*-- Author : I.O. Skillicorn
SUBROUTINE FTLSEG(NSS,IM)
**: FTLSEG 40000 SM. New monitoring histos.
**----------------------------------------------------------------------
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,FSGPAR.
COMMON/FSGPAR/DMINX, PHIT, TSCUT, SLCUT, RCUT, TSLPC,
+ MINHTS, MINPTS, MAXCLU, LSCUT, NWIRES, IPLOT
*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...)
*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)
*
* > Chard
* Hard-wired cuts if wanted, else take from COMMON/FSGPAR/ filled
* by FPTINT from the FRCP bank.
*
C MINIMUM SIZE OF CLUSTER FOR STARTING TRIPLE FINDING
Chard MINHTS=3
C MINIMUM NUMBER OF POINTS/TRACK SEGMENT
Chard MINPTS=4
* but keep this to avoid array size problems!!
C MAX SIZE OF CLUSTER FOR ANALYSIS
MAXCLU=KN
C
Chard NWIRES= 8
C
NT=0
NTRAKS(IM)=0
C
C
C***********************************************************************
C IPLOT=0 FOR NO DIAGNOSTIC T0, RMS TO LINE SEG, PLOTS: MAX SPEED
Chard IPLOT=0
IPLOT=1
C***********************************************************************
DO 199 I=1,MAXHTS
DO 199 J=1,36
IUSED(I,J)=0
199 IKILL(I,J)=0
C
DO 200 I=1,48
DO 201 J=1,KN
IRN(J,I)=0
IPN(J,I)=0
201 CONTINUE
200 CONTINUE
DO 203 I=1,12
DO 203 J=1,100
JDD(I,J)=0
DDD(I,J)=1000.
203 SDD(I,J)=0.
DO 204 I=1,12
DO 204 J=1,MAXTRK
IRPT(I,J,IM)=0
SDRFT(I,J,IM)=0.
204 CONTINUE
C WRITE(*,*)' NDP ',NDP
C DO 4999 IP=1,36
C DO 5000 I=1,NDP(IP)
C WRITE(*,*)' DRI,RM,NW',DRI(I,IP),RM(I,IP),NW(I,IP),I,IP
C000 CONTINUE
C999 CONTINUE
C ENSURE ONLY 1 HIT/WIRE - TAKE MIN DRIFT HIT
IONE=0
IF(IONE.EQ.1)THEN
DO 205 I=NSS,NSS+NWIRES-1
NN=NDP(I)
IF(NN.LE.1)GOTO205
NNN=NN-1
DO 206 J1=1,NNN
J3=J1+1
IF(DRI(J1,I).GT.900.)GOTO206
DO 207 J2=J3,NN
IF(DRI(J2,I).GT.900.)GOTO 207
IF(NW(J1,I).NE.NW(J2,I))GOTO 207
C SAME WIRE - KILL LONGER DRIFT
IF(DRI(J1,I).LT.DRI(J2,I))THEN
IKILL(J2,I)=-1
ELSE
IKILL(J1,I)=-1
ENDIF
207 CONTINUE
206 CONTINUE
205 CONTINUE
DO 208 I=NSS,NSS+NWIRES-1
NN=NDP(I)
IF(NN.LE.1)GOTO208
DO 209 J=1,NN
IF(IKILL(I,J).LT.0)THEN
DRI(I,J)=DRI(I,J)+1000.
ENDIF
209 CONTINUE
208 CONTINUE
ENDIF
C
C SUM WIRE HITS - ALL PLANES IN Z
DO 10 I=1,48
C CLUSTER SIZE
IWC(I)=0
10 CONTINUE
DO 20 IP=NSS,NSS+NWIRES-1
NN=NDP(IP)
IF(NN.EQ.0)GOTO20
DO 30 J=1,NN
IF(DRI(J,IP).GT.900.)GOTO30
C I=NW(J,IP)+1
C CHANGE 9/12/92
I=NW(J,IP)
IF(I.LT.1)I=1
IF(I.GT.48)I=48
IWC(I)=IWC(I)+1
IF(IWC(I).GT.KN)IWC(I)=KN
IRN(IWC(I),I)=J
IPN(IWC(I),I)=IP
30 CONTINUE
20 CONTINUE
C NOW HAVE STARTING CLUSTERS
C IWC= # HITS/WIRE
C WRITE(*,*)' CLUSTERS '
C PRINT 1000,IWC
1000 FORMAT((' ',24I3))
DO 40 I=1,48
IF(IWC(I).EQ.0)GOTO40
KK=IWC(I)
C CALL HFILL(70001,FLOAT(KK)+0.1,0.,1.)
C IRN = HIT #
CDEB PRINT 1001,IM,I,(IRN(K,I),K=1,KK)
C IPN = PLANE #
C PRINT 1002,IM,I,(IPN(K,I),K=1,KK)
1001 FORMAT(' CLUS IRN ',2I5,(2X,48I2))
1002 FORMAT(' CLUS IPN ',2I5,(2X,48I2))
40 CONTINUE
C SEARCH FOR LARGEST CLUSTER
500 CONTINUE
MAXC=0
IC=0
DO 50 I=1,48
IF(IWC(I).GT.MAXC)THEN
MAXC=IWC(I)
IC=I
ENDIF
50 CONTINUE
C IF(IC.NE.0)CALL HFILL(70002,FLOAT(MAXC)+0.1,0.,1.)
C WRITE(*,*)' CLUSTER FOUND IC,MAXC ',IC,MAXC
C CHECK FOR SUFFICIENT POINTS FOR LARGEST CLUSTER
IF(MAXC.LT.MINHTS)THEN
C FINISHED FOR THIS MODULE
GOTO999
ENDIF
CDEB WRITE(*,*)' ANALYSE FOUND CLUSTER IC,MAXC ',IC,MAXC
C CHECK MAX SIZE OF CLUSTER
IF(MAXC.GT.MAXCLU)THEN
IWC(IC)=-IWC(IC)
GO TO 500
ENDIF
*
*
* DIAGNOSTIC PLOTS FOR LOW MULTIPLICITY CLUSTERS ONLY
IDIAG=0
IF(MAXC.LE.20)IDIAG=1
C
CALL FTLISA(IRN(1,1),IPN(1,1),IWC(1),IC,MAXC,NSS,IM,IDIAG)
C
GOTO500
*
*
999 CONTINUE
* Make Tzero, Resolution and twin-peaks checksums.
IF(NTRAKS(IM).EQ.0)RETURN
IF(IPLOT.EQ.0)RETURN
DO 9000 I=1,NTRAKS(IM)
LL=0
FLL=0.
NCR=0
NWS=0
FNN=0.
DO 9100 J=1,12
C PLANE #
IP=J+NSS-1
C POINT #
NP=IRPT(J,I,IM)
YT(J)=0.
YS(J)=0.
NY(J)=0.
IF(NP.EQ.0)GOTO9100
FNN=FNN+1.
SGN=SDRFT(J,I,IM)
YT(J)=DRI(NP,IP)
YS(J)=SGN
NY(J)=NW(NP,IP)
IF(NWS.EQ.0)THEN
C STORE FIRST WIRE NUMBER AND DRIFT SIGN
NWS=NW(NP,IP)
SGNS=SDRFT(J,I,IM)
ENDIF
IF(NW(NP,IP).NE.NWS)GOTO9100
C KEEP TO SAME WIRE FOR DRIFT RESIDUAL
LL=LL+1
XX(LL)=ZP(IP)
YY(LL)=SGN*DRI(NP,IP)+DWS(NP,IP)
YN(LL)=RM(NP,IP)
IF(SGN.NE.SGNS)THEN
C SIGN CHANGE - STORE WIRE # AT FIRST CROSS
IF(NCR.EQ.0)WCROSS=FLOAT(J)+0.01
NCR=NCR+1
ENDIF
9100 CONTINUE
C T0 DETERMINATION - 8 WIRES
C CHECK 4 WIRES
DO 9010 K=0,4
C +++- AND ---+
IF(YS(K+1).EQ.0.)GOTO 9010
IF(YS(K+2).EQ.0.)GOTO 9010
IF(YS(K+3).EQ.0.)GOTO 9010
IF(YS(K+4).EQ.0.)GOTO 9010
C SAME WIRE
IF(NY(K+1).EQ.NY(K+2).AND.
1 NY(K+1).EQ.NY(K+3).AND.
1 NY(K+1).EQ.NY(K+4))THEN
IF(YS(K+1).EQ.YS(K+2).AND.
1 YS(K+1).EQ.YS(K+3).AND.
1 -YS(K+4).EQ.YS(K+1))THEN
TZ=0.5*(YT(K+2)+YT(K+3)+YT(K+4)-YT(K+1))
* T-zero...
ENDIF
C +--- AND -+++
IF(YS(K+2).EQ.YS(K+3).AND.
1 YS(K+2).EQ.YS(K+4).AND.
1 -YS(K+1).EQ.YS(K+2))THEN
TZ=0.5*(YT(K+1)+YT(K+2)+YT(K+3)-YT(K+4))
* T-zero...
ENDIF
C ++-- AND --++
IF(YS(K+1).EQ.YS(K+2).AND.
1 YS(K+3).EQ.YS(K+4).AND.
1 -YS(K+1).EQ.YS(K+3))THEN
TZV=0.25*(3.*(YT(K+2)+YT(K+3))-YT(K+1)-YT(K+4))
C CALL HFILL(90005,TZV,0.,1.)
C IF(TZV.GT.0.0)CALL HFILL(90015,TZV,0.,1.)
ENDIF
C ++++ AND ----
*
IF(YS(K+1).EQ.YS(K+2).AND.
1 YS(K+3).EQ.YS(K+4).AND.
1 YS(K+1).EQ.YS(K+3))THEN
* Twin peaks...
TZV=0.25*(3.*(YT(K+2)-YT(K+3))-YT(K+1)+YT(K+4))
* Resolution...
TZV=0.5*( (YT(K+4)+YT(K+1))-(YT(K+3)+YT(K+2)) )
ENDIF
ENDIF
9010 CONTINUE
C T0 DETERMINATION - 8 WIRES
C CHECK 5 WIRES TO ENSURE SAFE SIGN CHANGE 13/8/91
DO 9011 K=0,3
IF(YS(K+1).EQ.0.)GOTO 9011
IF(YS(K+5).EQ.0.)GOTO 9011
C +++-- AND ---++
C SAME WIRE
IF(NY(K+1).EQ.NY(K+2).AND.
1 NY(K+1).EQ.NY(K+3).AND.
1 NY(K+1).EQ.NY(K+4).AND.
1 NY(K+1).EQ.NY(K+5))THEN
IF(YS(K+1).EQ.YS(K+2).AND.
1 YS(K+1).EQ.YS(K+3).AND.
1 -YS(K+4).EQ.YS(K+1).AND.
1 -YS(K+5).EQ.YS(K+1))THEN
TZ=0.5*(YT(K+2)+YT(K+3)+YT(K+4)-YT(K+1))
C CALL HFILL(90004,TZ,0.,1.)
ENDIF
C ++--- AND --+++
IF(YS(K+3).EQ.YS(K+4).AND.
1 YS(K+3).EQ.YS(K+5).AND.
1 -YS(K+2).EQ.YS(K+3).AND.
1 -YS(K+1).EQ.YS(K+3))THEN
TZ=0.5*(YT(K+2)+YT(K+3)+YT(K+4)-YT(K+5))
C CALL HFILL(90004,TZ,0.,1.)
ENDIF
ENDIF
9011 CONTINUE
C NO SIGN CHANGE
C IF(LL.GE.4.AND.NCR.EQ.0)CALLHFILL(90002,0.01,0.,1.)
C SIGN CHANGE
C IF(LL.GE.4.AND.NCR.NE.0)CALLHFILL(90002,WCROSS,0.,1.)
FLL=LL
C FIT STR. LINE TO SEGMENT IF 4 OR MORE POINTS
IF(LL.LT.4)GOTO9000
CALL FTLFT(XX,YY,LL,0,AT,BT,EE)
CALL FTLFT(XX,YN,LL,0,AR,BR,ER)
C WRITE(*,*)' EE,ER',EE,ER
EE=SQRT(ABS(EE))
ER=SQRT(ABS(ER))
C RESIDUAL PLOT 18/7/92
DO 9200 LLL=1,LL
RESS=YY(LLL)-AT*XX(LLL)-BT
9200 CONTINUE
C CALL HFILL(90000,EE,0.,1.)
C CALL HFILL(90001,ER,0.,1.)
C RMS TO LINE SEGMENT DRIFT,RADIUS
C WRITE(*,*)' AT,XX(LL/2),BT',AT,XX(LL/2),BT,EE,ER
DA=AT*XX(LL/2)+BT
C DRIFT AT CENTRE OF LINE SEG
9000 CONTINUE
9009 CONTINUE
RETURN
END
*
*
* Small farm mod by ?
* add SEQ BOSMDL so above might work
* initialise RR (else DDMIN*RR test might fail?
*
C 21/01/93 301211908 MEMBER NAME FTLISAA (FILE46) FVS
C 06/01/93 301081132 MEMBER NAME FTLISA5 (FILE46) FVS
C 08/12/92 301061503 MEMBER NAME FTLISA2 (FILE46) FVS
C 06/12/92 212081044 MEMBER NAME FTLISA (GRAPHICS) FVS
C 04/12/92 212061354 MEMBER NAME LISALIB (FILE46) FVS
C 28/11/92 212011534 MEMBER NAME FTLISA (FILE46) FVS
C 28/11/92 211281327 MEMBER NAME FTLISA (GRAPHICS) FVS
C 13/11/92 211281108 MEMBER NAME FTLSEGO (GRAPHICS) FVS
C 13/11/92 MEMBER NAME FTLSEGO (FILE46) FVS
C 04/12/91 MEMBER NAME NEWSEG (FILE46) FVS
C FROM FILE46(GRFTRAC2)
C
C 13/11/92
C ADD SLOPE CHECK ON TRIPLES - SELECT MINIMUM SLOPE
C REMOVE EXTRAPOLATION IN PHI
C RCUT ---> 20 CMS
C SLCUT---> 0.1
C TSCUT---> 0.08 (WAS 0.1)
C DMINX---> 0.15 (WAS 0.2)
C
C PROJECTION CUT WITH DMINX
C VERSION FOR TRACK FINDING IN CLUSTER BY TRIPLES