*-- Author : Stephen Burke 07/05/92
SUBROUTINE FVZFIT
*-----------------------------------------Updates 21/09/93-------
**: FVZFIT.......SB. Ignore CT z-vertex if z=0.0.
*-----------------------------------------Updates 07/09/93-------
**: FVZFIT 40000 SB. Don't make a z-vertex if error is too big.
*-----------------------------------------Updates 26/07/93-------
**: FVZFIT 30907 SB. Change monitoring histograms.
**: FVZFIT 30907 RP. Farm changes.
*-----------------------------------------Updates 13/10/92-------
**: FVZFIT 30907 SB. Compare FT with CT z-vertex.
*-----------------------------------------Updates 29/07/92-------
**: FVZFIT 30907 SB. New monitoring histograms.
*-----------------------------------------Updates 06/05/92-------
**: FVZFIT 30907 SB. Bank FTGR added to the E-list:
*!: FTGR 30907 SB. New bank with forward z-vertex.
**: FVZFIT 30907 SB. New deck to perform forward z-vertex fit.
*-----------------------------------------Updates----------------
**********************************************************************
* *
* Fit a z-vertex from forward tracks *
* *
* Makes FTGR/FTGX banks: *
* *
* ! *
* TABLE FTGR ! z-vertex from forward tracks *
* ! *
* ! ATTributes: *
* ! ----------- *
* !COL ATT-name FMT Min Max ! Comments *
* ! *
* 1 Z F -200. 200. ! z *
* 2 dZ F 0. 200. ! sigma(z) *
* 3 CHISQ F 0. INF ! Chi-squared *
* 4 NDF I 0 INF ! (Number of tracks used) - 1 *
* ! *
* ! RELations: *
* ! ---------- *
* !COL REL.bank TYPE INT.bank !Comments *
* ! (COL) *
* ! *
* ! *
* END TABLE *
* *
* ! *
* TABLE FTGX ! pointers from FTGR to FTKR *
* ! *
* ! ATTributes: *
* ! ----------- *
* !COL ATT-name FMT Min Max ! Comments *
* ! *
* ! *
* ! RELations: *
* ! ---------- *
* !COL REL.bank TYPE INT.bank !Comments *
* ! (COL) *
* ! *
* 62 FTKR D1T1 ! FTKR tracks giving vertex *
* ! *
* ! FTGX is a list of all FTKR tracks used to create the FTGR *
* ! vertices. Note that there is no pointer from FTGR to FTGX, *
* ! so it is necessary to use the NDF values to calculate the *
* ! pointers. *
* ! *
* END TABLE *
* *
**********************************************************************
DIMENSION FVVEC(4)
LOGICAL LPRIM
SAVE LPRIM,IRUN,ZBEAZ
*KEEP,FVSTEE.
LOGICAL LTRUTH,LCUT,LRESID
COMMON /FVSTEE/ IDIAG,LUN,LUNHB,LTRUTH,LCUT,LRESID
*KEEP,FVPAR.
DOUBLE PRECISION ZWALL1,ZWALL2,RADLEN
COMMON /FVPAR/ ZWALL1,ZWALL2,RADLEN,MINHTP,MINHTR,ZSQMAX
&, PMIN,DCAMAX,Z0MAX,CHIMAX
*KEEP,FVSCAL.
* Various counters
PARAMETER (NSCAL=16)
COMMON /FVSCAL/ NNEVNT,NNVTX,NNFTKR,NNXTR,NNFIT,NNOUT,NNSIN
&, NNFTKP,NNXTRP,NNFITP,NNOUTP,NNSINP
&, NNVTXC,NNSINC,NNFVNC,NNFSNC
*KEEP,FVWBI.
* Work bank indices
PARAMETER (NFVWBI=2)
COMMON /FVWBI/ INFTPR,INFVWK
*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 ------
*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.
DATA LPRIM/.TRUE./,IRUN/-999999/,ZBEAZ/0./
**********************************************************************
INFTKR = NLINK('FTKR',0)
IF (INFTKR.LE.0) THEN
CALL ERRLOG(511,'S:FVZFIT: FTKR bank not found')
RETURN
ENDIF
* Count events
NNEVNT = NNEVNT + 1
* Zero work bank index
INFVWK = 0
* Quick check to see if there are any forward tracks
NFTKR = IW(INFTKR+2)
IF (NFTKR.LE.0) GOTO 8000
* Create a work bank to store z values and weights
CALL WBANK(IW,INFVWK,NFTKR,*9000)
CALL HCDIR('//PAWC/FVFIT',' ')
* Write primary/secondary flag into word 7 (IPTYPE)
IF (LTRUTH) CALL FVTRUE(INFTKR)
* Get the nominal z-vertex
IMC = JRDATA('RUNTYPE',STATUS)
INOSVX = 0
INBEAZ = 0
IF (IMC.GT.0) THEN
INOSVX = NLINK('SIPA',0)
ELSEIF (IRUN.NE.NCCRUN) THEN
IRUN = NCCRUN
INBEAZ = IABS(MDB('BEAZ'))
IF (INBEAZ.GT.0) ZBEAZ = RW(INBEAZ +2 +2)
ENDIF
ZNOM = 0.
IF (INOSVX.GT.0) THEN
IF(IW(INOSVX).GE.22) ZNOM = RW(INOSVX+21)+RW(INOSVX+22)
ELSE
ZNOM = ZBEAZ
ENDIF
*
* Loop over forward tracks, and calculate z0
*
DO 100 JFT=1,NFTKR-1,2
IF (LTRUTH) LPRIM = IBTAB(INFTKR,7,JFT).EQ.0
NNFTKR = NNFTKR + 1
IF (LPRIM) NNFTKP = NNFTKP + 1
* Extrapolate to vertex region and calculate z0 and weight
CALL FVXTRP(RW(INDCR(INFTKR,1,JFT)),ZNOM,LPRIM,Z0,WZ0,IFAIL)
IF (IFAIL.EQ.0) THEN
* Store in work bank
RW(INFVWK+JFT) = Z0
RW(INFVWK+JFT+1) = WZ0
NNFIT = NNFIT + 1
IF (LPRIM) NNFITP = NNFITP + 1
ELSE
* If the weight is zero, the track will be ignored
RW(INFVWK+JFT+1) = 0.
ENDIF
100 CONTINUE
* Take the weighted mean of the z values
CALL FVZWM(INFTKR,NFTKR,ZNOM,.TRUE.,FVVEC,IFAIL)
IF (IFAIL.NE.0) THEN
CALL SHS(21,0,0.)
GOTO 8000
ENDIF
* Create the FTGR bank ...
INFTGR = NBANK('FTGR',0,6)
IF (INFTGR.LE.0) THEN
CALL ERRLOG(512,'S:FVZFIT: Unable to create FTGR')
GOTO 9500
ENDIF
* ... and fill it
NVERT = 1
IW(INFTGR+1) = 4
IW(INFTGR+2) = NVERT
CALL UCOPY(FVVEC,IW(INFTGR+3),4)
CALL BLIST(IW,'E+','FTGR')
CALL BLIST(IW,'E+','FTGX')
* Monitoring histograms
CHISQ = RBTAB(INFTGR,3,1)
NDF = IBTAB(INFTGR,4,1)
CALL SHS(21,0,FLOAT(NDF+1))
CALL SHS(22,0,FVVEC(1))
CALL SHS(23,0,FVVEC(2))
IF (CHISQ.GT.0. .AND. NDF.GT.0) THEN
CHPROB = PROB(CHISQ,NDF)
CALL SHS(24,0,CHISQ/FLOAT(NDF))
CALL SHS(25,0,CHPROB)
ELSE
CALL SHS(24,0,-1.)
CALL SHS(25,0,-1.)
ENDIF
* Compare with the CxKV z-vertex
INCXKV = NLINK('CTKV',0)
IF (INCXKV.LE.0) INCXKV = NLINK('CJKV',0)
JPRIM = 0
IF (INCXKV.GT.0) THEN
NCXKV = IW(INCXKV+2)
DO 200 JCXKV=1,NCXKV
IF (IBTAB(INCXKV,9,JCXKV).EQ.1 .AND. JPRIM.LE.0)
& JPRIM = JCXKV
200 CONTINUE
IF (JPRIM.GT.0) THEN
CTZ = RBTAB(INCXKV,3,JPRIM)
IF (CTZ.NE.0.0) THEN
CALL SHS(28,0,FVVEC(1)-CTZ)
IF (FVVEC(2).GT.0.)
& CALL SHS(29,0,(FVVEC(1)-CTZ)/FVVEC(2))
ENDIF
ENDIF
ENDIF
IF (JPRIM.LE.0) THEN
NNFVNC = NNFVNC + 1
IF (NDF.EQ.0) NNFSNC = NNFSNC + 1
ENDIF
NNVTX = NNVTX + 1
NNOUT = NNOUT + NDF + 1
IF (LRESID) CALL FVCHEK(FVVEC)
* Now do "secondary" vertices
300 CONTINUE
CALL FVZWM(INFTKR,NFTKR,ZNOM,.FALSE.,FVVEC,IFAIL)
IF (IFAIL.EQ.0) THEN
NVERT = NVERT + 1
INFTGR = NBANK('FTGR',0,2+4*NVERT)
IF (INFTGR.LE.0) THEN
CALL ERRLOG(513,'S:FVZFIT: Unable to extend FTGR bank')
GOTO 9500
ENDIF
IW(INFTGR+2) = NVERT
CALL UCOPY(FVVEC,IW(INDCR(INFTGR,1,NVERT)),4)
* Monitoring histograms
CHISQ = RBTAB(INFTGR,3,NVERT)
NDF = IBTAB(INFTGR,4,NVERT)
CALL SHS(41,0,FLOAT(NDF+1))
CALL SHS(42,0,FVVEC(1))
CALL SHS(43,0,FVVEC(2))
IF (CHISQ.GT.0. .AND. NDF.GT.0) THEN
CHPROB = PROB(CHISQ,NDF)
CALL SHS(44,0,CHISQ/FLOAT(NDF))
CALL SHS(45,0,CHPROB)
ELSE
CALL SHS(44,0,-1.)
CALL SHS(45,0,-1.)
ENDIF
GOTO 300
ENDIF
9500 CONTINUE
* Truncate FTGX
INFTGX = NLINK('FTGX',0)
IF (INFTGX.GT.0) INFTGX = NBANK('FTGX',0,2+IW(INFTGX+2))
* Make sure work banks are dropped!
CALL WDROP(IW,INFVWK)
IF (LTRUTH) THEN
* Reset IPTYPE to 2
DO 400 JFT=1,NFTKR-1,2
IW(INDCR(INFTKR,7,JFT)) = 2
400 CONTINUE
ENDIF
*
* Some CT diagnostics
*
INCJKT = NLINK('CJKT',0)
INCXKV = NLINK('CTKV',0)
IF (INCXKV.LE.0) INCXKV = NLINK('CJKV',0)
IF (INCXKV.LE.0 .OR. INCJKT.LE.0) RETURN
JPRIM = 0
NCXKV = IW(INCXKV+2)
DO 500 JCXKV=1,NCXKV
IF (IBTAB(INCXKV,9,JCXKV).EQ.1 .AND. JPRIM.LE.0) JPRIM = JCXKV
500 CONTINUE
IF (JPRIM.LE.0) RETURN
NZTRK = 0
NCJKT = IW(INCJKT+2)
DO 600 JCJKT=1,NCJKT
IF (IBTAB(INCJKT,13,JCJKT).EQ.JPRIM) NZTRK = NZTRK + 1
600 CONTINUE
IF (NZTRK.EQ.1) NNSINC = NNSINC + 1
IF (NZTRK.GT.0) NNVTXC = NNVTXC + 1
IF (.NOT.LRESID) RETURN
INSVX = NLINK('SVX ',0)
IF (INSVX.LE.0) THEN
CALL ERRLOG(514,'W:FVZFIT: No SVX bank')
RETURN
ENDIF
JPSVX = 0
NSVX = IW(INSVX+2)
DO 700 JVX=NSVX,1,-1
IF (IBTAB(INSVX,4,JVX).EQ.1) JPSVX = JVX
700 CONTINUE
IF (JPSVX.LE.0) THEN
CALL ERRLOG(515,'W:FVZFIT: No primary vertex!')
RETURN
ENDIF
DZ = RBTAB(INCXKV,3,JPRIM) - RBTAB(INSVX,3,JPSVX)
CALL HFILL(100,DZ,0.,1.)
RETURN
8000 CONTINUE
* The FTGR bank must exist if possible
INFTGR = NLINK('FTGR',0)
IF (INFTGR.LE.0) THEN
INFTGR = NBANK('FTGR',0,2)
IF (INFTGR.GT.0) THEN
IW(INFTGR+1) = 4
IW(INFTGR+2) = 0
CALL BLIST(IW,'E+','FTGR')
ELSE
CALL ERRLOG(516,'S:FVZFIT: Unable to create FTGR bank')
ENDIF
ENDIF
INFTGX = NLINK('FTGX',0)
IF (INFTGR.GT.0 .AND. INFTGX.LE.0) THEN
INFTGX = NBANK('FTGX',0,2)
IF (INFTGX.GT.0) THEN
IW(INFTGX+1) = 1
IW(INFTGX+2) = 0
CALL BLIST(IW,'E+','FTGX')
ELSE
CALL ERRLOG(517,'S:FVZFIT: Unable to create FTGX bank')
ENDIF
ENDIF
GOTO 9500
9000 CONTINUE
CALL ERRLOG(518,'S:FVZFIT: Work bank creation failed')
RETURN
END
*