*-- Author : I. O. Skillicorn
SUBROUTINE FTLISA(IRN,IPN,IWC,IC,MAXC,NSS,IM,IDIAG)
**: FTLISA 40000 SM. Initialise RR (else DDMIN*RR test might fail?).
**: FTLISA 40000 SM. Add SEQ BOSMDL so farm change might work.
**----------------------------------------------------------------------
**: FTLISA 30907 RP. Farm changes.
**----------------------------------------------------------------------
C
C PROCEDURE:-
C 1 FORM CLUSTERS BASED ON WIRE HITS
C 2 SELECT LARGEST CLUSTER . END IF TOO FEW HITS
C OR ALL CLUSTERS HAVE BEEN EXAMINED.
C 3 SEARCH FOR TRIPLES IN CLUSTER (UNUSED POINTS ONLY)
C IF NO TRIPLES GOTO2
C 4 JOIN TRIPLES TO FORM LINE SEGMENTS
C 5 SELECT LONGEST LINE SEGMENT
C 6 EXTEND THIS LINE SEGMENT BY STRAIGHT LINE PROJECTION
C IN DRIFT (AND R ) WITHIN CLUSTER. MARK USED POINTS.
C 7 EXTEND FURTHER BY PROJECTION IN PHI INTO NEIGHBOURING
C CLUSTERS . MARK USED POINTS .
C 8 REEXAMINE LARGEST CLUSTER . IF INSUFFICIENT POINTS
C ELIMINATE CLUSTER AND GOTO 2 . OTHERWISE GOTO 3.
C
C
C AUTHOR: I.O.SKILLICORN
*KEEP,FRDIMS.
PARAMETER (MAXHTS=200)
PARAMETER (NUMWPL=36)
PARAMETER (MAXTRK=200)
PARAMETER (MXTTRK=900)
PARAMETER (MAXTR3=200)
PARAMETER (MAXHPW=2)
PARAMETER (MAXDIG=2000)
PARAMETER (NUMRWR=1727)
PARAMETER (NUMPWR=1151)
*KEEP,FH1WORK.
COMMON/FGMIOS/
* Planar geometry
+ ZPP(140),C(140),S(140),ITYPE(140),WZERO(140),WSPACE,
*
* Radial geometry
+ ZP(36),PHW(36),WS(36)
*
COMMON/H1WORK/
* Radial data...
+ WW(MAXHTS,36),DRI(MAXHTS,36),RM(MAXHTS,36),
+ NDP(36), NW(MAXHTS,36), DWS(MAXHTS,36),
*
* Planar Data
+ NDPW(NUMWPL),DW(MAXHTS,NUMWPL),
+ DRIW(MAXHTS,NUMWPL),NDW(MAXHTS,NUMWPL),
+ WWP(MAXHTS,NUMWPL),
+ IPHOLE(MAXHTS,NUMWPL),
*
* Pointers into DIGI bank for IOS labelled hits
+ IPFRRE(MAXHTS,36),IPFRPE(MAXHTS,36),NFRRE,NFRPE,
+ IRPIOS(MAXDIG,2), IPPIOS(MAXDIG,2),
*
* Track segment data
+ NTRAKS(3),IRPT(12,MAXTRK,3),SDRFT(12,MAXTRK,3),
*
* Fit data
+ PCOSL(MAXTRK,3),PSINL(MAXTRK,3),PHZL(MAXTRK,3),
+ DPCOSL(MAXTRK,3),DPSINL(MAXTRK,3),
+ DPHZL(MAXTRK,3),CHSQ(MAXTRK,3),RZI(MAXTRK,3),
+ RPCOSG(MAXTRK),RPSING(MAXTRK),
+ PHZG(MAXTRK),CC(3,MAXTRK),ZIG(MAXTRK),
+ IRADG(36,MAXTRK),PHIG(36,MAXTRK),
+ IG,SDRADG(36,MAXTRK),
+ R1,Z1,RFIT(MAXTRK,3),
+ CHG(MAXTRK),
+ PPA(MAXTRK,3), ZZA(MAXTRK,3),
+ GPA(MAXTRK,3),GZA(MAXTRK,3)
*
*
*KEEP,FPTVTX.
COMMON/VERTVV/ZV ,XVV,YVV
**the common/VERTEX/ becomes /VERTVV/ (in analogy to /VERTFF/) on the
** 17/6/91, since it is in conflict with the VERTEX module (g.bernardi)
** (note that all these common names should start by F in this deck...)
*KEEP,FSGPAR.
COMMON/FSGPAR/DMINX, PHIT, TSCUT, SLCUT, RCUT, TSLPC,
+ MINHTS, MINPTS, MAXCLU, LSCUT, NWIRES, IPLOT
*KEEP,BCS.
INTEGER NHROW,NHCOL,NHLEN
PARAMETER (NHROW = 2, NHCOL = 1, NHLEN=2)
INTEGER NBOSIW
PARAMETER (NBOSIW=1000000)
INTEGER IW(NBOSIW)
REAL RW(NBOSIW)
COMMON /BCS/ IW
EQUIVALENCE (RW(1),IW(1))
SAVE /BCS/
*KEEP,BOSMDL.
C ------BOSMDL
LOGICAL BEGJOB,ENDRUN,BEGRUN,REVENT,ENDJOB,OTHDAT
COMMON/BOSMDL/BEGJOB,ENDRUN,BEGRUN,REVENT,ENDJOB,OTHDAT,
+ LCCRUN,NCCRUN,NEVENT,
+ IHA,IBS,IDB,IDATEL,LUP,ISN,JSN
SAVE /BOSMDL/
C ------
*KEND.
COMMON /FRPAR/ DFCUT,RRCUT,CUT3,CUT4,CUT5
* LOCAL ARRAYS
*
DIMENSION XX(12),YY(12),YN(12)
DIMENSION LNOS(12,MAXTRK),IUSED(MAXHTS,36),NPTS(MAXTRK)
DIMENSION SD(12,MAXTRK),PHI(12,MAXTRK),LPRS(12,MAXTRK)
DIMENSION PHI2(12,MAXTRK),GRAD(MAXTRK)
DIMENSION X1(MAXTRK),Y1(MAXTRK),X2(MAXTRK),Y2(MAXTRK)
DIMENSION XNS(MAXTRK),XNSS(MAXTRK)
DIMENSION NPS(MAXTRK),LX1(MAXTRK),LX2(MAXTRK),NPTSP(MAXTRK)
DIMENSION IL(MAXTRK),IFL(MAXTRK)
DIMENSION ITRACK(12,MAXTRK),NUMPTS(MAXTRK)
DIMENSION SDS(12,MAXTRK),FDS(12,MAXTRK)
DIMENSION D(3,2),ISS(3)
DIMENSION SSCHI(MAXTRK)
C MODS 13/5/91 FOLLOW TO SAVE SPACE VVVVVVVVVVVVVVVVVVVVVVVVV
DIMENSION RS(12,MAXTRK,11)
EQUIVALENCE (RS(1,1,1),PCOSL(1,1))
EQUIVALENCE ( LNOS(1,1),RS(1,1, 1))
EQUIVALENCE ( SD(1,1),RS(1,1, 2))
EQUIVALENCE ( PHI(1,1),RS(1,1, 3))
EQUIVALENCE ( LPRS(1,1),RS(1,1, 4))
EQUIVALENCE ( PHI2(1,1),RS(1,1, 5))
EQUIVALENCE (ITRACK(1,1),RS(1,1, 6))
EQUIVALENCE ( SDS(1,1),RS(1,1, 7))
EQUIVALENCE ( FDS(1,1),RS(1,1, 8))
EQUIVALENCE ( IUSED(1,1),RS(1,1, 9))
C ADD
DIMENSION RSS(MAXTRK,15)
EQUIVALENCE (RSS(1,1),R1)
EQUIVALENCE ( NPTS(1),RSS(1, 1))
EQUIVALENCE ( GRAD(1),RSS(1, 2))
EQUIVALENCE ( X1(1),RSS(1, 3))
EQUIVALENCE ( X2(1),RSS(1, 4))
EQUIVALENCE ( Y1(1),RSS(1, 5))
EQUIVALENCE ( Y2(1),RSS(1, 7))
EQUIVALENCE ( XNS(1),RSS(1, 8))
EQUIVALENCE ( XNSS(1),RSS(1, 9))
EQUIVALENCE ( NPS(1),RSS(1,10))
EQUIVALENCE ( LX1(1),RSS(1,11))
EQUIVALENCE ( NPTSP(1),RSS(1,12))
EQUIVALENCE ( IL(1),RSS(1,13))
EQUIVALENCE ( IFL(1),RSS(1,14))
EQUIVALENCE (NUMPTS(1),RSS(1,15))
C
CEND ADDITION ********************************************
DATA ISTART/0/
PARAMETER (KN=50)
DIMENSION IRN(KN,48),IPN(KN,48),IWC(48)
DIMENSION SDD(12,100),NNPTS(100),CHI(100)
DIMENSION IFP(100),ILP(100),JDD(12,100),DDD(12,100)
DIMENSION IKILL(MAXHTS,36)
DIMENSION LTRI(12,MAXTRK)
DIMENSION SGTRI(12,MAXTRK)
DIMENSION ZTRI(MAXTRK)
DIMENSION DTRI(MAXTRK),RTRI(MAXTRK)
DIMENSION SLTRI(MAXTRK)
DIMENSION NL(MAXTRK)
DIMENSION YT(12),YS(12),NY(12)
PI2=6.283185307
C
C NO DIAGNOSTIC HISTOGRAMS IDIAG=0
IDIAG=0
C
*
* > Chard
* Hard-wired cuts if wanted, else take from COMMON/FSGPAR/ filled
* by FPTINT from the FRCP bank.
*
C CUTS
C MAXIMUM DISTANCE ( IN DRIFT) FOR DIGITISING
C TO BE ASSOCIATED WITH TRIPLE(S)
C IE ROAD WIDTH IS 2.*DMINX (CMS.)
C SHOULD BE LESS THAN TWO-TRACK RESOLUTION 0.2 CMS
C AND LESS THAN 4*STAGGER
Chard DMINX=0.1
C
Chard PROJ=0.0
PROJ=1.0
C DMINX=DFCUT
C MAXIMUM DISTANCE ( IN PHI ) FOR DIGITISING
C TO BE ASSOCIATED WITH CLUSTER = PROJ*DMINX/R
C
C MINIMUM SIZE OF CLUSTER FOR STARTING TRIPLE FINDING
Chard MINHTS=3
C
C MINIMUM NUMBER OF POINTS/TRACK SEGMENT
Chard MINPTS=4
C
C MAX SIZE OF CLUSTER FOR ANALYSIS
MAXCLU=KN
C
C ABS((D1+D3)/2 -D2 ).LT.TSCUT FOR TRIPLE(OPEN FROM 0.08)
Chard TSCUT=0.10
C IN JOINING TRIPLES ALL POINTS MUST LIE WITHIN +- TSCUT
C OF FIRST AND LAST POINTS OF TRIPLES TO BE JOINED
C
C
C MAX TRIPLE SLOPE- CORRESPONDS TO 0.25 GEV(OPEN FROM 0.25)
Chard TSLPC=0.5
C SLOPE CUT FOR JOINING TRIPLES
Chard SLCUT=0.15
C
C MIN LENGTH OF SEGMENT BEFORE EXTENSION BY PROJECTION
Chard LSCUT=3
C
C CUT IN R FOR TRIPLE AND PROJECTION(OPEN FROM 20.)
Chard RCUT=50.
C
C RCUT=RRCUT
IF(ISTART.EQ.0)THEN
ISTART=1
Write(*,*)' '
Write(*,*)' FTREC Pattern recognition'
Write(*,*)' Using ftlisa '
Write(*,*)' Dminx = ',DMINX
Write(*,*)' Proj = ',PROJ
Write(*,*)' Tscut = ',TSCUT
Write(*,*)' Tslpc = ',TSLPC
Write(*,*)' Slcut = ',SLCUT
Write(*,*)' Rcut = ',RCUT
Write(*,*)' '
C DIAGNOSTIC HISTOGRAMS
IF(IDIAG.NE.0) THEN
CALL STEXT(9000,4,' TRIPLE DISTANCE DEFINE -TSCUT ')
CALL BHS(9000,0,50,-0.5,0.5 )
CALL STEXT(9001,4,' TRIPLE SLOPE -TSLPC ')
CALL BHS(9001,0,50,-1.0,1.0 )
CALL STEXT(9002,4,' TRIPLE DISTANCE JOIN 1-TSCUT ')
CALL BHS(9002,0,50,-0.5,0.5 )
CALL STEXT(9003,4,' TRIPLE DISTANCE JOIN 2-TSCUT ')
CALL BHS(9003,0,50,-0.5,0.5 )
CALL STEXT(9004,4,' PROJECT- DMINX ')
CALL BHS(9004,0,50,-0.51,0.49 )
CALL STEXT(9005,4,' PROJECT IN PHI - DMINX*PROJ ')
CALL BHS(9005,0,50,-1.0,1.0 )
CALL STEXT(9006,4,' TRIPLE SLOPE CUT - SLCUT ')
CALL BHS(9006,0,50,-0.5,0.5 )
CALL STEXT(9007,4,' PROJECT- DMINX DURING SELECTION ')
CALL BHS(9007,0,50,0.00,1.00 )
CALL STEXT(9008,4,' PROJECT- DMINX FINAL ')
CALL BHS(9008,0,50,0.00,0.20 )
CALL STEXT(9009,4,' RESIDUALS TO FINAL SEGMENT')
CALL BHS(9009,0,50,-0.10,0.10 )
CALL STEXT(9010,4,' RESIDUALS TO FINAL SEGMENT')
CALL BHS(9010,0,50, 0.0,0.20 )
CALL STEXT(9011,4,' RMS OF FIT ')
CALL BHS(9011,0,50, 0.0,0.10 )
ENDIF
ENDIF
C
C OPEN EXTRAPOLATION FOR CLEAN WEDGES
C
SDMINX=DMINX
IF(MAXC.LT.15)DMINX=DMINX*2.
C
NT=0
NTIN=NTRAKS(IM)
C
Chard NWIRES= 12
C
C SEARCH FOR TRIPLES IN CLUSTER
500 CONTINUE
DO 203 I=1,12
DO 203 J=1,100
JDD(I,J)=0
DDD(I,J)=1000.
203 SDD(I,J)=0.
NTRI=0
DDMIN=1000.
DO 110 K1=1,MAXC-2
LJ1=IRN(K1,IC)
LP1=IPN(K1,IC)
C WRITE(*,*)' LJ1 LP1',LJ1,LP1
IF(DRI(LJ1,LP1).GT.900.)GOTO110
IF(IUSED(LJ1,LP1).GT.0)GOTO110
KK1=K1+1
DO 120 K2=KK1,MAXC-1
LP2=IPN(K2,IC)
IF(LP2.NE.LP1+1)GOTO120
LJ2=IRN(K2,IC)
IF(DRI(LJ2,LP2).GT.900.)GOTO120
IF(IUSED(LJ2,LP2).GT.0)GOTO120
KK2=K2+1
C WRITE(*,*)' LJ2 LP2',LJ2,LP2
IF(IUSED(LJ2,LP2).GT.0)GOTO120
DO 130 K3=KK2,MAXC
LP3=IPN(K3,IC)
IF(LP3.NE.LP1+2)GOTO130
LJ3=IRN(K3,IC)
IF(DRI(LJ3,LP3).GT.900.)GOTO130
IF(IUSED(LJ3,LP3).GT.0)GOTO130
C WRITE(*,*)' LJ3 LP3',LJ3,LP3
C NOW HAVE POSSIBLE TRIPLE - LOOP OVER SIGNS
DO 140 IS1=1,2
S1=1.
IF(IS1.EQ.2)S1=-1.
D1=S1*DRI(LJ1,LP1)+DWS(LJ1,LP1)
R1=RM(LJ1,LP1)
DO 141 IS2=1,2
S2=1.
IF(IS2.EQ.2)S2=-1.
D2=S2*DRI(LJ2,LP2)+DWS(LJ2,LP2)
R2=RM(LJ2,LP2)
C MAX TRIPLE SLOPE
IF(ABS(D1-D2).GT.TSLPC)GOTO141
DO 142 IS3=1,2
S3=1.
IF(IS3.EQ.2)S3=-1.
D3=S3*DRI(LJ3,LP3)+DWS(LJ3,LP3)
R3=RM(LJ3,LP3)
DD= ((D1+D3)*0.5-D2)
IF(IDIAG.EQ.1)CALL SHS(9000,0,DD)
IF(IDIAG.EQ.1)CALL SHS(9001,0,(D3-D1)*0.5)
DD=ABS(DD)
DR=ABS((R1+R3)*0.5-R2)
DS=ABS(D3-D1)
C MAX SLOPE OF TRIPLE
IF(DS.GT.2.*TSLPC)GOTO142
C DDA= (D1+D3)*0.5-D2
IF(DD.LT.TSCUT.AND.DR.LT.RCUT)THEN
SS1=S1
SS2=S2
SS3=S3
II=K1
JJ=K2
KK=K3
RRS=(R1+R2+R3)*0.33333333
C CALL HFILL(70004,DDAS,0.,1.)
NTRI=NTRI+1
IF(NTRI.GT.MAXTRK)NTRI=MAXTRK
C POINTERS TO CLUSTER
LTRI(1,NTRI)=II
LTRI(2,NTRI)=JJ
LTRI(3,NTRI)=KK
C WRITE(*,*)' TRI ',NTRI,II,JJ,KK
C NUMBER POINTERS
NL(NTRI)=3
C DRIFT SIGN
SGTRI(1,NTRI)=SS1
SGTRI(2,NTRI)=SS2
SGTRI(3,NTRI)=SS3
C Z OF CENTRE OF LAST TRIPLE
KPP=IPN(JJ,IC)
ZTRI(NTRI)=ZP(KPP)
D1=SS1*DRI(IRN(II,IC),IPN(II,IC))+DWS(IRN(II,IC),IPN(II,IC))
D2=SS2*DRI(IRN(JJ,IC),IPN(JJ,IC))+DWS(IRN(JJ,IC),IPN(JJ,IC))
D3=SS3*DRI(IRN(KK,IC),IPN(KK,IC))+DWS(IRN(KK,IC),IPN(KK,IC))
RZ=1./(ZP(LP3)-ZP(LP1))
DSS=(D1+D2+D3)*0.33333333
SLPS=(D3-D1)*RZ
C SLOPE OF TRIPLE
SLTRI(NTRI)=SLPS
C MEAN DRIFT
DTRI(NTRI)=DSS
C MEAN R
RTRI(NTRI)=RRS
ENDIF
142 CONTINUE
141 CONTINUE
140 CONTINUE
130 CONTINUE
120 CONTINUE
110 CONTINUE
C WRITE(*,*)' FTLISA NTRI ',NTRI
IF(NTRI.EQ.0)THEN
IWC(IC)=-IWC(IC)
GOTO999
ENDIF
*
*
*
*
*
*
C COMBINE TRIPLES TO FORM TRACK
IF(NTRI.GE.2)THEN
DO 300 I=1,NTRI-1
IF(ZTRI(I).LT.0.)GOTO300
K=I+1
DO 310 J=K,NTRI
IF(ZTRI(J).LT.0.)GOTO310
IF(ABS(RTRI(I)-RTRI(J)).GT.RCUT)GOTO310
C CHECK FOR TWO POINTS IN COMMON WITH SAME DRIFT SIGNS
C EXTEND TRIPLE BY ONE POINT
IF(LTRI(NL(I)-1,I).EQ.LTRI(1,J).AND.
1 LTRI(NL(I),I).EQ.LTRI(2,J))THEN
IF(SGTRI(NL(I)-1,I).EQ.SGTRI(1,J).AND.
1 SGTRI(NL(I),I).EQ.SGTRI(2,J))THEN
C TWO POINTS AGREE,ADD FINAL POINT AFTER CHECKING
C THAT ALL POINTS ARE WITHIN TOLERANCE OF LINE
C CONNECTED TO FIRST AND LAST POINTS OF POTENTIAL
C JOINED SEGMENTS
C FIRST POINT FIRST TRIPLE
II=LTRI(1,I)
C LAST POINT SECOND TRIPLE
KK=LTRI(NL(J),J)
C POINTS
I1=IRN(II,IC)
K1=IRN(KK,IC)
C PLANES
IP=IPN(II,IC)
KP=IPN(KK,IC)
C DRIFT SIGNS
S1=SGTRI(1,I)
S3=SGTRI(NL(J),J)
D1=S1*DRI(I1,IP)+DWS(I1,IP)
D3=S3*DRI(K1,KP)+DWS(K1,KP)
Z1=ZP(IP)
Z3=ZP(KP)
SLP=(D3-D1)/(Z3-Z1)
C CHECK POINTS AGREE - FIRST TRIPLE
DO 320 N1=2,NL(I)
II1=LTRI(N1,I)
I1=IRN(II1,IC)
IP1=IPN(II1,IC)
S11=SGTRI(N1,I)
C MEASURED
D11=S11*DRI(I1,IP1)+DWS(I1,IP1)
ZZ=ZP(IP1)
C PREDICTED
DP=D1+(ZZ-Z1)*SLP
IF(IDIAG.EQ.1)CALL SHS(9002,0,DP-D11)
C WRITE(*,*)' T-J 1 ',N1,ABS(DP-D11),DMINX
IF(ABS(DP-D11).GT.TSCUT)GOTO310
320 CONTINUE
C CHECK POINTS AGREE - SECOND TRIPLE
DO 330 N1=1,NL(J)-1
II1=LTRI(N1,J)
I1=IRN(II1,IC)
IP1=IPN(II1,IC)
S11=SGTRI(N1,J)
D11=S11*DRI(I1,IP1)+DWS(I1,IP1)
ZZ=ZP(IP1)
DP=D1+(ZZ-Z1)*SLP
IF(IDIAG.EQ.1)CALL SHS(9002,0,DP-D11)
C WRITE(*,*)' T-J 2 ',N1,ABS(DP-D11),DMINX
IF(ABS(DP-D11).GT.TSCUT)GOTO310
330 CONTINUE
C WRITE(*,*)' ADD I,J ',I,J
C PRINT1100, I,(LTRI(III, I),III=1,NL( I))
C PRINT1100, J,(LTRI(III, J),III=1,NL( J))
NL(I)=NL(I)+1
IF(NL(I).GT.12)NL(I)=12
LTRI(NL(I),I)=LTRI(3,J)
SGTRI(NL(I),I)=SGTRI(3,J)
CDEB PRINT1100, I,(LTRI(III, I),III=1,NL( I))
C REPLACE Z,SLOPE,MEAN DRIFT
ZTRI(I)=ZTRI(J)
SLTRI(I)=SLTRI(J)
DTRI(I)=DTRI(J)
RTRI(I)=RTRI(J)
C MARK J AS USED
ZTRI(J)=-100.
GOTO310
ENDIF
ENDIF
NOMISS=1
IF(NOMISS.EQ.1)THEN
C ALLOW FOR ONE MISSING DIGITIZING, JOIN ACROSS GAP
IF(ZTRI(J)-ZTRI(I).LT.4.5.AND.
1 ZTRI(J)-ZTRI(I).GT.3.5)THEN
C CALL HFILL(70003,(SLTRI(I)-SLTRI(J)),0.,1.)
IF(IDIAG.EQ.1)CALL SHS(9006,0,SLTRI(I)-SLTRI(J))
IF(ABS(SLTRI(I)-SLTRI(J)).GT.SLCUT)GOTO310
IF(ABS( (DTRI(I)-DTRI(J))/(ZTRI(I)-ZTRI(J)) -SLTRI(I)).GT.
1 SLCUT)GOTO310
IF(ABS( (DTRI(I)-DTRI(J))/(ZTRI(I)-ZTRI(J)) -SLTRI(J)).GT.
1 SLCUT)GOTO310
IF(ABS(RTRI(I)-RTRI(J)).GT.RCUT)GOTO310
C THEN
C CHECK THAT ALL POINTS ARE WITHIN TOLERANCE OF LINE
C CONNECTED TO FIRST AND LAST POINTS OF POTENTIAL
C JOINED SEGMENTS
C FIRST POINT FIRST TRIPLE
II=LTRI(1,I)
C LAST POINT SECOND TRIPLE
KK=LTRI(NL(J),J)
C POINTS
I1=IRN(II,IC)
K1=IRN(KK,IC)
C PLANES
IP=IPN(II,IC)
KP=IPN(KK,IC)
C DRIFT SIGNS
S1=SGTRI(1,I)
S3=SGTRI(NL(J),J)
D1=S1*DRI(I1,IP)+DWS(I1,IP)
D3=S3*DRI(K1,KP)+DWS(K1,KP)
Z1=ZP(IP)
Z3=ZP(KP)
SLP=(D3-D1)/(Z3-Z1)
C CHECK POINTS AGREE - FIRST TRIPLE
DO 340 N1=2,NL(I)
II1=LTRI(N1,I)
I1=IRN(II1,IC)
IP1=IPN(II1,IC)
S11=SGTRI(N1,I)
C MEASURED
D11=S11*DRI(I1,IP1)+DWS(I1,IP1)
ZZ=ZP(IP1)
C PREDICTED
DP=D1+(ZZ-Z1)*SLP
IF(IDIAG.EQ.1)CALL SHS(9003,0,DP-D11)
C WRITE(*,*)' T-J 1 ',N1,ABS(DP-D11),DMINX
IF(ABS(DP-D11).GT.TSCUT)GOTO310
340 CONTINUE
C CHECK POINTS AGREE - SECOND TRIPLE
DO 350 N1=1,NL(J)-1
II1=LTRI(N1,J)
I1=IRN(II1,IC)
IP1=IPN(II1,IC)
S11=SGTRI(N1,J)
D11=S11*DRI(I1,IP1)+DWS(I1,IP1)
ZZ=ZP(IP1)
DP=D1+(ZZ-Z1)*SLP
IF(IDIAG.EQ.1)CALL SHS(9003,0,DP-D11)
C WRITE(*,*)' T-J 2 ',N1,ABS(DP-D11),DMINX
IF(ABS(DP-D11).GT.TSCUT)GOTO310
350 CONTINUE
C JOIN
DO 315 L=1,NL(J)
NL(I)=NL(I)+1
LTRI(NL(I),I)=LTRI(L,J)
SGTRI(NL(I),I)=SGTRI(L,J)
315 CONTINUE
ZTRI(I)=ZTRI(J)
SLTRI(I)=SLTRI(J)
DTRI(I)=DTRI(J)
C FLAG TRIPLE AS JOINED
ZTRI(J)=-100.
ENDIF
ENDIF
310 CONTINUE
300 CONTINUE
ENDIF
*
* NOW HAVE JOINED TRIPLES - FIT
*
DO 62 KD=1,100
NNPTS(KD)=0
CHI(KD)=0.
DO 62 J1=1,12
JDD(J1,KD)=0
DDD(J1,KD)=1000.
62 SDD(J1,KD)=0.
KCC=0
C WRITE(*,*)' NTRI TOT BEFORE DO 100 LOOP ',NTRI
DO 100 KC=1,NTRI
IF(ZTRI(KC).LT.0.0)GOTO100
C PICK UP POINTS IN EXTENDED TRIPLE AND FIT STR LINE
LL=0
C WRITE(*,*)' FTLISA JOINED TRIPLES -NL ',KC,NL(KC)
DO 400 II=1,NL(KC)
JJ=LTRI(II,KC)
I=IRN(JJ,IC)
IP=IPN(JJ,IC)
SGN=SGTRI(II,KC)
DR=SGN*DRI(I,IP)+DWS(I,IP)
LL=LL+1
XX(LL)=ZP(IP)
YY(LL)=DR
400 CONTINUE
CALLFTLFT(XX,YY,LL,0,TS,TI,EE)
*
*
*
C
C
KCC=KCC+1
C WRITE(*,*)' KCC ',KCC
IF(KCC.GT.99)THEN
C WRITE(*,*)' KCC AT LIMIT - FTLISA '
KCC=100
GOTO100
ENDIF
DO 410 II=1,NL(KC)
JJ=LTRI(II,KC)
I=IRN(JJ,IC)
IP=IPN(JJ,IC)
SGN=SGTRI(II,KC)
DIFF=ABS(YY(II)-TS*XX(II)-TI)
JPP=IP-NSS+1
SDD(JPP,KCC)=SGN
JDD(JPP,KCC)=I
DDD(JPP,KCC)=DIFF
410 CONTINUE
C NOW LOOK FOR OTHER POINTS IN CLUSTER TO FILL
C GAPS IN SEGMENT
DO 60 II=1,MAXC
I=IRN(II,IC)
J=I
IP=IPN(II,IC)
IF(IUSED(I,IP).GT.0)GOTO60
JPP=IP-NSS+1
C IF POINT ON PLANE EXISTS IN TRIPLE GOTO60
IF(JDD(JPP,KCC).NE.0)GOTO60
C CHECK POINT IN R
DR=ABS(RM(I,IP)-RTRI(KC))
IF(DR.GT.RCUT)GOTO60
ZZ=ZP(IP)
C PREDICT DRIFT AT THIS Z
DP=TS*ZZ+TI
YN(1)= DRI(I,IP)+DWS(I,IP)
YN(2)=-DRI(I,IP)+DWS(I,IP)
DDMIN=1000.
DO 61 IS=1,2
IF(IDIAG.EQ.1)CALL SHS(9004,0,YN(IS)-DP)
DD=ABS(YN(IS)-DP)
DDA=(YN(IS)-DP)
IF(DD.LT.DDMIN)THEN
DDMIN=DD
DDAS=DDA
ISN=IS
ENDIF
61 CONTINUE
IF(IDIAG.EQ.1)CALL SHS(9007,0,DDMIN)
C IF(ABS(DDAS).GT.0.00001)CALL HFILL(70005,DDAS,0.,1.)
IF(DDMIN.LT.DMINX)THEN
C GOOD POINT
IF(DDMIN.LT.DDD(JPP,KCC))THEN
C CLOSER TO LINE THAN PREVIOUS GOOD POINT - STORE
C
C
IF(ISN.EQ.1)THEN
SDD(JPP,KCC)=1.0
JDD(JPP,KCC)=J
DDD(JPP,KCC)=DDMIN
ELSE
SDD(JPP,KCC)=-1.0
JDD(JPP,KCC)=J
DDD(JPP,KCC)=DDMIN
ENDIF
C
ENDIF
ENDIF
C WRITE(*,*)' I1,KCC,JPP,SDD ',I1,KCC,JPP,SDD(JPP,KCC)
60 CONTINUE
NNPTS(KCC)=0
CHI(KCC)=0.
DO 63 KKK=1,12
IF(SDD(KKK,KCC).NE.0.)NNPTS(KCC)=NNPTS(KCC)+1
IF(SDD(KKK,KCC).NE.0.)CHI(KCC)=CHI(KCC)+DDD(KKK,KCC)**2/.004
IF(SDD(KKK,KCC).EQ.0.)GOTO63
IF(IDIAG.EQ.1)CALL SHS(9008,0,DDD(KKK,KCC))
63 CONTINUE
IF(NNPTS(KCC).NE.0)CHI(KCC)=CHI(KCC)/FLOAT(NNPTS(KCC))
C PRINT 1003,KCC,NNPTS(KCC),CHI(KCC),(JDD(I2,KCC),I2=1,12)
C PRINT 1103,KCC,NNPTS(KCC),CHI(KCC),(SDD(I2,KCC),I2=1,12)
1003 FORMAT(' JDD',2I3,1X,F5.3,12I3 )
1103 FORMAT(' SDD',2I3,2X,F5.3,12F3.0)
100 CONTINUE
C WRITE(*,*)' AFTER DO 100 LOOP KCC',KCC
C SELECT BEST LINE - LONGEST OR BEST CHI
C WEIGHT=#POINTS
WTMAX=0.
IIG=0
DO 70 I=1,KCC
WT=FLOAT(NNPTS(I))
IF((WT-WTMAX).GT.0)THEN
C ONE OR MORE POINTS EXCESS - SELECT ON POINTS
WTMAX=WT
IIG=I
ELSEIF((WT.EQ.WTMAX).AND.IIG.NE.0)THEN
C SAME NUMBER POINTS - SELECT ON CHI
IF(CHI(I).LT.CHI(IIG))THEN
WTMAX=WT
IIG=I
ENDIF
ENDIF
70 CONTINUE
IF(IIG.EQ.0.OR.NNPTS(IIG).LT.MINPTS)THEN
C BAD CLUSTER - LT MINPTS POINTS
IWC(IC)=-IWC(IC)
C WRITE(*,*)' BAD CLUSTER LT MINPTS'
GOTO999
ENDIF
C AT THIS POINT WE HAVE A GOOD SEGMENT
C FILL OUTPUT BANK FOR FOUND SEGMENT
NTRAKS(IM)=NTRAKS(IM)+1
IF(NTRAKS(IM).GT.MAXTRK)NTRAKS(IM)=MAXTRK
NT=NTRAKS(IM)
C WRITE(*,*)' NTRAKS(IM) ',NT
JPPMIN=1000
JPPMAX=0
RMEAN=0.
FNN=0.
DO 80 I=1,12
JP=I+NSS-1
CDEB WRITE(*,*)' I,JP,IIG ',I,JP,IIG,SDD(I,IIG)
IF(SDD(I ,IIG).EQ.0.)GOTO80
IF(I .LT.JPPMIN)THEN
JPPMIN=I
JMIN=JDD(I,IIG)
ENDIF
IF(I.GT.JPPMAX)THEN
JPPMAX=I
JMAX=JDD(I,IIG)
ENDIF
J=JDD(I,IIG)
IRPT(I ,NT,IM)=JDD(I ,IIG)
SDRFT(I ,NT,IM)=SDD(I ,IIG)
IUSED(J,JP)=1
RMEAN=RMEAN+RM(J,JP)
FNN=FNN+1.
80 CONTINUE
IF(JPPMAX.EQ.0.OR.JPPMIN.EQ.1000)THEN
C WRITE(*,*)' JPPMAX=0 OR JPPMIN=1000 '
NTRAKS(IM)=NTRAKS(IM)-1
GOTO999
ENDIF
RMEAN=RMEAN/FNN
C WRITE(*,*)' OUTPUT BANK BEFORE PROJECTION'
C PRINT 1014,IM,NT,(IRPT(I1,NT,IM),I1=1,12)
1004 FORMAT(' IRPT ',I5,1X,12I3)
CDEB PRINT 1015,IM,NT,(SDRFT(I1,NT,IM),I1=1,12)
1005 FORMAT(' SDRFT',I5,2X,12F3.0)
C LOOK FOR CLUSTER ON NEARBY WIRES
C CALCULATE PARAMETERS FOR PROJECTION IN PHI
C UNLESS FULL LINE SEGMENT
IF(JPPMIN.EQ.1.AND.JPPMAX.EQ.NWIRES)GOTO998
JMIN=JDD(JPPMIN,IIG)
JP=JPPMIN+NSS-1
D1=SDD(JPPMIN,IIG)*DRI(JMIN,JP)+DWS(JMIN,JP)
PHI1=ATAN(D1/RMEAN )+WW(JMIN,JP)
Z1=ZP(JP)
C
JMAX=JDD(JPPMAX,IIG)
JP=JPPMAX+NSS-1
D2=SDD(JPPMAX,IIG)*DRI(JMAX,JP)+DWS(JMAX,JP)
PHI3=ATAN(D2/RMEAN )+WW(JMAX,JP)
Z2=ZP(JP)
SLP=(PHI3-PHI1)/(Z2-Z1)
C CHECK ADJACENT WIRE - LOWER NUMBER- SAVE IC
ICS=IC
C IF IC=1 EXAMINE 48 AS LOWER NUMBER
C IF(IC.EQ.1)IC=49
IF((IC-1).GT.0)THEN
C NOTE IABS BECAUSE THERE COULD BE USEFUL POINTS THAT DO NOT FORM TR
IF(IABS(IWC(IC-1)).GT.0)THEN
DO 85 I=1,IABS(IWC(IC-1))
J=IRN(I,IC-1)
JPP=IPN(I,IC-1)-NSS+1
IF(JPP.LT.JPPMIN.OR.JPP.GT.JPPMAX)THEN
C CHECK PHI CONTINUITY
JP=IPN(I,IC-1)
IF(IUSED(J,JP).GT.0)GOTO85
ZZ=ZP(JP)
C PREDICT PHI
PHIP=PHI1+(ZZ-Z1)*SLP
D1= DRI(J,JP)+DWS(J,JP)
D2=-DRI(J,JP)+DWS(J,JP)
YN(1)=ATAN(D1/RMEAN )+WW(J,JP)
YN(2)=ATAN(D2/RMEAN )+WW(J,JP)
CDEB WRITE(*,*)' LOW CLUSTER PHI ',PHIP,YN(1),YN(2)
DDMIN=1000.
DO 851 IS=1,2
DD =ABS(YN(IS)-PHIP)
C DD2=ABS(YN(IS)-PHIP+PI2)
C DD2=ABS(YN(IS)-PHIP-PI2)
C DD=AMIN1(DD1,DD2,DD3)
DDA=(YN(IS)-PHIP)
IF(DD.LT.DDMIN)THEN
DDMIN=DD
DDAS=DDA
RR=RMEAN
ISN=IS
ENDIF
851 CONTINUE
IF(IDIAG.EQ.1)CALL SHS(9005,0,(YN(ISN)-PHIP)*RM(J,JP))
C CALL HFILL(70006,DDAS,0.,1.)
IF(DDMIN*RR.GT.DMINX*PROJ)GOTO85
C GOOD POINT - CONT. IN PHI
IF(ISN.EQ.1)SDRFT(JPP,NT,IM)=1.
IF(ISN.EQ.2)SDRFT(JPP,NT,IM)=-1.
IRPT(JPP,NT,IM)=J
IUSED(J,JP)=1
ENDIF
85 CONTINUE
CDEB WRITE(*,*)' OUTPUT BANK AFTER ADDING LOWER CLUSTER'
CDEB PRINT 1004,NT,(IRPT(I1,NT,IM),I1=1,12)
C1004 FORMAT(' IRPT ',I5,1X,12I3)
CDEB PRINT 1005,NT,(SDRFT(I1,NT,IM),I1=1,12)
C1005 FORMAT(' SDRFT',I5,1X,12F3.0)
ENDIF
ENDIF
C RESET IC IN CASE CHANGED
IC=ICS
C CHECK ADJACENT WIRE - HIGHER NUMBER
C IF IC=48 EXAMINE IC=1 AS HIGHER NUMBER
C IF(IC.EQ.48)IC=0
IF((IC+1).LE.48)THEN
IF(IABS(IWC(IC+1)).GT.0)THEN
DO 86 I=1,IABS(IWC(IC+1))
J=IRN(I,IC+1)
JPP=IPN(I,IC+1)-NSS+1
IF(JPP.LT.JPPMIN.OR.JPP.GT.JPPMAX)THEN
C CHECK PHI CONTINUITY
JP=IPN(I,IC+1)
IF(IUSED(J,JP).GT.0)GOTO86
ZZ=ZP(JP)
C PREDICT PHI
PHIP=PHI1+(ZZ-Z1)*SLP
D1= DRI(J,JP)+DWS(J,JP)
D2=-DRI(J,JP)+DWS(J,JP)
YN(1)=ATAN(D1/RMEAN )+WW(J,JP)
YN(2)=ATAN(D2/RMEAN )+WW(J,JP)
CDEB WRITE(*,*)' HIGH CLUSTER PHI ',PHIP,YN(1),YN(2)
DDMIN=1000.
DO 861 IS=1,2
DD =ABS(YN(IS)-PHIP)
C DD2=ABS(YN(IS)-PHIP+PI2)
C DD2=ABS(YN(IS)-PHIP-PI2)
C DD=AMIN1(DD1,DD2,DD3)
DDA= (YN(IS)-PHIP)
IF(DD.LT.DDMIN)THEN
DDMIN=DD
DDAS=DDA
RR=RMEAN
ISN=IS
ENDIF
861 CONTINUE
IF(IDIAG.EQ.1)CALL SHS(9005,0,(YN(ISN)-PHIP)*RM(J,JP))
C CALL HFILL(70006,DDAS,0.,1.)
IF(DDMIN*RR.GT.DMINX*PROJ)GOTO86
C GOOD POINT - CONT. IN PHI
IF(ISN.EQ.1)SDRFT(JPP,NT,IM)=1.
IF(ISN.EQ.2)SDRFT(JPP,NT,IM)=-1.
IRPT(JPP,NT,IM)=J
IUSED(J,JP)=1
ENDIF
86 CONTINUE
CDEB WRITE(*,*)' OUTPUT BANK AFTER ADDING HIGHER CLUSTER'
CDEB PRINT 1004,NT,(IRPT(I1,NT,IM),I1=1,12)
C1004 FORMAT(' IRPT ',I5,1X,12I3)
CDEB PRINT 1005,NT,(SDRFT(I1,NT,IM),I1=1,12)
C1005 FORMAT(' SDRFT',I5,1X,12F3.0)
ENDIF
ENDIF
C RESET IC IN CASE CHANGED
IC=ICS
998 CONTINUE
C WRITE(*,*)' NTIN,NTRAKS(IM) ',NTIN,NTRAKS(IM)
C WRITE(*,*)' FTLISA OUT ',NTRAKS(IM)
C PRINT 1014,IM,NT,(IRPT(I1,NT,IM),I1=1,12)
1014 FORMAT(' IRPT ',2I5,2X,12I3,I8)
C PRINT 1015,IM,NT,(SDRFT(I1,NT,IM),I1=1,12)
1015 FORMAT(' SDRFT',2I5,3X,12F3.0)
C REEXAMINE CLUSTER
C IF(IWC(IC).GT.0)THEN
C WRITE(*,*)' GT 500 REEXAMINE CLUSTER IWC',IWC(IC),IC
C DO 3000 I=1,10
C PRINT 4000,I,(IUSED(I,II),II=1,36)
C 4000 FORMAT(' IUSED ',I5,3X,12I1,1X,12I1,1X,12I1)
C 3000 CONTINUE
C ENDIF
IF(IWC(IC).GT.0) GO TO 500
999 CONTINUE
C RESET DMINX
DMINX=SDMINX
IF(NTRAKS(IM).EQ.NTIN)RETURN
C
C CORRECT R FOR LORENTZ ANGLE FOR
C FOUND TRACK SEGMENTS
DO 9000 I=NTIN+1,NTRAKS(IM)
LL=0
DO 9100 J=1,12
C PLANE #
IP=J+NSS-1
C POINT #
NP=IRPT(J,I,IM)
IF(NP.EQ.0)GOTO9100
C DRIFT SIGN
SGN=SDRFT(J,I,IM)
RM(NP,IP)=RM(NP,IP)
1 +FLOREN(RM(NP,IP),DRI(NP,IP),SGN)
IF(IDIAG.EQ.0)GOTO9100
LL=LL+1
DRIFF=DRI(NP,IP)*SGN+DWS(NP,IP)
YY(LL)=DRIFF
XX(LL)=ZP(IP)
9100 CONTINUE
IF(IDIAG.EQ.1)CALL FTLFT(XX,YY,LL,0,TS,TI,EE)
DO 9101 II=1,LL
DIFF=YY(II)-TS*XX(II)-TI
IF(IDIAG.EQ.1)CALL SHS(9009,0,DIFF)
IF(IDIAG.EQ.1)CALL SHS(9010,0,ABS(DIFF))
IF(IDIAG.EQ.1)CALL SHS(9011,0,SQRT(ABS(EE)))
9101 CONTINUE
C
C PRINT 1014,IM, I,(IRPT(I1, I,IM),I1=1,12)
C PRINT 1015,IM, I,(SDRFT(I1, I,IM),I1=1,12)
9000 CONTINUE
RETURN
END
*