*-- Author : S.Burke
SUBROUTINE FFTRCH
*-----------------------------------------Updates 07/09/93-------
**: FFTRCH 40000 SB. New definition of dead wire flag.
*-----------------------------------------Updates 03/05/93-------
**: FFTRCH 40000 SB. Check for dead wires and hits with no digi.
**: FFTRCH 40000 SB. Reinstate missing track histograms.
*-----------------------------------------Updates----------------
**********************************************************************
* *
* Histogram the length of tracks which are not found by the patrec *
* *
* NB Histograms are booked in FFHBK *
* *
**********************************************************************
*KEEP,FKNPL.
CHARACTER*5 CKDBG
PARAMETER (CKDBG='FKDBG')
PARAMETER (NPL=72)
LOGICAL LTRUE,LFIRST,LTRPL,LTRPLD
DOUBLE PRECISION TRUE,RTRUE,CHITRU,SPRO,CPRO,SFIL,CFIL
&, SSMT,CSMT,SSMTR,CSMTR,DPRO,CBPRO,QPRO,QGAIN
&, RPRO,CRPRO,RFIL,CRFIL,RSMT,CRSMT,CHIFIL,CHISMT
*
* Per-track values can go in H1WORK; note that LTRUE and LFIRST must
* be set at least per event.
*
* This is about 36k words long; the remaining common blocks are
* about 3.6k in total. Some of this could be in /H1WORK/, but the
* blocks would have to be reorganised.
*
COMMON /H1WORK/
* /FKPROJ/
& SPRO(5,NPL),CPRO(5,5,NPL)
* /FKFILT/
&, SFIL(5,NPL),CFIL(5,5,NPL)
* /FKSMTH/
&, SSMT(5,NPL),CSMT(5,5,NPL)
&, SSMTR(5,NPL),CSMTR(5,5,NPL)
* /FKINT/
&, DPRO(5,5,NPL),CBPRO(5,5,NPL),QPRO(5,5,NPL)
&, QGAIN(5,5,NPL),IAPROX,LFIRST
* /FKRSID/
&, RPRO(2,NPL),CRPRO(2,2,NPL),RFIL(2,NPL)
&, CRFIL(2,2,NPL),RSMT(2,NPL),CRSMT(2,2,NPL)
&, CHIFIL(NPL),CHISMT(NPL)
* /FKTRUE/
&, TRUE(5,NPL),RTRUE(5,NPL),CHITRU(NPL),LTRUE
* /FKDBG/
&, LTRPL(NPL),LTRPLD(NPL)
*KEEP,FFGEO.
COMMON /FFGEO/ INDG1(2),INDLC(2),IDIGI(NPL)
*KEEP,FFWBI.
* Work bank indices (note that INDKTR is *NOT* a work bank index!)
PARAMETER (NWBI=10)
COMMON /FFWBI/ INDRSX(2),INDX(2),INDKX(2),INDPUR
&, INDKTR,INDKTX,INDTPR
*KEEP,FFDBG.
CHARACTER*5 CFDBG
CHARACTER*6 CFKDBG
PARAMETER (CFDBG='FFDBG',CFKDBG='FFKDBG')
PARAMETER (NTRACK=1000)
COMMON /FFDBG/ ITRTR(2,NTRACK),ITRNF(5,NTRACK),JTRTR
*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,STFUNCT.
* index of element before row number IROW
INDR(IND,IROW)=IND+2+IW(IND+1)*(IROW-1)
* index of L'th element of row number IROW
INDCR(IND,L,IROW)=INDR(IND,IROW) + L
* L'th integer element of the IROW'th row of bank with index IND
IBTAB(IND,L,IROW)=IW(INDCR(IND,L,IROW))
* L'th real element of the IROW'th row of bank with index IND
RBTAB(IND,L,IROW)=RW(INDCR(IND,L,IROW))
*KEND.
**********************************************************************
CALL VZERO(ITRNF,5*NTRACK)
INDSTR = NLINK('STR ',0)
IF (INDSTR.LE.0) RETURN
IF (INDRSX(1).GT.0) THEN
NHITP = IW(INDRSX(1)+2)
ELSE
NHITP = 0
ENDIF
IF (INDRSX(2).GT.0) THEN
NHITR = IW(INDRSX(2)+2)
ELSE
NHITR = 0
ENDIF
IF (NHITP.LE.0 .AND. NHITR.LE.0) RETURN
NTR = 0
DO 400 JHIT=1,NHITP
IF (IBTAB(INDRSX(1),1,JHIT).GE.512) GOTO 400
JSTR = IBTAB(INDRSX(1),2,JHIT)
JTR = 0
100 CONTINUE
JTR = JTR + 1
ITR = ITRTR(1,JTR)
IF (ITR.GT.0 .AND. ITR.NE.JSTR
& .AND. JTR.LT.NTRACK) GOTO 100
IF (ITR.EQ.JSTR) GOTO 400
JDIG = IBTAB(INDRSX(1),3,JHIT)
IF (JDIG.LE.0) GOTO 400
* Check for dead wire
ICELL = IBTAB(INDLC(1),1,JDIG)
IF (IBTAB(INDG1(1),1,ICELL+1).EQ.1) GOTO 400
JPX = 0
200 CONTINUE
JPX = JPX + 1
IDIG = IBTAB(INDX(1),1,JPX)
IF (IDIG.NE.JDIG .AND. JPX.LT.IW(INDX(1)+2)) GOTO 200
JTR = 0
300 CONTINUE
JTR = JTR + 1
ITR = ITRNF(1,JTR)
IF (ITR.GT.0 .AND. ITR.NE.JSTR
& .AND. JTR.LT.NTRACK) GOTO 300
IF (ITR.LE.0) THEN
NTR = NTR + 1
ITRNF(1,JTR) = JSTR
ITRNF(2,JTR) = 1
IF (IBTAB(INDSTR,7,JSTR).LE.0) ITRNF(4,JTR) = 1
IF (IDIG.EQ.JDIG) ITRNF(5,JTR) = 1
ELSEIF (ITR.EQ.JSTR) THEN
ITRNF(2,JTR) = ITRNF(2,JTR) + 1
IF (IBTAB(INDSTR,7,JSTR).LE.0)
& ITRNF(4,JTR) = ITRNF(4,JTR) + 1
IF (IDIG.EQ.JDIG) ITRNF(5,JTR) = ITRNF(5,JTR) + 1
ENDIF
400 CONTINUE
DO 800 JHIT=1,NHITR
IFLAG = IBTAB(INDRSX(2),1,JHIT)
IF (IFLAG.GE.512) GOTO 800
JSTR = IBTAB(INDRSX(2),2,JHIT)
JTR = 0
500 CONTINUE
JTR = JTR + 1
ITR = ITRTR(1,JTR)
IF (ITR.GT.0 .AND. ITR.NE.JSTR
& .AND. JTR.LT.NTRACK) GOTO 500
IF (ITR.EQ.JSTR) GOTO 800
JDIG = IBTAB(INDRSX(2),3,JHIT)
IF (JDIG.LE.0) GOTO 800
* Check for dead wire
ICELL = IBTAB(INDLC(2),1,JDIG)
IDEAD = IBTAB(INDG1(2),1,ICELL+1)
IWEDG = JBIT(IFLAG,2)
IF (IDEAD.EQ.1 .OR. IDEAD.EQ.IWEDG) GOTO 800
JRX = 0
600 CONTINUE
JRX = JRX + 1
IDIG = IBTAB(INDX(2),1,JRX)
IF (IDIG.NE.JDIG .AND. JRX.LT.IW(INDX(2)+2)) GOTO 600
JTR = 0
700 CONTINUE
JTR = JTR + 1
ITR = ITRNF(1,JTR)
IF (ITR.GT.0 .AND. ITR.NE.JSTR
& .AND. JTR.LT.NTRACK) GOTO 700
IF (ITR.LE.0) THEN
NTR = NTR + 1
ITRNF(1,JTR) = JSTR
ITRNF(3,JTR) = 1
IF (IBTAB(INDSTR,7,JSTR).LE.0) ITRNF(4,JTR) = 1
IF (IDIG.EQ.JDIG) ITRNF(5,JTR) = 1
ELSEIF (ITR.EQ.JSTR) THEN
ITRNF(3,JTR) = ITRNF(3,JTR) + 1
IF (IBTAB(INDSTR,7,JSTR).LE.0)
& ITRNF(4,JTR) = ITRNF(4,JTR) + 1
IF (IDIG.EQ.JDIG) ITRNF(5,JTR) = ITRNF(5,JTR) + 1
ENDIF
800 CONTINUE
CALL HFILL(331,FLOAT(NTR),0.,1.)
IF (NTR.LE.0) RETURN
DO 900 JTR=1,NTR
NHITP = ITRNF(2,JTR)
NHITR = ITRNF(3,JTR)
NHITPR = ITRNF(4,JTR)
NFOUND = ITRNF(5,JTR)
PTRK = VMOD(IW(INDCR(INDSTR,1,ITRNF(1,JTR))),3)
CALL HFILL(332,FLOAT(NHITP),0.,1.)
CALL HFILL(333,FLOAT(NHITR),0.,1.)
CALL HFILL(334,PTRK,0.,1.)
IF (NHITPR.GT.0) THEN
CALL HFILL(335,FLOAT(NHITPR),0.,1.)
CALL HFILL(336,PTRK,0.,1.)
ENDIF
C IF (NHITPR.GT.36) CALL HFILL(347,PTRK,0.,1.)
C CALL HFILL(348,FLOAT(NFOUND),0.,1.)
C CALL HFILL(349,FLOAT(NFOUND)/FLOAT(NHITP+NHITR),0.,1.)
900 CONTINUE
RETURN
END
*