*-- Author : Stephen Burke 07/05/92
SUBROUTINE FVXTRP(FTVEC,ZNOM,LPRIM,Z0,WZ0,IERR)
*-----------------------------------------Updates 07/09/93-------
**: FVXTRP 40000 SB. Fix bug in xy vertex histos.
*-----------------------------------------Updates 26/07/93-------
**: FVXTRP 30907 SB. Change monitoring histograms.
**: FVXTRP 30907 RP. Farm changes.
*-----------------------------------------Updates 30/10/92-------
**: FVXTRP 30907 SB. Separate cut on # of radial and planar hits.
**: FVXTRP 30907 SB. New debug histograms and numbers.
*-----------------------------------------Updates 03/08/92-------
**: FVXTRP 30907 SB. Redundant calls to FKNORM removed.
*-----------------------------------------Updates 29/07/92-------
**: FVXTRP 30907 SB. Serious bugs fixed; xy histogram added.
*-----------------------------------------Updates 02/06/92-------
**: FVXTRP 30907 SB. Protect against divide by 0.
*-----------------------------------------Updates 06/05/92-------
**: FVXTRP 30907 SB. New deck to extrapolate tracks to vertex.
*-----------------------------------------Updates----------------
**********************************************************************
* *
* Extrapolate a forward track to the vertex region, and return z0 *
* *
* ERROR CONDITIONS; *
* IERR = 0 ; normal termination *
* -> IERR = 101 ; parameters not at track start (code error) *
* IERR = 2 ; too few hits *
* IERR = 3 ; initial z0 too large *
* IERR = 4 ; momentum too small *
* IERR = 5 ; too far from xy vertex (dca) *
* IERR = 6 ; too far from xy vertex (z0) *
* *
* -> Fatal errors *
* *
* The output parameters are undefined after an error. *
* *
* INPUT; *
* FTVEC - FT-type (parameterisation 2) track vector *
* ZNOM - the nominal z-vertex position *
* LPRIM - .TRUE. if track is a primary (used for diagnostics) *
* *
* OUTPUT; *
* Z0 - z0 of extrapolated track *
* WZ0 - 1/(error on z0)**2 *
* *
**********************************************************************
DIMENSION FTVEC(21)
LOGICAL LPRIM
DIMENSION FTROT(16),CTV(5),CTC(5,5)
DOUBLE PRECISION S1(5),C1(5,5),S2(5),C2(5,5),DTRAN(5,5),QMS(5,5)
DOUBLE PRECISION Z,DZ
*KEEP,FKPIDP.
DOUBLE PRECISION PI,TWOPI,PIBY2
PARAMETER (PI=3.141592653589793238)
PARAMETER (TWOPI=PI*2.0D0,PIBY2=PI/2.0D0)
*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,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/
*KEND.
**********************************************************************
IERR = 0
CALL UCOPY(FTVEC(19),NX,1)
IF (NX.LE.0) THEN
CALL ERRLOG(541,'F:FVXTRP: Not a starting parameterisation')
IERR = 101
RETURN
ENDIF
*
* Initial selection criteria
*
CALL UCOPY(FTVEC(20),NHIT,1)
NRAD = NHIT/(256*256*256)
NPLAN = NHIT/(256*256) - NRAD*256
IF (NPLAN.LT.MINHTP .OR. NRAD.LT.MINHTR) IERR = 2
*
* This is supposed to be a rough (straight line) estimate of the
* z0, for a quick initial cut (was bugged, hope it's right now)
*
IF (FTVEC(3).GT.1.0E-10) THEN
XCP = FTVEC(4)*COS(FTVEC(2))
YSP = FTVEC(5)*SIN(FTVEC(2))
Z0EST = FTVEC(6) - (XCP + YSP)/TAN(FTVEC(3))
ZSQ = Z0EST*Z0EST
ELSE
ZSQ = 1.0E20
ENDIF
IF (ZSQ.GT.ZSQMAX) IERR = 3
IF (LCUT) THEN
IF (LPRIM) THEN
CALL HFILL(201,FLOAT(NPLAN),0.,1.)
CALL HFILL(203,FLOAT(NRAD),0.,1.)
CALL HFILL(205,ZSQ,0.,1.)
ELSE
CALL HFILL(202,FLOAT(NPLAN),0.,1.)
CALL HFILL(204,FLOAT(NRAD),0.,1.)
CALL HFILL(206,ZSQ,0.,1.)
ENDIF
ENDIF
IF (IERR.GT.0) RETURN
* Allow for a relative rotation/shift between CT and FT
CALL KTROT(FTVEC,FTROT)
* Convert into KF internal format
CALL FKETOI(FTROT,S1,C1)
IF (ABS(S1(3)).GT.1.0D-15) THEN
PMOM = ABS(1.0D0/S1(3))
ELSE
PMOM = SIGN(1.0D15,S1(3))
ENDIF
IF (LCUT .AND. LPRIM) CALL HFILL(207,PMOM,0.,1.)
IF (LCUT .AND. .NOT.LPRIM) CALL HFILL(208,PMOM,0.,1.)
IF (PMOM.LT.PMIN) THEN
IERR = 4
RETURN
ENDIF
NNXTR = NNXTR + 1
IF (LPRIM) NNXTRP = NNXTRP + 1
* Swim to end wall
Z = FTROT(6)
DZ = ZWALL2 - Z
CALL FKTRAN(DZ,Z,S1,S2,DTRAN)
CALL FKMUL(C1,DTRAN,C2)
* Allow for multiple scattering in the end wall
DZ = ZWALL1 - ZWALL2
CALL FKTRAN(DZ,ZWALL2,S2,S1,DTRAN)
CALL FKMUL(C2,DTRAN,C1)
CALL FKSCAT(DZ,S2,RADLEN,DTRAN,QMS)
CALL FKQADD(C1,QMS)
* Swim to (notional) vertex
DZ = ZNOM - ZWALL1
CALL FKTRAN(DZ,ZWALL1,S1,S2,DTRAN)
CALL FKMUL(C1,DTRAN,C2)
* Convert to external (IPTYPE 2) format
CALL KTITOE(DBLE(ZNOM),S2,C2,S1,C1)
* Convert to IPTYPE 1 format
CALL KTFTCT(S1,C1,DBLE(ZNOM),CTV,CTC)
DCA = ABS(CTV(4))
Z0 = CTV(5)
IF (CTC(5,5).GT.0.) THEN
WZ0 = 1./CTC(5,5)
ELSE
WZ0 = 0.
ENDIF
IF (LCUT) THEN
IF (LPRIM) THEN
CALL HFILL(209,DCA,0.,1.)
CALL HFILL(211,Z0,0.,1.)
ELSE
CALL HFILL(210,DCA,0.,1.)
CALL HFILL(212,Z0,0.,1.)
ENDIF
ENDIF
IF (DCA.GT.DCAMAX) IERR = 5
IF (ABS(Z0-ZNOM).GT.Z0MAX) IERR = 6
* Fill monitoring histograms
CALL SHS(26,0,DCA)
CALL SHS(27,0,Z0)
IF (IERR.NE.0) RETURN
*
* Monitor the xy-vertex
*
PHIBYT = 0.5
ZBYT = 15.
IF (ABS(Z0-ZNOM).GT.2.0*ZBYT) RETURN
DZ = Z0 - ZNOM
CALL FKTRAN(DZ,DBLE(ZNOM),S2,S1,DTRAN)
PHI = S1(5)
IF (PHI.GT.PI) PHI = PHI - PI
IF (PHI.GT.PIBY2-PHIBYT .AND. PHI.LT.PIBY2+PHIBYT) THEN
IF (Z0-ZNOM.LT.-ZBYT) THEN
CALL SHS(30,0,SNGL(S1(1)))
ELSEIF (Z0-ZNOM.LT.ZBYT) THEN
CALL SHS(31,0,SNGL(S1(1)))
ELSE
CALL SHS(32,0,SNGL(S1(1)))
ENDIF
ENDIF
IF (PHI.LT.PHIBYT .OR. PHI.GT.PI-PHIBYT) THEN
IF (Z0-ZNOM.LT.-ZBYT) THEN
CALL SHS(33,0,SNGL(S1(2)))
ELSEIF (Z0-ZNOM.LT.ZBYT) THEN
CALL SHS(34,0,SNGL(S1(2)))
ELSE
CALL SHS(35,0,SNGL(S1(2)))
ENDIF
ENDIF
RETURN
END
*