C 27/11/89 108291236 MEMBER NAME VXMAIN (ES) FVS
C 22/06/84 512112012 MEMBER NAME VXMAIN (ES) FORTRAN
SUBROUTINE VXMAIN
C=====================================================================
C MAIN (SUB)ROUTINE FOR FINDING VERTICES
C---------------------------------------------------------------------
C INPUT : KLOE OFFICIAL TRACK BANKS
C CFLAGS
C CVXCUT
C OUTPUT: TRACK BANKS, VERTEX BANKS, AND VERTEX PTRS
C---------------------------------------------------------------------
C INTERMEDIATE STORAGE: APPROX 12.0K IN /CWORK/
C---------------------------------------------------------------------
C AVAILABLE CUTS (FROM SUBROUTINE INCUTS) :
C
C CMD SUBROUTINE ACTION IS TO CHANGE THE
C AFFECTED
C ITRF VXXYZ MAX NUM OF ITERATIONS FOR THE VERTEX FIT
C ITRS VXSWIM MAX NUM OF ITERATIONS FOR SWIM TO A LINE
C ICLL VXMAIN DEBUG OPTION TO RETURN AFTER ICLL = N
C CALLS TO VXXYZ. NO DEBUG FOR ICLL=-1
C IBRP VXSWIM,VXTKIN DEBUG OPTION TO SHOW ON IPS TERMINAL
C THE TRACK SWUM TO INNER DC WALL (IBRP=2)
C OR SWUM TO THE BEAM TUBE (IBRP=3)
C NO DEBUG FOR IBRP = -1
C XXX ITRK VXSWIM NO CURRENT FUNCTION
C
C DRMX VXMAIN MAX R ALLOWED FROM INTERSECTION (RETURNED
C BY VXCRSS) FOR A TRK TO BE INCLUDED IN FIT
C SWCR VXMAIN MAX R FROM BEAMLINE ALLOWED FOR COLINEAR
C TRK CANDIDATES GOING INTO CONSTRAINED FIT
C SWCZ VXMAIN SAME AS ABOVE BUT FOR Z
C CHGM VXXYZ MINIMUM MAGITUDE FOR CHISQ CORRECTION
C DVMX VXPREP MAX DEVIATION FOR A GOOD TRK
C CURRENT VALUE IS 7. (NOT STD BUT RELATED)
C DLTR VXXYZ MAX SIZE FOR R CORRECTION VECTOR
C DLTZ VXXYZ MAX SIZE FOR Z CORRECTION VECTOR
C CTWR VXPREP R WEIGHT FOR CONSTRAINT TRK (CONSTR FIT)
C CTWZ VXPREP Z WEIGHT FOR CONSTRAINT TRK (CONSTR FIT)
C CRSZ VXCRSS Z CUT FOR REJECTING A POSSIBLE INTERSECTION
C STEP VXSWIM STEP SIZE FOR TRACK SWIMMING(IN CM)
C ACOL VXMAIN COS OF (PI-MAX DEV) FOR COLLINEAR TRKS
C WHERE MAX DEV IS ANGLE CUT FOR COLLINEARITY
C CERR VXXYZ NEGATE THE FIT IF THE REPORTED ERRORS
C ARE TOO BIG. ERROR IN X OR Y .LT. CERR
C ERROR IN Z .LT. 6*CERR.
C CTOL VXCRSS TOLERANCE FOR DECIDING WHEN TWO CIRCLES ARE
C TANGENT
C DXY VXMAIN MAX R FROM BEAMLINE FOR RC VX 10
C DZ VXMAIN MAX Z FROM BEAMLINE FOR RC VX 10
C---------------------------------------------------------------------
C --- D. COPPAGE --- VERSION 04.10.83 V3.00 (ARG05)
C REVISED 13.01.84 V3.01 (ARG06)NOW SWIMS 1 PRONGS
C REVISED 27.01.84 V3.02
C PROPOSD 15.04.84 V3.03 CHANGES IN CONV GAM PROC
C VERSION 18.05.84 V4.00 ARG07 (INCOMPATIBLE ARG06)
C 27.06.84 V4.02 ARG07
C 31.07.84 V4.03 ARG07
C 22.01.85 V4.04 ARG08 NAT DEDX FOR CONV GMA
C 24.04.85 V4.10 ARG09 MOD FOR VDC
C 18.06.85 V4.11 UNDRFL IN BHBH SEC FIXED
C --- GILKINSON ---- CHANGED COTANGENT CALCULATION TO SIGN IF PZ = 0
C 13/12/85
C --- HKAP --------- GENERAL CLEANUP & DEBUG 07/11/90
C --- HKAP --------- MODIFY SWIM ONLY OPTION 26/11/90
C=====================================================================
$$IMPLICIT
$$INCLUDE 'K$ITRK:CFLAGS.INC'
$$INCLUDE 'K$ITRK:CCONST.INC'
$$INCLUDE 'K$ITRK:CVXCUT.INC'
REAL CUTR,SCUTR,SCUTZ,COSCOL
EQUIVALENCE(CUTRVX,CUTR),(SCTRVX,SCUTR),(SCTZVX,SCUTZ)
EQUIVALENCE (ACOLVX,COSCOL)
$$INCLUDE 'K$ITRK:CVXWORK.INC'
C
INTEGER INDCTK,INDDATK
INTEGER IHH,IVSAV,MTKSV,IV,MTKSVO,LTRN
INTEGER ILIST,NB1,NBS,NTRS
INTEGER KPTR,INUM,NMTRK,IVX,IVXS
INTEGER KNUM1,KNUM2,IDMASS,MSS1,MSS2
REAL COSPXP,EMMG
REAL PHI,R,RSAV,AKUR1,AKUR2,FMSS,V1COT,V1PHI
REAL X,VXERR,XCN,XBEAM,XINT,V2COT,V2PHI
DIMENSION X(3),VXERR(6),XCN(3),XBEAM(3)
DIMENSION XINT(3),ILIST(3)
LOGICAL CONSTR,BHABHA
C
CC YBOS DECLARATIONS
C
$$INCLUDE 'K$INC:ERLEVL.INC'
$$INCLUDE 'YBOS$LIBRARY:ERRCOD.INC'
$$INCLUDE 'K$INC:BCS.INC'
$$INCLUDE 'K$ITRK:DTFS.INC'
$$INCLUDE 'K$ITRK:DVFS.INC'
$$INCLUDE 'K$ITRK:DCHD.INC'
INTEGER STATUS,IND,INDDAT,I,INDH,INDATH
INTEGER ICALL,NHDSTR,NPRIM,MXCHGD
INTEGER INDC,IHDSIZ,MSFRCE,LTK,ITK
INTEGER LERR,J,ITK1,NFLAG,MTK
INTEGER JBIT,JMAX,NONLIN,MXBNK,MBNK
INTEGER IFIT,KTK,KNDDAT
INTEGER BLOCAT,BDATA,BNUMB,BNEXT
INTEGER BTYMKG
INTEGER BNKSIZ
CHARACTER*32 BNKTYP
DATA BNKTYP/'3I4,10R4,3I4,XXX(I4,16R4,2I4)'/
INTEGER HDSIZ,BVER
DATA HDSIZ/2/
DATA BVER/1/
REAL AM1,AM2,P1,P2,P1P2CS,FM,COS,E12
REAL X0,XV,TY,Y0,YV,TX,TZ,ACUR,CTT
REAL DR,VXDMIN,DIST,COSTHA,WR1,WR2
REAL WZ1,WZ2,COSOPE,CHISQ
REAL DBEAM,X1,Y1,Z1,X2,Y2,Z2
REAL PTAGLIO,TRKBUF(32)
INTEGER IMODULO,IGENE
CHARACTER*40 char_buf
REAL RDCMIN,DISMX1,DISMX2
PARAMETER (RDCMIN=30.,DISMX1=40.,DISMX2=50.)
C --- STATEMENT FUNCTIONS:
C --- MOMENTUM
REAL P,PTINV,COTTH
P(PTINV,COTTH) = SQRT(1.+COTTH*COTTH)/PTINV
C --- ENERGY OF 2-PARTICLE SYSTEM ?????????????????????
E12(AM1,P1,AM2,P2,P1P2CS) =
= SQRT( AM1**2 + AM2**2 + 2.*(SQRT( (P1**2+AM1**2)*(P2**2+AM2**2) )
- - P1P2CS ) )
EMMG(FM,P1,P2,COS) =
+ SQRT( 2.*(FM**2*(1.+0.5*(P2/P1+P1/P2))+P1*P2*(1.-COS)) )
C --- SIGNED DISTANCE X0 - XV PROJECTED INTO R-PHI-PLANE
DIST(X0,Y0,XV,YV,TX,TY,TZ) =
> ( (X0-XV)*TY-(Y0-YV)*TX )/SQRT(1.-TZ**2)
C
DATA XBEAM/ 0.0,0.0,0.0/
C DATA CUTR/2.0/,SCUTR,SCUTZ/1.5,7.0/ COS165/-0.9659258/=COSCOL
C
C --- CHECK WHETHER ANY FIT TRACKS
C Now locate the drift chamber header bank
STATUS = BLOCAT(IW,'DCHD',1,INDH,INDATH)
IF (STATUS.EQ.YESUCC) THEN
INDH = INDATH + IW(INDATH+DCHHDS)
ELSE
CALL ERLOGR('VXMAIN',ERWARN,0,0,
+ 'DC Header Bank DCHD not found!')
RETURN
ENDIF
NHDTRK = IW(INDH+DCHTRK)
C
NHDVTX = 0
IF (NHDTRK.LE.0) RETURN
C
C Event type is obtained from the EVCL bank, which should be filled somewhere
C by the online/offline data filtering and/or by GEANFI.
BHABHA=.FALSE.
C Locate the Event Classification bank
STATUS = BLOCAT(IW,'EVCL',1,INDH,INDATH)
IF (STATUS.EQ.YESUCC) THEN
imodulo=mod(IW(INDATH+13),1000) ! 12th word=MC event type (start at 0)
igene=( imodulo - mod(imodulo,100) )/100
C IGENE 1=Phi; 2=Bhabha; 3=Cosmics; 4=Machine background
if(igene.eq.2) BHABHA = .TRUE.
ELSE
CALL ERLOGR('VXMAIN',ERWARN,0,0,
+ 'Event Classification Bank EVCL not found!')
ENDIF
PTAGLIO=1.5
IF(BHABHA) THEN
C Change default VERTEX CUTS for BHABHA events
CUTRVX=4.0
CUTZVX=5.0
PTAGLIO=0.4
ENDIF
C
C --- CHECK THAT THERE IS ENOUGH SPACE IN THE CVXWORK BUFFERS
IF (NHDTRK .GT. MXTRVX) THEN
WRITE (CHAR_BUF,'(''number of DTFS banks > '',I5)') MXTRVX
CALL ERLOGR('VXMAIN',ERSEVR,0,0,CHAR_BUF)
NHDTRK = MXTRVX
ENDIF
C
C --- SET UP TRIAL VECTOR FOR PRIMARY VERTEX
C AND POSSIBLE CONSTRAINT VECTOR
C
ICALL = 0
NHDSTR = 0
NPRIM = 0
CONSTR = .FALSE.
X(1) = XBEAM(1)
X(2) = XBEAM(2)
X(3) = XBEAM(3)
CALL VZERO(MSLIST,64)
C
C --- SET UP GOOD TRACKS
C
MXCHGD = 0
C
C LOOP OVER ALL FITTED TRACK CANDIDATES (ALL DTFS BANKS)
C
STATUS = BLOCAT(IW,'DTFS',-1,IND,INDDAT)
DO WHILE (IND.GT.0)
INDDAT=INDDAT+IW(INDDAT+DTFHDS)
MXCHGD = MXCHGD+1
IGDTK(MXCHGD) = MXCHGD
STATUS=BNUMB(IW,IND,DTFS_BNK_NUM_LIST(MXCHGD))
IF (STATUS.NE.YESUCC) THEN
CALL ERLOGR('VXMAIN',ERSEVR,0,0,
+ 'DTFS BANK NUMBER CANNOT BE EXTRACTED FOR LOCATED BANK.')
RETURN
ENDIF
ACUR=ABS(RW(INDDAT+DTFCUR))
CTT=RW(INDDAT+DTFCTT)
IF (ABS(CTT).LT.1.E4) THEN
QFAC(MXCHGD) = P(ACUR,CTT)
DRMIN(MXCHGD) = VXDMIN(INDDAT,X)
IF (IW(INDDAT+DTFCEN) .EQ. 1) THEN
NPRIM = NPRIM + 1
JGDTK(NPRIM) = IGDTK(MXCHGD)
ENDIF
ENDIF
STATUS=BNEXT(IW,IND,IND)
STATUS=BDATA(IW,IND,INDDAT)
ENDDO
C
C --- INITIALIZE TRACK BANKS, SWIM THROUGH WALLS
C
C--- KLOE code modification ----- begin ------ A.Andryakov----
C Force PI-meson masshyp.
C
C MSFRCE = -1
MSFRCE = 2
C
C--- KLOE code modification ----- end -------- A.Andryakov----
C
CALL VXTKIN (MXCHGD,MSFRCE)
IF (MXCHGD.LT.2) GOTO 944
C
C --- SORT HIGH MOMENTUM TKS TO THE LEFT
C
DO 32 I=1,MXCHGD-1
DO 32 J=I+1,MXCHGD
IF (QFAC(IGDTK(I)).LT.QFAC(IGDTK(J))) THEN
C ------------ INTERCHANGE TRACKS
ITK1 = IGDTK(I)
IGDTK(I) = IGDTK(J)
IGDTK(J) = ITK1
ENDIF
32 CONTINUE
Crid In case of bhabha events, we CAN have 2 tracks.
Crid Why apply this cut, anyway?
IF (MXCHGD.GE.2 .AND.
> (.NOT.BHABHA)) GOTO 666 ! FORCE to start from "PRIMARY VTX"
C
C === LOOK FOR BHABHAS AND COLLINEAR EVENTS ==========================
C
NFLAG = 2
IF (NPRIM.NE.2 .AND.
+(QFAC(IGDTK(1)).LT.PTAGLIO .OR. QFAC(IGDTK(2)).LT.PTAGLIO) ) GOTO 50
IF (DRMIN(IGDTK(1)).GT.SCUTR .OR.
+ DRMIN(IGDTK(2)).GT.SCUTR ) GOTO 50
C --- IF HERE THEN
C 1. NPRIM = 2 OR BOTH HIGHEST MOMENTA >= 1.5 GEV/C
C 2. BOTH DISTANCES TO BEAM LINE <= SCUTR
C NOW GET A BETTER D0 VALUE AND CHECK Z
LTK = IGDTK(1)
CALL VXSWIM (X,LTK,TRKBNK(1,4,LTK),LERR)
IF (LERR.NE.0) GOTO 50
DR = ABS(DIST(TRKBNK(2,4,LTK),TRKBNK(3,4,LTK),0.,0.,
+ TRKBNK(5,4,LTK),TRKBNK(6,4,LTK),TRKBNK(7,4,LTK)))
IF (DR.GT.SCUTR .AND. ABS(TRKBNK(4,4,LTK)).GT.SCUTZ) GOTO 50
C
MTK = IGDTK(2)
CALL VXSWIM(X,MTK,TRKBNK(1,4,MTK),LERR)
IF (LERR.NE.0) GOTO 50
DR = ABS(DIST(TRKBNK(2,4,MTK),TRKBNK(3,4,MTK),0.,0.,
+ TRKBNK(5,4,MTK),TRKBNK(6,4,MTK),TRKBNK(7,4,MTK)))
IF (DR.GT.SCUTR .AND. ABS(TRKBNK(4,4,MTK)).GT.SCUTZ) GOTO 50
C
IF (.NOT.BHABHA) THEN
COSTHA = TRKBNK(5,4,LTK) * TRKBNK(5,4,MTK) +
+ TRKBNK(6,4,LTK) * TRKBNK(6,4,MTK) +
+ TRKBNK(7,4,LTK) * TRKBNK(7,4,MTK)
IF (COSTHA-COSCOL.GT.0.0) GOTO 50
ENDIF
C
C === HERE WE HAVE A BHABHA EVENT OR TWO COLLINEAR TRACKS. ===========
C SO TRY A CONSTRAINED FIT.
C
WR1 = 1./TRKBNK(15,4,LTK)
WR2 = 1./TRKBNK(15,4,MTK)
WZ1 = 1./TRKBNK(20,4,LTK)
WZ2 = 1./TRKBNK(20,4,MTK)
XCN(1) = (TRKBNK(2,4,LTK)*WR1 + TRKBNK(2,4,MTK)*WR2)/(WR1+WR2)
XCN(2) = (TRKBNK(3,4,LTK)*WR1 + TRKBNK(3,4,MTK)*WR2)/(WR1+WR2)
XCN(3) = (TRKBNK(4,4,LTK)*WZ1 + TRKBNK(4,4,MTK)*WZ2)/(WZ1+WZ2)
CALL UCOPY(XCN,XINT,3)
CONSTR = .TRUE.
JGDTK(1) = IGDTK(1)
JGDTK(2) = IGDTK(2)
JMAX = 2
IF (BHABHA.OR.MXCHGD.LE.2) GOTO 42
NONLIN = 0
C
DO 40 ITK=3,MXCHGD
STATUS = BLOCAT(IW,'DTFS',
& DTFS_bnk_num_list(IGDTK(ITK)),
& INDC,INDDAT)
IHDSIZ=IW(INDDAT+DTFHDS)
INDDAT=INDDAT+IHDSIZ
IF (VXDMIN(INDDAT,XCN).GT.SCUTR) GOTO 40
IF (ITKBNK(32,1,IGDTK(ITK)).LT.0) GOTO 40
MXBNK = 3
C ------ IF VDC TRACK:
IF (ITKBNK(32,4,IGDTK(ITK)).GE.100) MXBNK = 2
MBNK = ITKBNK(32,2,IGDTK(ITK))
IF (MBNK.NE.MXBNK) GOTO 40
JMAX = JMAX + 1
JGDTK(JMAX) = IGDTK(ITK)
C ------ FIND COS(OPENING ANGLE) WITH IGDTK(1)
COSOPE = TRKBNK(5,4,IGDTK(1))*TRKBNK(5,MBNK,IGDTK(ITK))+
+ TRKBNK(6,4,IGDTK(1))*TRKBNK(6,MBNK,IGDTK(ITK))+
+ TRKBNK(7,4,IGDTK(1))*TRKBNK(7,MBNK,IGDTK(ITK))
IF (ABS(COSOPE).GT.ABS(COSCOL)) GOTO 40
NONLIN = NONLIN + 1
40 CONTINUE
IF (NONLIN.GT.0) GOTO 50
C
42 CONTINUE
CALL VXXYZ(JMAX,JGDTK,XINT,VXERR,CHISQ,IFIT,XCN,CONSTR)
C --- FOR DEBUG OF PROBLEM VERTICES
ICALL = ICALL+1
IF (ICALL.EQ.ICLLVX) GOTO 9999
C
IF (IFIT.NE.0) GOTO 44
CALL VXSTOR(JGDTK,JMAX,XINT,VXERR,CHISQ,NFLAG,IFIT)
NHDSTR = NHDVTX
NPRIM = NPRIM-JMAX
IF (MXCHGD.EQ.2) GOTO 900
44 CONTINUE
IF (MXCHGD.EQ.2) GOTO 100
C
C === LOOK FOR CONVERTED GAMMAS NOW ==================================
C
50 CONTINUE
CALL VXGMMA(MXCHGD,LERR)
C IF(LERR.LT.0)GO TO 900
C
C === LOOK FOR PRIMARY NEXT ==========================================
C
666 continue
IF (NPRIM.LT.2) GOTO 70
CONSTR = .FALSE.
XINT(1) = 0.
XINT(2) = 0.
XINT(3) = 0.
C
CALL VXXYZ(NPRIM,JGDTK,XINT,VXERR,CHISQ,IFIT,XCN,CONSTR)
IF(IFIT.NE.0
& .and.IFIT.NE.7
& .and.IFIT.NE.6
& ) GOTO 70
DBEAM = SQRT( XINT(1)**2+XINT(2)**2 )
IF (DBEAM.GT.3.5) GOTO 70
NFLAG = 1
CALL VXSTOR(JGDTK,NPRIM,XINT,VXERR,CHISQ,NFLAG,IFIT)
NHDSTR = NHDVTX
C
C === NOW LOOK FOR SECONDARY VERTICES ================================
C TWO PRONG VTXS OF NET CHARGE 0 CAN HAVE ONE TRK ASSOCIATED WITH
C PRIMARY
C
70 CONTINUE
CALL VXSCND(MXCHGD,NHDSTR,LERR)
C
C === TRY TO FIND START/STOP VERTICES NOW ===========
C
DO 85 ITK = 1,MXCHGD
STATUS = BLOCAT(IW,'DTFS',
& DTFS_bnk_num_list(IGDTK(ITK)),
& INDC,INDDAT)
IHDSIZ=IW(INDDAT+DTFHDS)
INDDAT=INDDAT+IHDSIZ
X1 = RW(INDDAT+DTFXLP)
Y1 = RW(INDDAT+DTFYLP)
Z1 = RW(INDDAT+DTFZLP)
DO 82 KTK = 1,MXCHGD
IF (KTK.EQ.ITK) GOTO 82
IF (MSLIST(IGDTK(ITK)).NE.0 .AND.
+ MSLIST(IGDTK(KTK)).NE.0) GOTO 82
STATUS = BLOCAT(IW,'DTFS',
& DTFS_bnk_num_list(IGDTK(KTK)),
& INDC,KNDDAT)
IHDSIZ=IW(KNDDAT+DTFHDS)
KNDDAT=KNDDAT+IHDSIZ
X2 = RW(KNDDAT+DTFXCO)
Y2 = RW(KNDDAT+DTFYCO)
Z2 = RW(KNDDAT+DTFZCO)
IF (SQRT((X1-X2)**2 + (Y1-Y2)**2).GT.DISMX1) GOTO 82
C --------- THERE EXISTS A CANDIDATE
XINT(1) = 0.5*(X1+X2)
XINT(2) = 0.5*(Y1+Y2)
XINT(3) = 0.5*(Z1+Z2)
ILIST(1) = IGDTK(ITK)
ILIST(2) = IGDTK(KTK)
IHH = 2
CONSTR = .FALSE.
C --------- FIX TRACK BANK SO THAT TRACK CAN BE SWUM INTO DC PROPER
C WITHOUT IMPROPER SWIM FLAG
TRKBNK(32,3,ILIST(1)) = -1.0
CALL VXXYZ(IHH,ILIST,XINT,VXERR,CHISQ,IFIT,XCN,CONSTR)
TRKBNK(32,3,ILIST(1)) = 1.0
IF (IFIT.NE.0 .AND. IFIT.NE.6 .AND. IFIT.NE.7) GOTO 82
NFLAG = 15
CALL VXSTOR(ILIST,2,XINT,VXERR,CHISQ,NFLAG,IFIT)
GOTO 85
82 CONTINUE
85 CONTINUE
GO TO 900
C
100 CONTINUE
IF (NHDVTX.GT.0) GOTO 900
CALL INERR(510,1)
GO TO 943
C
C === FIX UP VERTICES SO THAT ONE WITH MOST TKS IS PRIMARY. ==========
C IF NO VERTEX HAS MORE THAN TWO TKS, PICK NEAREST TO
C BEAM LINE ORIGIN.
C
900 CONTINUE
IF(NHDVTX.LE.0)GO TO 943
IVSAV=1
IF(NHDVTX.EQ.1)GO TO 915
MTKSV=LV(KVX(1)+5)
DO 905 IV=2,NHDVTX
MTK=LV(KVX(IV)+5)
IF(MTKSV.GT.MTK)GO TO 905
MTKSVO=MTKSV
MTKSV=MTK
IVSAV=IV
905 CONTINUE
IF(IVSAV.EQ.1)GO TO 915
IF(MTKSV.GT.MTKSVO)GO TO 912
C ----------------->> ELSE HAVE AT LEAST 2 VTXS OF EQ MULT
C LOOK FOR VERTEX CLOSEST TO BEAMLINE
RSAV=SQRT(FV(KVX(1)+6)**2+FV(KVX(1)+7)**2+FV(KVX(1)+8)**2)
IVSAV=1
DO 910 IV=2,NHDVTX
MTK=LV(KVX(IV)+5)
IF(MTK .LT. MTKSV)GO TO 910
R=SQRT(FV(KVX(IV)+6)**2+FV(KVX(IV)+7)**2+FV(KVX(IV)+8)**2)
IF(R .GT. RSAV) GO TO 910
RSAV=R
IVSAV=IV
910 CONTINUE
IF(IVSAV.EQ.1)GO TO 915
912 CONTINUE
LTRN = KVX(IVSAV)
KVX(IVSAV)= KVX(1)
KVX(1) = LTRN
915 CONTINUE
DO 920 ITK=1,MXCHGD
NB1 = JBIT(MSLIST(IGDTK(ITK)), 1 )
NBS = JBIT(MSLIST(IGDTK(ITK)),IVSAV)
IF( NB1 .EQ. NBS )GO TO 920
IF( NBS .EQ. 0 )GO TO 918
CALL SBIT0(MSLIST(IGDTK(ITK)),IVSAV)
CALL SBIT1(MSLIST(IGDTK(ITK)), 1 )
GO TO 920
918 CONTINUE
CALL SBIT0(MSLIST(IGDTK(ITK)), 1 )
CALL SBIT1(MSLIST(IGDTK(ITK)),IVSAV)
920 CONTINUE
C ----------------->> FILL PRIMARY VERTEX
C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
NTRS=LV(KVX(1)+5)
WRITE(BNKTYP(14:16),'(I3)') NTRS
C
C Create the vertex track bank
C ============================
STATUS = BTYMKG(IW,'DVFS',1,BNKTYP,BNKSIZ, IND, INDDAT)
IF (STATUS.NE.YESUCC) THEN
RETURN
ENDIF
IW(INDDAT+DVFHDS)=HDSIZ
IW(INDDAT+DVFVRN)=BVER
INDDAT=INDDAT+HDSIZ
IW(INDDAT+DVFQFL)=LV(KVX(1)+4)
CALL UCOPY(FV(KVX(1)+6),RW(INDDAT+DVFXCO),3)
RW(INDDAT+DVFCHI)=FV(KVX(1)+15)
CALL UCOPY(FV(KVX(1)+9),RW(INDDAT+DVFCVV),6)
IW(INDDAT+DVFIDF)=LV(KVX(1)+1)
IW(INDDAT+DVFMTR)=0
IW(INDDAT+DVFNTR)=NTRS
C ----------------->> FIX UP AD TRACK BANKS
KPTR = KVX(1)
INUM = LV(KPTR+5)
DO 930 ITK=1,INUM
KPTR = KPTR + 17
NMTRK = LV(KPTR + 1)
STATUS = BLOCAT(IW,'DTFS',
& DTFS_bnk_num_list(NMTRK),
& INDCTK,INDDATK)
IHDSIZ=IW(INDDATK+DTFHDS)
INDDATK=INDDATK+IHDSIZ
IW(INDDAT+DVFNTR+DVFTRA+19*(ITK-1))=DTFS_bnk_num_list(NMTRK)
CALL UCOPY(FV(KPTR+2),RW(INDDAT+DVFNTR+DVFCRV+19*(ITK-1)), 9)
IF(RW(INDDATK+DTFCUR).LT.0.)
+ RW(INDDAT+DVFNTR+DVFCRV+19*(ITK-1))=
+ -RW(INDDAT+DVFNTR+DVFCRV+19*(ITK-1))
RW(INDDAT+DVFNTR+DVFCHV+19*(ITK-1)) = FV(KPTR+17)
RW(INDDAT+DVFNTR+DVFLNV+19*(ITK-1)) = FV(KPTR+11)
CC STORE THE PACKED LIST OF VERTICES
IW(INDDATK+DTFPVM)=MSLIST(NMTRK)
IW(INDDAT+DVFNTR+DVFPVM+19*(ITK-1))=MSLIST(NMTRK)
CALL UCOPY(LV(KPTR+12),RW(INDDAT+DVFNTR+DVFD0V+19*(ITK-1)),5)
C IF CHRGD DECAY, FIX LENGTH
IVX = IW(INDDATK+DTFPVS)
IF(IVX.EQ.0)GO TO 930
CCC VERIFICARE SE FV(+28) E' UNA CORREZIONE ALL LUNGHEZZA
IF(LV(KVX(IVX)+18).EQ.NMTRK)
+ RW(INDDAT+DVFNTR+DVFLNV+19*(ITK-1)) =
+ RW(INDDAT+DVFNTR+DVFLNV+19*(ITK-1))+FV(KVX(IVX)+28)
CC DA CAPIRE???
CCC IF(LV(KVX(IVX)+35).EQ.ITK)
CCC + AD(JTK(NMTRK)+16) = AD(JTK(NMTRK)+16)+FV(KVX(IVX)+45)
930 CONTINUE
C ----------------->> STORE REST OF VERTICES (IF ANY)
IF(NHDVTX .LE. 1)GO TO 942
IF(NHDVTX.LT.20)GO TO 932
CALL INERR(518,1)
NHDVTX = 20
932 CONTINUE
DO 936 IVX=2,NHDVTX
IF(LV(KVX(IVX)+1).EQ.1 .OR. LV(KVX(IVX)+1).EQ.2 .OR.
+ LV(KVX(IVX)+1).EQ.15 )GO TO 935
IF(LV(KVX(IVX)+5) .NE. 2)GO TO 935
KNUM1 = LV(KVX(IVX)+18)
KNUM2 = LV(KVX(IVX)+35)
STATUS = BLOCAT(IW,'DTFS',
& DTFS_bnk_num_list(KNUM1),
& IND,INDDAT)
IHDSIZ=IW(INDDAT+DTFHDS)
INDDAT=INDDAT+IHDSIZ
AKUR1=RW(INDDAT+DTFCUR)
STATUS = BLOCAT(IW,'DTFS',
& DTFS_bnk_num_list(KNUM2),
& IND,INDDAT)
IHDSIZ=IW(INDDAT+DTFHDS)
INDDAT=INDDAT+IHDSIZ
AKUR2=RW(INDDAT+DTFCUR)
IF(AKUR1*AKUR2.GT.0.0)GO TO 935
C ----------------->> NEW TRK BNKS WANTED?
C CHECK INV MASS
P1 = P(FV(KVX(IVX)+19),FV(KVX(IVX)+20))
P2 = P(FV(KVX(IVX)+36),FV(KVX(IVX)+37))
FMSS = E12(PION_MASS,P1,PION_MASS,P2,FV(KVX(IVX)+17))
IF( FMSS .LT. 0.460 .OR. FMSS .GT. 0.540 )GO TO 931
IDMASS = 20
MSS1 = 1
MSS2 = 1
GO TO 934
931 CONTINUE
IF(FV(KVX(IVX)+16) .GT. .120)GO TO 935
IF(FV(KVX(IVX)+16) .LT. .020)GO TO 933
IDMASS = 84
MSS1 = 1
MSS2 = 29
FMSS = E12(PION_MASS,P1,PROTON_MASS,P2,FV(KVX(IVX)+17))
IF( FMSS .GT. 1.075 .AND. FMSS .LT. 1.155 )GO TO 934
MSS1 = 29
MSS2 = 1
FMSS = E12(PROTON_MASS,P1,PION_MASS,P2,FV(KVX(IVX)+17))
IF( FMSS .GT. 1.075 .AND. FMSS .LT. 1.155 )GO TO 934
933 CONTINUE
IF( FV(KVX(IVX)+17)/(P1*P2) .LT. 0.951)GO TO 935
C COS(OPENING ANGLE = 18 DEG) = 0.951
IDMASS = 10
MSS1 = 22
MSS2 = 22
V1COT = FV(KVX(IVX)+20)
V1PHI = FV(KVX(IVX)+21)
V2COT = FV(KVX(IVX)+37)
V2PHI = FV(KVX(IVX)+38)
COSPXP = (COS(V1PHI-V2PHI)+V1COT*V2COT)/
+ SQRT( (1.+V1COT**2)*(1.+V2COT**2) )
FMSS = EMMG(ELEC_MASS,P1,P2,COSPXP)
IF( FMSS.GT.0.05 )GO TO 935
C
C >>>>>>>>>>>>>>>> OPEN A NEW BANK
934 CONTINUE
CCC INSERIRE LA BANCA DEI NEUTRI
CC NHDTRK = NHDTRK + 1
CCC CALL ZBOOK(ID,JTK(NHDTRK),24)
C-----------EXIT IF /CADATA/ FULL (HKAP 27/05/91)
CC IF (JTK(NHDTRK).EQ.0) THEN
CC CALL INERR (25,3)
CC RETURN
CC ENDIF
CC MPTR = JTK(NHDTRK)
CC ID(MPTR+1) = IDMASS + 500
CC ID(MPTR+2) = 1
CC ID(MPTR+3) = IVX
CC AD(MPTR+4) = 0.0
CC AD(MPTR+5) = 0.0
CC CALL VXDIFF(IVX,MSS1,MSS2,FMSS,AD(MPTR+6),AD(MPTR+7),
CC + AD(MPTR+8),AD(MPTR+9),AD(MPTR+23),AD(MPTR+16),AD(MPTR+15) )
CC CALL VZERO(AD(MPTR+17),5)
CC ID(MPTR+17) = -1
CC AD(MPTR+22) = FMSS
CC AD(MPTR+24) = 0.0
CC LV(KVX(IVX)+2) = NHDTRK
935 CONTINUE
C-
C------------------------------------------------------------------
C- Very important changes. A.Andryakov 16-SEP-1994
C-
C- **** Multiple vertecies case *****
C-
C- Original VXMAIN:
C- ----------------
C- Track parameters in the vtx. fit part of the output track bank
C- are taken at the vertex point only for tracks from the MAIN vertex.
C- All other charged tracks are propogated back to the point of this
C- MAIN vtx. Their parameters at the corresponding secondary vertex
C- are used only for V0 vertecies to calculate the 4-momenta
C- of the neutral particles and then they are lost.
C-
C- Present version of VXMAIN:
C- --------------------------
C- Track parameters in the vtx. fit part of the output track bank
C- correspond to the proper vertex point for any track from any vertex.
C-
C-------------------------------------- begin A.A. ---------------
C ----------------->> FILL SECONDARY VERTEX
C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
KPTR = KVX(ivx)
NTRS=LV(KPTR+5)
WRITE(BNKTYP(14:16),'(I3)') NTRS
C
C Create the vertex track bank
C ============================
STATUS = BTYMKG(IW,'DVFS',IVX,BNKTYP,BNKSIZ, IND, INDDAT)
IF (STATUS.NE.YESUCC) THEN
RETURN
ENDIF
IW(INDDAT+DVFHDS)=HDSIZ
IW(INDDAT+DVFVRN)=BVER
INDDAT=INDDAT+HDSIZ
IW(INDDAT+DVFQFL)=LV(KPTR+4)
CALL UCOPY(FV(KPTR+6),RW(INDDAT+DVFXCO),3)
RW(INDDAT+DVFCHI)=FV(KPTR+15)
CALL UCOPY(FV(KPTR+9),RW(INDDAT+DVFCVV),6)
IW(INDDAT+DVFIDF)=LV(KPTR+1)
IW(INDDAT+DVFMTR)=0
IW(INDDAT+DVFNTR)=NTRS
C
C IN CASE OF KINK DELETE THE MOTHER TRACK FROM THE LIST LV(KPTR+3)
C
cc IF(LV(KPTR+1).EQ.15)THEN
cc IW(INDDAT+DVFMTR)=LV(KPTR+2)
cc CALL SBIT0(LV(KPTR+3),LV(KPTR+2))
cc ENDIF
IW(INDDAT+DVFNTR)=NTRS
C ----------------->> FIX UP AD TRACK BANKS for current vtx
DO 1930 ITK=1,NTRS
KPTR = KPTR + 17
NMTRK = LV(KPTR + 1)
STATUS = BLOCAT(IW,'DTFS',
& DTFS_bnk_num_list(NMTRK),
& INDCTK,INDDATK)
IHDSIZ=IW(INDDATK+DTFHDS)
INDDATK=INDDATK+IHDSIZ
IW(INDDAT+DVFNTR+DVFTRA+19*(ITK-1))=DTFS_bnk_num_list(NMTRK)
CALL UCOPY(FV(KPTR+2),RW(INDDAT+DVFNTR+DVFCRV+19*(ITK-1)), 9)
IF(RW(INDDATK+DTFCUR).LT.0.)
+ RW(INDDAT+DVFNTR+DVFCRV+19*(ITK-1))=
+ -RW(INDDAT+DVFNTR+DVFCRV+19*(ITK-1))
RW(INDDAT+DVFNTR+DVFCHV+19*(ITK-1)) = FV(KPTR+17)
RW(INDDAT+DVFNTR+DVFLNV+19*(ITK-1)) = FV(KPTR+11)
IW(INDDATK+DTFPVM)=MSLIST(NMTRK)
IW(INDDAT+DVFNTR+DVFPVM+19*(ITK-1))=MSLIST(NMTRK)
CALL UCOPY(LV(KPTR+12),RW(INDDAT+DVFNTR+DVFD0V+19*(ITK-1)),5)
IVXS = IW(INDDATK+DTFPVS)
IF(IVXS.EQ.0)GO TO 1930
CCC VERIFICARE SE FV(+28) E' UNA CORREZIONE ALL LUNGHEZZA
IF(LV(KVX(IVXS)+18).EQ.NMTRK)
+ RW(INDDAT+DVFNTR+DVFLNV+19*(ITK-1)) =
+ RW(INDDAT+DVFNTR+DVFLNV+19*(ITK-1))+FV(KVX(IVXS)+28)
CC DA CAPIRE???
CCC IF(LV(KVX(IVXS)+35).EQ.ITK)
CCC + AD(JTK(NMTRK)+16) = AD(JTK(NMTRK)+16)+FV(KVX(IVXS)+45)
1930 CONTINUE
936 CONTINUE
C ----------------->> SWIM ALL TKS NOT INCLUDED IN FITS TO
C CLOSEST APPROACH TO THE BEAM LINE
942 CONTINUE
C
IF(KLKS_SWIM.NE.1) GO TO 9999 ! IF SWIMMING HAS BEEN ASKED
C
STATUS = BLOCAT(IW,'DVFS',1,INDC,INDDAT)
IHDSIZ=IW(INDDAT+DVFHDS)
INDDAT=INDDAT+IHDSIZ
X(1) = RW(INDDAT+DVFXCO)
X(2) = RW(INDDAT+DVFYCO)
X(3) = RW(INDDAT+DVFZCO)
IF(NHDVTX .GT. 0)GO TO 944
943 X(1) = XBEAM(1)
X(2) = XBEAM(2)
X(3) = XBEAM(3)
944 CONTINUE
DO 945 LTK=1,MXCHGD
ITK = IGDTK(LTK)
STATUS = BLOCAT(IW,'DTFS',
& DTFS_bnk_num_list(ITK),
& INDC,INDDAT)
IHDSIZ=IW(INDDAT+DTFHDS)
INDDAT=INDDAT+IHDSIZ
MBNK = 3
ITKBNK(32,1,ITK) = MBNK
CALL VXSWIM( X, ITK, TRKBUF, LERR)
C
IF( LERR .NE. 0 )GO TO 945 ! SWIM ERROR
IF( MSLIST(ITK) .NE. 0 )GO TO 945
C
RW(INDDAT+DTFCUS) = TRKBUF(30)
C DAVE-- PROTECT AGAINST PZ = 0
RW(INDDAT+DTFCTS) = TRKBUF(7)
IF( ABS(TRKBUF(7)) .GT. 1.0E-5 )
+ RW(INDDAT+DTFCTS) =
+ SIGN(1./SQRT(1./TRKBUF(7)**2-1.),TRKBUF(7))
PHI = ATAN2(TRKBUF(6),TRKBUF(5))
RW(INDDAT+DTFPHS) = PHI
IF(PHI.LT.0.)RW(INDDAT+DTFPHS)=PI2+PHI
CALL UCOPY(TRKBUF(2),RW(INDDAT+DTFXSW),3)
C? CALL UCOPY(TRKBUF(24),RW(INDDAT+DTFCOV),6)
RW(INDDAT+DTFLNG) = TRKBUF(1)
945 CONTINUE
9999 CONTINUE
C
RETURN
END
C 27/11/89 MEMBER NAME VXCOVR (ES) FVS
REAL FUNCTION VXCOVR(D,COV1,COV2,E)
$$IMPLICIT
C
C DIMENSION D(6),E(6),COV(12)
REAL D,E,COV1,COV2
DIMENSION D(6),E(6),COV1(6),COV2(6)
C
VXCOVR = (COV1(1)*E(1)+COV1(2)*E(2)+COV1(3)*E(3))*D(1)
+ +(COV1(2)*E(1)+COV1(4)*E(2)+COV1(5)*E(3))*D(2)
+ +(COV1(3)*E(1)+COV1(5)*E(2)+COV1(6)*E(3))*D(3)
+ +(COV2(1)*E(4)+COV2(2)*E(5)+COV2(3)*E(6))*D(4)
+ +(COV2(2)*E(4)+COV2(4)*E(5)+COV2(5)*E(6))*D(5)
+ +(COV2(3)*E(4)+COV2(5)*E(5)+COV2(6)*E(6))*D(6)
C
RETURN
END
C 27/11/89 102071907 MEMBER NAME VXSWIM (ES) FVS
C 17/04/84 MEMBER NAME VXSWIM (S) FORTRAN
SUBROUTINE VXSWIM(WVTX,ITRK,TRKOUT,LERR)
$$IMPLICIT
C
C=====================================================================
C SUBROUTINE FOR SWIMMING TRACKS
C --- CALLED FROM VXMAIN, VXPREP, VXTKIN, VDTKIN
C---------------------------------------------------------------------
C INPUT : WVTX(2)= X,Y SWIM END POINT
C ITRK = NUMBER OF TRACK TO BE SWUM
C TRKBNK(*,N,ITRK) = TRACKBNK IN COMMON/CWORK/
C
C OUTPUT: TRKOUT = TRKBNK(32,REGION,TRACK NUMBER)
C 1 - 4 1 - 64
C---------------------------------------------------------------------
C DESCRIPTION OF WORKING TRACK BANK TRKBNK( N , I , J ):
C N=
C 1 TRACK LENGTH
C 2,3,4 X,Y,Z
C 5,6,7 VTNG X,Y,Z
C 8,9,10 VNORM X,Y,Z (UNNORMALIZED)
C 11,12,13 VH X,Y,Z (UNIT VECTOR IN DIR OF MAG FIELD)
C 14 1/VHMAG (MAGNITUDE OF MAG FIELD)
C 15 - 29 COVARIANCE MATRIX FOR REGION I
C 30 SIGNED VALUE OF K
C 31 ABS(DP/DX) (DEFAULT MASS = PI MASS. K FROM REGION 1)
C 32, I=1 STATUS WORD = 1 OR 2: INPUT BNK FROM VXTKIN/VDTKIN
C = 3 INIT TRKOUT FROM BEST BNK
C = 4 USE TRKOUT WITH MODIFICATION
C I=2 STATUS WORD = NUMBER OF LAST FILLED BANK
C = -1 NO BANKS FILLED
C I=3 STATUS WORD = +1.0 FOR NEGATIVE SWIMS (NORMAL)
C = -1.0 FOR POSITIVE SWIMS (MUST BE
C SET WHEN NEEDED)
C I=4 STATUS WORD = NUMBER OF BANK USED TO INITIALIZE
C THE WORKING BANK WHEN LAST INIT +
C 100 IF VDC HITS IN FIT
C---------------------------------------------------------------------
C --- D.L. COPPAGE 21/07/83 V3.00 (ARG05)
C 20/01/84 V3.01 (ARG06)
C 21/03/84 V3.02 (ARG06) FIXED ERROR
C AFFECTING LEGALITY OF SWIM (LERR 2)
C 17.04.84 V3.03 (ARG06) FIXED CONVERG
C FOR VERY LOW PT TRKS
C 14.05.84 V4.00 (ARG07) DKDX IN DC
C 29.07.84 V5.00 (ARG08) NEW MGFLD
C 30.08.84 V5.10 (ARG08) NTIFLD 3 MAGFL
C 11.11.84 V5.20 (ARG08) FIXED MAG FLD
C MAP. BAD FOR INNER DC AND COMPENSATION
C COILS FOR EXPT 2 DATA. FIXED SWIM TO
C HOLD PTOT FIXED INSTEAD OF K
C 12.12.84 V5.30 (ARG08) SINL PROB FIX
C 19.04.85 V6.00 MOD FOR VDC FITS
C --- HKAP 25/10/90 CLEAN UP
C---------------------------------------------------------------------
$$INCLUDE 'K$ITRK:CCONST.INC'
$$INCLUDE 'K$ITRK:CFLAGS.INC'
$$INCLUDE 'K$ITRK:CTIDRI.INC'
$$INCLUDE 'K$ITRK:CVXCUT.INC'
$$INCLUDE 'K$ITRK:CVXWORK.INC'
$$INCLUDE 'YBOS$LIBRARY:ERRCOD.INC'
$$INCLUDE 'K$INC:BCS.INC'
C
REAL WVTX,TRKOUT(32)
INTEGER ITRK,LERR
C
INTEGER LBNK,ITERMX,NDXSV,IBNK,MXBNK,I,L,KK
INTEGER IVOL
INTEGER ITER,NDX
REAL COEFF,STEPLG,SWLNGH,COSPHI,SINPHI,SINGMA
REAL COSDLT,RELERR,COSGMA,GMA,DIRSWM
REAL FRAC,COSLAM,RHO,DLTIV,DWW
REAL arcl,turn,sintrn,costrn,sinlh,hn,hz,tinv
C
REAL VH,DELT,WWVTX,TRKSP,SRFVDC
DIMENSION VH(3),DELT(2),WVTX(2),WWVTX(2),TRKSP(3),
+ SRFVDC(2)
LOGICAL FLGVDC
REAL BRADL/0.000/
C DATA STEPLG/4.0/
C DATA ITERMX/5/
REAL EBYCIV
DATA EBYCIV /3.33567E+3/
c call vzero(TRKOUT,32) ! clear TRKOUT befor using (Andryakov)
c When I thoght a little bit and looked in
c the code of this routine I've understood that
c nobody should touch TRKOUT
C
C ----------------->> SET VDC FLAG AND APPROPRIATE SURFACES
C RSRFCO(1) = DC(RAD) ALWAYS
C RSRFCO(2) = BT(RAD) ALWAYS
LBNK = ITKBNK(32,4,ITRK)
FLGVDC = LBNK.GE.100
c FLGVDC = .TRUE.
SRFVDC(1) = RSRFCO(1)
SRFVDC(2) = RSRFCO(2)
IF(.NOT.FLGVDC)GO TO 6
SRFVDC(1) = RSRFCO(2)
SRFVDC(2) = 0.0
6 CONTINUE
C
C ----------------->> LOOP OVER BANKS TO FIND BEST ONE
C UNLESS ALREADY USING WORKSPACE (=4)
ITERMX = ITRSVX
FRAC = STEPVX/40.0
NDXSV = 9999
IBNK = ITKBNK(32,1,ITRK)
MXBNK = ITKBNK(32,2,ITRK)
IF( MXBNK .LT. 0 )GO TO 996
DO 7 I=1,MXBNK
7 TRKSP(I) = 1./(SQRT(1.-TRKBNK(7,I,ITRK)**2)*TRKBNK(30,I,ITRK))
IF( IBNK .NE. 4 )GO TO 8
LBNK = MOD(ITKBNK(32,4,ITRK),100)
IBNK = LBNK
GO TO 15
8 IF( IBNK .EQ. 1 .OR. IBNK .EQ. 2 )GO TO 10
C WHICH BANK IS CLOSEST
IBNK = 1
IF(MXBNK.EQ.1)GO TO 10
L = IBNK
DO 9 KK=1,2
COSLAM = SQRT(1.-TRKBNK(7,L,ITRK)**2)
C RHO = TRKBNK(14,L,ITRK)/(EBYC*TRKBNK(30,L,ITRK)*COSLAM)
RHO = TRKBNK(14,L,ITRK)*TRKSP(L)*EBYCIV
DELT(1) = TRKBNK(2,L,ITRK) + RHO*TRKBNK(6,L,ITRK) - WVTX(1)
DELT(2) = TRKBNK(3,L,ITRK) - RHO*TRKBNK(5,L,ITRK) - WVTX(2)
DLTIV = SIGN(1./SQRT(DELT(1)**2 + DELT(2)**2),RHO)
WWVTX(1) = WVTX(1) + (1.-RHO*COSLAM*DLTIV)*DELT(1)
WWVTX(2) = WVTX(2) + (1.-RHO*COSLAM*DLTIV)*DELT(2)
DWW = WWVTX(1)**2+WWVTX(2)**2
IF(DWW.LT.SRFVDC(1)**2 )IBNK=2
IF(DWW.LT.SRFVDC(2)**2 )IBNK=MIN(3,MXBNK)
IF(IBNK .EQ. 1)GO TO 10
L = IBNK
9 CONTINUE
10 CALL UCOPY(TRKBNK(1,IBNK,ITRK),TRKOUT,30)
LBNK = IBNK
IF(FLGVDC)LBNK = LBNK + 100
ITKBNK(32,4,ITRK) = LBNK
15 CONTINUE
C
C ----------------->> NOW CALCULATE SWIM DISTANCE
C TO SAVE TIME, USE RHO/COSLAM I.E.
C RHO = RHO(SPACE)
C = Q*P/((E/C)*B)
COSLAM = SQRT(1. - TRKOUT(7)**2)
C RHO = TRKOUT(14)/(CONVERS*TRKOUT(30)*COSLAM)
RHO = TRKOUT(14)*TRKSP(IBNK)*EBYCIV
COEFF = AMAX1(COSLAM,0.1)
STEPLG = AMIN1( STEPVX*COEFF , FRAC*ABS(RHO)*COSLAM*COEFF )
LERR = 0
SWLNGH = ( (WVTX(1) - TRKOUT(2)) * TRKOUT(5) +
+ (WVTX(2) - TRKOUT(3)) * TRKOUT(6) )/COSLAM**2
IF( ABS(SWLNGH) .LT. 0.1 )GO TO 998
C
COSPHI = TRKOUT(5)/COSLAM
SINPHI = TRKOUT(6)/COSLAM
C
DELT(1) = TRKOUT(2) + RHO*TRKOUT(6) - WVTX(1)
DELT(2) = TRKOUT(3) - RHO*TRKOUT(5) - WVTX(2)
DLTIV = SIGN(1./SQRT(DELT(1)**2 + DELT(2)**2),RHO)
SINGMA = (DELT(1)*COSPHI + DELT(2)*SINPHI)*DLTIV
IF( ABS(SINGMA) .GT. 0.7 )GO TO 90
COSDLT = SWLNGH*COSLAM
+ /SQRT( (TRKOUT(2)-WVTX(1))**2+(TRKOUT(3)-WVTX(2))**2 )
IF(ABS(COSDLT) .GT. 1. )COSDLT = 1.
C ---------------->> RELATIVE ERR = TAN(DLT)*TAN(GMA) WHEN
C USING SWLNGH FROM TANGENT APPROX
RELERR = SQRT( (1./COSDLT**2-1.)/(1./SINGMA**2-1.) )
IF( RELERR .LT. 0.005 )GO TO 100
WWVTX(1) = WVTX(1) + (1.-RHO*COSLAM*DLTIV)*DELT(1)
WWVTX(2) = WVTX(2) + (1.-RHO*COSLAM*DLTIV)*DELT(2)
SWLNGH = ( (WWVTX(1)-TRKOUT(2))*TRKOUT(5) +
+ (WWVTX(2)-TRKOUT(3))*TRKOUT(6) )/COSLAM**2
COSDLT = SWLNGH*COSLAM
+ /SQRT( (TRKOUT(2)-WWVTX(1))**2+(TRKOUT(3)-WWVTX(2))**2 )
IF(ABS(COSDLT) .GT. 1. )COSDLT = 1.
RELERR = SQRT( (1./COSDLT**2-1.)/(1./SINGMA**2-1.) )
IF( RELERR .LT. 0.005 )GO TO 100
90 COSGMA = (DELT(1)*SINPHI - DELT(2)*COSPHI)*DLTIV
GMA = ATAN2(SINGMA,COSGMA)
SWLNGH = -GMA*RHO
C
100 IF( ABS(SWLNGH) .LT. 0.1 )GO TO 998
C
C ==================>> ENTER SWIM SECTION
C
LBNK = MOD(ITKBNK(32,4,ITRK),100)
C?? LERR = 9
C?? IF( LBNK .LT. MXBNK .AND.
C?? + TRKOUT(1)-SWLNGH .GT. TRKBNK(1,LBNK+1,ITRK) + 8.0 )GO TO 998
C?? LERR = 6
DIRSWM = TRKBNK(32,3,ITRK)
C?? IF( TRKOUT(1)-SWLNGH .LT. 0.85*DIRSWM*TRKBNK(1,1,ITRK) )GO TO 998
DO 300 ITER = 1,ITERMX
C --- # TRACING STEPS AND ARC LENGTH
NDX = MAX0( IFIX( ABS(SWLNGH/STEPLG)) , 1 )
ARCL = SIGN( STEPLG, SWLNGH)
IF( ABS(SWLNGH) .LT. STEPLG ) ARCL = SWLNGH
LERR = 7
IF( NDX .GT. NDXSV + 4 )GO TO 998
NDXSV = NDX
C --- TRACE THE TRACK
DO 200 I = 1,NDX
C --- TURNING ANGLE
TURN = ARCL/RHO
C ----------------->> CHANGE IN POSITION AND TANGENT
C (CONSISTENT WITH MARK2 PAPER)
C --- APPROX SIN(TURN) (CONSISTENT WITH MARK2 PAPER)
SINTRN = TURN*(1.-TURN**2*0.16666667*
+ (1.-TURN**2*0.05))
C --- APPROX COS(TURN) = SQRT(1-SIN(TURN)**2)
COSTRN = 1. - 0.5*SINTRN**2
COSTRN = 0.5*(COSTRN + (1.-SINTRN**2)/COSTRN)
COSTRN = 0.5*(COSTRN + (1.-SINTRN**2)/COSTRN)
C --- SIN(LAMBDA)
SINLH = TRKOUT(5)*TRKOUT(11)+TRKOUT(6)*TRKOUT(12)+
+ TRKOUT(7)*TRKOUT(13)
C --- NEW STARTING POINT
HN = 1. - COSTRN
HZ = (TURN - SINTRN)*SINLH
TRKOUT(2) = TRKOUT(2) +
+ RHO*(SINTRN*TRKOUT(5) + HN*TRKOUT( 8) + HZ*TRKOUT(11))
TRKOUT(3) = TRKOUT(3) +
+ RHO*(SINTRN*TRKOUT(6) + HN*TRKOUT( 9) + HZ*TRKOUT(12))
TRKOUT(4) = TRKOUT(4) +
+ RHO*(SINTRN*TRKOUT(7) + HN*TRKOUT(10) + HZ*TRKOUT(13))
C --- NEW TANGENT
HN = HN*SINLH
TRKOUT(5) =
+ COSTRN*TRKOUT(5) + SINTRN*TRKOUT( 8) + HN*TRKOUT(11)
TRKOUT(6) =
+ COSTRN*TRKOUT(6) + SINTRN*TRKOUT( 9) + HN*TRKOUT(12)
TRKOUT(7) =
+ COSTRN*TRKOUT(7) + SINTRN*TRKOUT(10) + HN*TRKOUT(13)
C
IF(ABS(TRKOUT(7)) .GE. 1.)GO TO 995
C
C--- KLOE code modification ----- begin ------ A.Andryakov----
C We have an uniform magnetic field and so don't need any corr. on VH
C
VH(1) = 0.
VH(2) = TIFLAV*BRADL/CONVERS
VH(3) = TIFLAV*(1.-0.5*BRADL*BRADL)/CONVERS
C
C--- KLOE code modification ----- end -------- A.Andryakov----
C
C ----------------->> NOW UPDATE VH AND VNORM
C At present in KLOE magnetic field is uniform
C
C --- NORMAL VECTOR N = T X H
TRKOUT( 8) = TRKOUT(6)*TRKOUT(13)-TRKOUT(7)*TRKOUT(12)
TRKOUT( 9) = TRKOUT(7)*TRKOUT(11)-TRKOUT(5)*TRKOUT(13)
TRKOUT(10) = TRKOUT(5)*TRKOUT(12)-TRKOUT(6)*TRKOUT(11)
COSLAM = SQRT(1. - TRKOUT(7)**2)
C ----------------->> UPDATE K FROM RIGHT REGION
IBNK = 3
c IF( DR0 .GT. SRFVDC(2) )IBNK=2
c IF( DR0 .GT. SRFVDC(1) )IBNK=1
IF(IBNK.GT.MXBNK)IBNK = MXBNK
C -- ADDED -- 3.05.84 --- CHANGED 08.11.84
TRKSP(IBNK) =
+ SIGN(ABS(TRKSP(IBNK))-ARCL*TRKBNK(31,IBNK,ITRK),
+ TRKSP(IBNK))
RHO = TRKOUT(14)*TRKSP(IBNK)*EBYCIV
C
200 CONTINUE
C ----------------->> INSURE THAT TANGENT IS NORMALIZED
TINV = 1./SQRT(TRKOUT(5)**2+TRKOUT(6)**2+TRKOUT(7)**2)
IF( ABS(TINV-1.) .LT. 0.0001 )GO TO 210
TRKOUT(5) = TRKOUT(5)*TINV
TRKOUT(6) = TRKOUT(6)*TINV
TRKOUT(7) = TRKOUT(7)*TINV
210 CONTINUE
C ----------------->> UPDATE TRACK LENGTH AND
C GET NEW ESTIMATE OF SWIM DISTANCE
TRKOUT(1) = TRKOUT(1) - ARCL*FLOAT(NDX)
SWLNGH = ( (WVTX(1)-TRKOUT(2))*TRKOUT(5) +
+ (WVTX(2)-TRKOUT(3))*TRKOUT(6) )/COSLAM**2
C --- EXIT IF TRACK SWUM
IF( ABS(SWLNGH) .LT. 0.1 ) GO TO 400
C ----------------->> OTHERWISE TRY A MORE REFINED CALC
C FOR LOW PT TRACKS
C
DELT(1) = TRKOUT(2) + RHO*TRKOUT(6) - WVTX(1)
DELT(2) = TRKOUT(3) - RHO*TRKOUT(5) - WVTX(2)
DLTIV = SIGN(1./SQRT(DELT(1)**2 + DELT(2)**2),RHO)
WWVTX(1) = WVTX(1) + (1.-RHO*COSLAM*DLTIV)*DELT(1)
WWVTX(2) = WVTX(2) + (1.-RHO*COSLAM*DLTIV)*DELT(2)
SWLNGH = ( (WWVTX(1)-TRKOUT(2))*TRKOUT(5) +
+ (WWVTX(2)-TRKOUT(3))*TRKOUT(6) )/COSLAM**2
300 CONTINUE
C IF HERE, TOO MANY ITERATIONS
CALL INERR(571,1)
LERR = 1
GO TO 998
C
400 CONTINUE
C
C ----------------->> FIND CORRECT COVARIANCE MATRIX
C IF FLGVDC = TRKBNK(32,4,*).GE.100, THEN VDC HITS IN FIT
IVOL = 3
IF(FLGVDC)IVOL = 2
C
IF( IBNK.EQ.IVOL )GO TO 450
C ----------------- A SWIM ENDING IN REGION 3(IVOL) IS ALWAYS LEGAL
C
c IF( IBNK.EQ.IVOL-1 .AND. ABS(DR0-RSRFCO(2)).LT.1. )GO TO 450
C ----------------- A SWIM ENDING IN REGION 2 AND HAVING BEEN SWUM
C THRU REGION 3 IS DECLARED LEGAL IF WITHIN 1 CM
C OF THE DC SIDE OF THE BEAM TUBE SURFACE (IN ORDER
C TO AVOID DISCARDING GOOD TRACKS IF THE VTX
C APPROXIMATION IS A LITTLE WRONG)
C IF FLGVDC , REPLACE 3 BY IVOL ETC...
C
C NEED TO SEE WHETHER LEGAL IF HERE
LERR = 2
IF( (IBNK .LT. MXBNK .AND.
+ (TRKOUT(1).GT.TRKBNK(1,IBNK+1,ITRK))
+ .OR. TRKOUT(1).LT.0.85*DIRSWM*TRKBNK(1,1,ITRK)) )GO TO 998
C ----------------- A SWIM ENDING IN REGION 1(2) MUST NOT HAVE PASSED
C THRU REGION 2(3) (EXCEPT FOR THE ABOVE EXCEPTION)
C THE CHECK IS MADE AGAINST THE TRK LENGTH TO THE
C NEXT LOWEST REGION (I.E. CLOSEST TO THE BEAM LINE)
C A SWIM IN REGION 1 ALONG THE DIRECTION
C OF PARTICLE MOTION MUST BE EXPRESSLY ENABLED
C WITH DIRSWM SET TO -1.0 BEFORE THE CALL TO VXSWIM
C
450 CONTINUE
C -- ADDED -- 3.05.84 :: CHANGED 9.11.84 CONVERT TO K FROM P,COSLAM
C ----------------------:: IF NO SWIM ITERATION THEN FILLED ON ENTRY
TRKOUT(30) = 1./(TRKSP(IBNK)*COSLAM)
C-----------------------
C
CALL VXERRC(TRKBNK(1,IBNK,ITRK),TRKOUT)
LERR = 10
IF(AMIN1(TRKOUT(15),TRKOUT(20),TRKOUT(24),TRKOUT(27),TRKOUT(29))
+ .LE.0.0)GO TO 998
LERR = 0
RETURN
C
995 CONTINUE
LERR = 5
GO TO 998
996 CONTINUE
LERR = 4
GO TO 998
998 CONTINUE
C LERR =0,1,2,3,4,5,6,7,8,9,10
IF (LERR.EQ.4.OR.LERR.EQ.5.OR.LERR.EQ.7)
> CALL INERR(572,1)
IF (LERR.EQ.10) CALL INERR(515,1)
999 CONTINUE
C
RETURN
END
C 27/11/89 MEMBER NAME VXCRSS (ES) FVS
C 26/07/84 MEMBER NAME VXCRSS (MAR85) FORTRAN
SUBROUTINE VXCRSS(ILIST,XINT,LERRC,CNVGMA)
$$IMPLICIT
C
C SUBROUTINE FOR FINDING APPROXIMATE INTERSECTION OF TWO TRACKS
C --- CALLED FROM VXMAIN AND VXSCND
C
C ORIGINAL VERSION BY D.COPPAGE FOR ARGUS (QUITE POORLY CODED).
C REVISED BY A.CALCATERRA FOR KLOE ON 20 NOV 96
C
C INPUT :
C ILIST(2) = LIST OF A PAIR OF TRACK NUMBERS
C OUTPUT:
C XINT(3) = APPROXIMATE X,Y,Z INTERSECTION OF TRACK PAIR
C LERRCR = 0 UNLESS TRACK SWIM REFUSED IN VXTKIN (LERRC=6)
C OR THE MAGNETIC FIELD IS *VERY* SMALL (LERRC=7)
C CNVGMA = LOGICAL VARIABLE TELLING WHETHER TRACKS IN THE PAIR
C ARE TANGENT WITHIN CUTS DRIVEN BY TOLER (SEE BELOW)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
LOGICAL CNVGMA
INTEGER ILIST(2),LERRC
REAL XINT(3)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
$$INCLUDE 'K$ITRK:CCONST.INC'
$$INCLUDE 'K$ITRK:CVXWORK.INC'
C
REAL PROXIM
C
LOGICAL EXTCRC,INTCRC
INTEGER LSTRG1,LSTRG2,INRMST,REG,REGION,NDX
INTEGER IL,IG
REAL RRMIN,RR,TRMIV
REAL DCC,RLCOS,ARGMNT,A_HALF
REAL DLTZ,SGNIL,SGNIG,DLTCPL,DLTCMN,ANGNW
REAL VS(3,2),TS(3,2),VH(3),RHO(2)
REAL ANGSTR(2),XCTR(2,2),CTGTHE(2),U(2),ANG(2),ZPL(2),ZMN(2)
REAL SGNQB(2),ANGCTR(2),TURNPL(2),TURNMN(2)
C
REAL TOLER /0.10/
C
LERRC = 0
C
C Find the innermost region in which both tracks have been swum
LSTRG1 = ITKBNK(32,2,ILIST(1))
IF (LSTRG1 .LT. 0) THEN
LERRC = 6
RETURN
ENDIF
C
LSTRG2 = ITKBNK(32,2,ILIST(2))
IF (LSTRG2 .LT. 0) THEN
LERRC = 6
RETURN
ENDIF
C
INRMST = MIN0(LSTRG1,LSTRG2)
C
RRMIN = 1.E38
DO REG=1,INRMST
RR = (TRKBNK(2,REG,ILIST(1))-TRKBNK(2,REG,ILIST(2)))**2
+ +(TRKBNK(3,REG,ILIST(1))-TRKBNK(3,REG,ILIST(2)))**2
+ +(TRKBNK(4,REG,ILIST(1))-TRKBNK(4,REG,ILIST(2)))**2
IF (RR .LT. RRMIN) THEN
RRMIN = RR
REGION = REG
ENDIF
ENDDO
C
DO NDX=1,2
VS(1,NDX) = TRKBNK(2,REGION,ILIST(NDX))
VS(2,NDX) = TRKBNK(3,REGION,ILIST(NDX))
VS(3,NDX) = TRKBNK(4,REGION,ILIST(NDX))
TS(1,NDX) = TRKBNK(5,REGION,ILIST(NDX))
TS(2,NDX) = TRKBNK(6,REGION,ILIST(NDX))
TS(3,NDX) = TRKBNK(7,REGION,ILIST(NDX))
CALL MGFLD(TRKBNK(2,REGION,ILIST(NDX)),VH)
IF (ABS(VH(3)) .LE. 1.0E-4) THEN
LERRC = 7
RETURN
ELSE
C
C KLOE convention: RHO is >0 for a positive particle, turning CLOCKWISE.
RHO(NDX) = 1./(CONVERS*VH(3)*TRKBNK(30,REGION,ILIST(NDX)))
SGNQB(NDX) = SIGN(1.0,RHO(NDX))
C
C This is the angle from the center of curvature to the starting point
ANGSTR(NDX)=
+ ATAN2(SGNQB(NDX)*TS(1,NDX), -SGNQB(NDX)*TS(2,NDX))
C
C These are the coordinates of the center of curvature
TRMIV = 1./SQRT(TS(1,NDX)**2+TS(2,NDX)**2)
XCTR(1,NDX) = VS(1,NDX) + RHO(NDX)*TS(2,NDX)*TRMIV
XCTR(2,NDX) = VS(2,NDX) - RHO(NDX)*TS(1,NDX)*TRMIV
C
C This is the cotangent of theta (or the tangent of lambda, the dip angle)
CTGTHE(NDX) = TS(3,NDX)/SQRT(1.0-TS(3,NDX)*TS(3,NDX))
RHO(NDX) = ABS(RHO(NDX))
ENDIF
ENDDO
C ----------------->> ASSURE THAT RHO(IG) .GT. RHO(IL)
IF (RHO(1) .LT. RHO(2)) THEN
IL=1
IG=2
ELSE
IL=2
IG=1
ENDIF
C
C U is the vector joining the centers of the two circles in the tr. plane
U(1) = XCTR(1,IG)-XCTR(1,IL)
U(2) = XCTR(2,IG)-XCTR(2,IL)
DCC = SQRT(U(1)**2+U(2)**2)
C
C ----------------->> TEST FOR ALMOST TANGENT CIRCLES
C
EXTCRC = DCC .GT. (RHO(1)+RHO(2))
INTCRC = DCC .LT. (RHO(IG)-RHO(IL))
C
IF (EXTCRC .OR. INTCRC) THEN
C
C The two circles have *NO* intersections. Use the point of closest
C approach to both helices.
C Finally, if the circles are "tangent within cuts", flag CNVGMA = .true.
ANGCTR(IL) = ATAN2(U(2),U(1))
ANGCTR(IG) = ATAN2(-U(2),-U(1))
IF (INTCRC) ANGCTR(IL) = ANGCTR(IG)
C
TURNPL(IL) = PROXIM(ANGCTR(IL)-ANGSTR(IL),0.)
ZPL(IL) = VS(3,IL) - SGNQB(IL)*TURNPL(IL)*RHO(IL)*CTGTHE(IL)
C
TURNPL(IG) = PROXIM(ANGCTR(IG)-ANGSTR(IG),0.)
ZPL(IG) = VS(3,IG) - SGNQB(IG)*TURNPL(IG)*RHO(IG)*CTGTHE(IG)
C
DLTZ = ABS(ZPL(IG)-ZPL(IL))
IF (INTCRC) THEN
A_HALF = (RHO(IG)-RHO(IL)-DCC)/2.
ELSE
A_HALF = (DCC-RHO(IG)-RHO(IL))/2.
ENDIF
XINT(1) = XCTR(1,IL) + (RHO(IL)+A_HALF)*COS(ANGCTR(IL))
XINT(2) = XCTR(2,IL) + (RHO(IL)+A_HALF)*SIN(ANGCTR(IL))
XINT(3) = 0.5*(ZPL(IG)+ZPL(IL))
C
IF (INTCRC) THEN
CNVGMA = RHO(IG)-DCC-RHO(IL) .LT. TOLER*DCC
ELSE
CNVGMA = DCC-RHO(1)-RHO(2) .LT. TOLER*(RHO(1)+RHO(2))
ENDIF
ELSE
C
C The two circles have exactly two intersections
CNVGMA = .FALSE.
C
C This is the distance from the center of circle IL to the chord
C between the two intersections.
RLCOS = ((DCC**2-RHO(IG)**2)+RHO(IL)**2)/(2.*DCC)
ARGMNT = RLCOS/RHO(IL)
IF (ABS(ARGMNT) .GT. 1.) THEN
ARGMNT = SIGN(1.,ARGMNT)
ENDIF
C
C This is a half of the chord angle, defined positive
ANG(IL) = ACOS(ARGMNT)
C
C Same for circle IG....
ARGMNT = (DCC-RLCOS)/RHO(IG)
IF (ABS(ARGMNT) .GT. 1.) THEN
ARGMNT = SIGN(1.,ARGMNT)
ENDIF
ANG(IG) = ACOS(ARGMNT)
C
C This is the angle of center IG seen from IL, correctly in (-PI,PI)
ANGCTR(IL) = ATAN2(U(2),U(1))
SGNIL = SIGN(1.0,ANGCTR(IL))
C
C And here is the angle of center IL seen from IG, also in (-PI,PI)
ANGCTR(IG) = ATAN2(-U(2),-U(1))
SGNIG = SIGN(1.0,ANGCTR(IG))
C
C These 4 TURNs are the ang.distances from the 2 starting points up to the
C intersections (2 for each track). Signs are geometric: clockwise --> < 0
TURNPL(IL) = PROXIM(ANGCTR(IL)+SGNIL*ANG(IL)-ANGSTR(IL),0.)
C
C The 4 - signs below take into account the KLOE convention above
ZPL(IL) = VS(3,IL) - SGNQB(IL)*TURNPL(IL)*RHO(IL)*CTGTHE(IL)
C
TURNPL(IG) = PROXIM(ANGCTR(IG)+SGNIG*ANG(IG)-ANGSTR(IG),0.)
ZPL(IG) = VS(3,IG) - SGNQB(IG)*TURNPL(IG)*RHO(IG)*CTGTHE(IG)
C
TURNMN(IL) = PROXIM(ANGCTR(IL)-SGNIL*ANG(IL)-ANGSTR(IL),0.)
ZMN(IL) = VS(3,IL) - SGNQB(IL)*TURNMN(IL)*RHO(IL)*CTGTHE(IL)
C
TURNMN(IG) = PROXIM(ANGCTR(IG)-SGNIG*ANG(IG)-ANGSTR(IG),0.)
ZMN(IG) = VS(3,IG) - SGNQB(IG)*TURNMN(IG)*RHO(IG)*CTGTHE(IG)
C
C The good intersection is the closest one to both points.
DLTCPL = TURNPL(IL)**2+TURNPL(IG)**2
DLTCMN = TURNMN(IL)**2+TURNMN(IG)**2
IF (DLTCPL .GT. DLTCMN) THEN
ANGNW = ANGCTR(IL) - SGNIL*ANG(IL)
XINT(3) = 0.5*(ZMN(IG)+ZMN(IL))
ELSE
ANGNW = ANGCTR(IL) + SGNIL*ANG(IL)
XINT(3) = 0.5*(ZPL(IG)+ZPL(IL))
ENDIF
XINT(1) = XCTR(1,IL) + RHO(IL)*COS(ANGNW)
XINT(2) = XCTR(2,IL) + RHO(IL)*SIN(ANGNW)
ENDIF
C
RETURN
END
C 27/11/89 911301527 MEMBER NAME VXDIFF (ES) FVS
C 10/05/84 512092236 MEMBER NAME VXDIFF (NOV85) FORTRAN
SUBROUTINE VXDIFF(IVTX,M1,M2,TMV0,P,TANL,PHI,COV,DELMSS,R3,CHI2)
$$IMPLICIT
C
C --- D. COPPAGE --- VERSION 18.05.84 V1.0 (ARG07)
C 25.06.84 V2.01 (ARG07)
C 26.10.84 V2.02 (ARG07) CALC XI2P FROM BL
C IF IVXT = 1
C 10.01.85 V2.03 (ARG08) FIX COT SING PROB
C 09.12.85 V3.00 (ARG08) FIX SING TAN AND
C FIX SIGN MISTAKE IN PHI DERV
C
C SUBROUTINE FOR CALCULATING PARAMETERS FOR A NEUTRAL TRACK
C --- CALLED FROM VXMAIN
C
C INPUT :
C IVTX = VERTEX NUMBER
C NHDVTX = MAXIMUM NUMBER OF FOUND VERTICES
C M1,M2 = PARTICLE IDS FOR V0 DAUGHTERS
C TMV0 = CALCULATED V0 INV MASS
C ALMOST EVERYTHING IN /CWORK/
C OUTPUT :
C P = TOTAL MOMENTUM OF DECAYING NEUTRAL
C TANL = COTANGENT(POLAR ANGLE) OF THE DIRECTION OF P
C PHI = X,Y ANGLE OF DIRECTION OF P
C COV = COVARIANCE MATRIX FOR P,TANL,PHI
C DELMSS = ERROR IN INV MASS CALC
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
$$INCLUDE 'K$ITRK:CCONST.INC'
$$INCLUDE 'K$ITRK:CFLAGS.INC'
$$INCLUDE 'K$ITRK:CVXWORK.INC'
C
INTEGER IVTX,M1,M2
REAL TMV0,P,TANL,PHI,COV,DELMSS,R3,CHI2
C
INTEGER LPTR,MPTR
REAL CSL2,GTANLM,GPHI
REAL VRGPHI,VRGTLM,COTNLP,WTL,WTP
REAL FNORM,WTLP,CHI2L,CHI2P
REAL VXCOVR
C
REAL PDF,SDF,PHIDF,FMDF,GPHIDF
REAL GTNLDF,COVPNT
DIMENSION COV(6),PDF(6),SDF(6),PHIDF(6),FMDF(6),GPHIDF(6)
+ ,GTNLDF(6),COVPNT(3)
LOGICAL LINVR
REAL PTOT,SK1,S1,PHI1,CL1,SK2,S2,PHI2,CL2
REAL STOT
REAL PHITOT
REAL PSK,CSL1
REAL PS
REAL PPHI
REAL SSK,PSK1
REAL SS
REAL SPHI,XXXX,PPHI1
REAL PHISK,PTOTX,PTOTY
REAL PHIS
REAL FMSK,P1,FM1,P2,FM2
REAL FMS
REAL FMPH
REAL GPHIX,X1,XN,SINGPH,COSGPH
REAL GPHIY
REAL GTNLMX,Z1,ZN,RTWO
REAL GTNLMY,YN,Y1
REAL GTNLMZ
PTOT(SK1,S1,PHI1,CL1,SK2,S2,PHI2,CL2) =
+ SQRT( 1./(SK1*CL1)**2 + 1./(SK2*CL2)**2 +
+ 2.*(COS(PHI1-PHI2)+S1*S2)/(SK1*SK2) )
STOT(SK1,S1,SK2,S2,P) =
+ (S1/SK1+S2/SK2)/SQRT(P**2-(S1/SK1+S2/SK2)**2)
PHITOT(SK1,PHI1,SK2,PHI2) =
+ ATAN2(SIN(PHI1)/SK1+SIN(PHI2)/SK2,COS(PHI1)/SK1+COS(PHI2)/SK2)
C
PSK(SK1,S1,PHI1,CSL1,SK2,S2,PHI2,P) =
+ -(1./(CSL1*SK1)**2+(COS(PHI1-PHI2)+S1*S2)/(SK1*SK2))/(P*SK1)
PS(SK1,S1,SK2,P) = S1/(SK1*SK2*P)
PPHI(SK1,PHI1,SK2,PHI2,P) = -SIN(PHI1-PHI2)/(SK1*SK2*P)
C
SSK(SK1,S1,SK2,S2,P,PSK1) =
+ -(S1*(P/SK1)**2+P*PSK1*(S1/SK1+S2/SK2))/
+ SQRT((P**2-(S1/SK1+S2/SK2)**2)**3)
SS(SK1,S1,SK2,S2,P) =
+ (P**2/SK1-S1/(SK1*SK2)*(S1/SK1+S2/SK2))/
+ SQRT((P**2-(S1/SK1+S2/SK2)**2)**3)
C --- STOT IS A STATEMENT FUNCTION!!! NOT GOOD AS ARGUMENT!!!
CCC SPHI(SK1,S1,SK2,S2,STOT,P,PPHI1) =
CCC + -STOT*P*PPHI1/(P**2-(S1/SK1+S2/SK2)**2)
SPHI(SK1,S1,SK2,S2,XXXX,P,PPHI1) =
+ -XXXX*P*PPHI1/(P**2-(S1/SK1+S2/SK2)**2)
C
PHISK(SK1,PHI1,SK2,PHI2,PTOTX,PTOTY) =
+ SIN(PHI2-PHI1)/(SK1**2*SK2*(PTOTX**2+PTOTY**2))
PHIS(SK1,PHI1,SK2,PHI2,PTOTX,PTOTY) =
+ (1./SK1 + COS(PHI1-PHI2)/SK2)/(SK1*(PTOTX**2+PTOTY**2))
C
CR PHISK(SK1,PHI1,SK2,PHI2,PHITOT) =
CR + (TAN(PHITOT)*COS(PHI1)-SIN(PHI1))/
CR + ((SK1**2*(1.+TAN(PHITOT)**2))*(COS(PHI1)/SK1+COS(PHI2)/SK2))
CR PHISKI(SK1,PHI1,SK2,PHI2,PHITOT) =
CR + - (1./TAN(PHITOT)*SIN(PHI1)-COS(PHI1))/
CR + ((SK1**2*(1.+1./TAN(PHITOT)**2))*(SIN(PHI1)/SK1+SIN(PHI2)/SK2))
CR PHISI(SK1,PHI1,SK2,PHI2,PHITOT) =
CR + ( SIN(PHI1)-1./TAN(PHITOT)*COS(PHI1))/
CR + ( (1.+1./TAN(PHITOT)**2)*SK1*(SIN(PHI1)/SK1+SIN(PHI2)/SK2))
CR PHIS(SK1,PHI1,SK2,PHI2,PHITOT) =
CR + ( COS(PHI1)-TAN(PHITOT)*SIN(PHI1))/
CR + ( (1.+TAN(PHITOT)**2)*SK1*(COS(PHI1)/SK1+COS(PHI2)/SK2))
C
FMSK(SK1,S1,PHI1,P1,FM1,SK2,S2,PHI2,P2,FM2,TMV0) =
+ (-P1**2*SQRT( (P2**2+FM2**2)/(P1**2+FM1**2) )
+ +( COS(PHI1-PHI2) +S1*S2 )/( SK1*SK2 ) )/( SK1*TMV0)
FMS(SK1,S1,P1,FM1,SK2,S2,P2,FM2,TMV0) =
+ ( S1*SQRT( (P2**2+FM2**2)/(P1**2+FM1**2) )/SK1**2
+ - S2/(SK1*SK2) ) /TMV0
FMPH(SK1,PHI1,SK2,PHI2,TMV0) = -SIN(PHI1-PHI2)/(SK1*SK2*TMV0)
C
GPHIX(X1,XN,SINGPH,COSGPH) = SINGPH*COSGPH/(XN-X1)
GPHIY(X1,XN,COSGPH) = -COSGPH**2/(XN-X1)
GTNLMX(X1,Z1,XN,ZN,RTWO) = (ZN-Z1)*(XN-X1)/RTWO**3
GTNLMY(Y1,Z1,YN,ZN,RTWO) = (ZN-Z1)*(YN-Y1)/RTWO**3
GTNLMZ(Z1,RTWO) = -1./RTWO
C
LPTR = KVX(IVTX)+19
SK1 = FV(LPTR)
S1 = FV(LPTR+1)
CSL1 = 1./SQRT(1.+S1**2)
PHI1 = FV(LPTR+2)
LPTR = LPTR + 17
SK2 = FV(LPTR)
S2 = FV(LPTR+1)
CSL2 = 1./SQRT(1.+S2**2)
PHI2 = FV(LPTR+2)
P = PTOT(SK1,S1,PHI1,CSL1,SK2,S2,PHI2,CSL2)
TANL = STOT(SK1,S1,SK2,S2,P)
PHI = PHITOT(SK1,PHI1,SK2,PHI2)
LINVR = .FALSE.
IF( ABS(ABS(PHI)-PIBY2).LT.PIBY4 )LINVR = .TRUE.
PDF(1) = PSK(SK1,S1,PHI1,CSL1,SK2,S2,PHI2,P)
PDF(2) = PS(SK1,S1,SK2,P)
PDF(3) = PPHI(SK1,PHI1,SK2,PHI2,P)
PDF(4) = PSK(SK2,S2,PHI2,CSL2,SK1,S1,PHI1,P)
PDF(5) = PS(SK2,S2,SK1,P)
PDF(6) = -PDF(3)
C
SDF(1) = SSK(SK1,S1,SK2,S2,P,PDF(1))
SDF(2) = SS(SK1,S1,SK2,S2,P)
SDF(3) = SPHI(SK1,S1,SK2,S2,TANL,P,PDF(3))
SDF(4) = SSK(SK2,S2,SK1,S1,P,PDF(4))
SDF(5) = SS(SK2,S2,SK1,S1,P)
SDF(6) = SPHI(SK2,S2,SK1,S1,TANL,P,PDF(6))
C
PTOTX = COS(PHI1)/SK1 + COS(PHI2)/SK2
PTOTY = SIN(PHI1)/SK1 + SIN(PHI2)/SK2
PHIDF(1) = PHISK(SK1,PHI1,SK2,PHI2,PTOTX,PTOTY)
PHIDF(2) = PHISK(SK2,PHI2,SK1,PHI1,PTOTX,PTOTY)
PHIDF(3) = 0.
PHIDF(4) = PHIS(SK1,PHI1,SK2,PHI2,PTOTX,PTOTY)
PHIDF(5) = PHIS(SK2,PHI2,SK1,PHI1,PTOTX,PTOTY)
PHIDF(6) = 0.
CR IF(LINVR)GO TO 50
CR PHIDF(1) = PHISK(SK1,PHI1,SK2,PHI2,PHI)
CR PHIDF(2) = PHIS(SK1,PHI1,SK2,PHI2,PHI)
CR PHIDF(3) = 0.0
CR PHIDF(4) = PHISK(SK2,PHI2,SK1,PHI1,PHI)
CR PHIDF(5) = PHIS(SK2,PHI2,SK1,PHI1,PHI)
CR PHIDF(6) = 0.0
CR GO TO 100
C
C50 CONTINUE
CR PHIDF(1) = PHISKI(SK1,PHI1,SK2,PHI2,PHI)
CR PHIDF(2) = PHISI(SK1,PHI1,SK2,PHI2,PHI)
CR PHIDF(3) = 0.0
CR PHIDF(4) = PHISKI(SK2,PHI2,SK1,PHI1,PHI)
CR PHIDF(5) = PHISI(SK2,PHI2,SK1,PHI1,PHI)
CR PHIDF(6) = 0.0
C100 CONTINUE
C
MPTR = LPTR-17
COV(1) = VXCOVR(PDF,FV(MPTR+3),FV(LPTR+3),PDF)
COV(2) = VXCOVR(PDF,FV(MPTR+3),FV(LPTR+3),SDF)
COV(3) = VXCOVR(PDF,FV(MPTR+3),FV(LPTR+3),PHIDF)
COV(4) = VXCOVR(SDF,FV(MPTR+3),FV(LPTR+3),SDF)
COV(5) = VXCOVR(SDF,FV(MPTR+3),FV(LPTR+3),PHIDF)
COV(6) = VXCOVR(PHIDF,FV(MPTR+3),FV(LPTR+3),PHIDF)
C
P1 =1./(SK1*CSL1)
P2 =1./(SK2*CSL2)
IF (M1.EQ.1) THEN
FM1 = PION_MASS
ELSEIF (M1.EQ. 4) THEN
FM1 = KAON_MASS
ELSEIF (M1.EQ.22) THEN
FM1 = ELEC_MASS
ELSEIF (M1.EQ.29) THEN
FM1 = PROTON_MASS
ENDIF
IF (M2.EQ.1) THEN
FM2 = PION_MASS
ELSEIF (M2.EQ. 4) THEN
FM2 = KAON_MASS
ELSEIF (M2.EQ.22) THEN
FM2 = ELEC_MASS
ELSEIF (M2.EQ.29) THEN
FM2 = PROTON_MASS
ENDIF
FMDF(1) = FMSK(SK1,S1,PHI1,P1,FM1,SK2,S2,PHI2,P2,FM2,TMV0)
FMDF(4) = FMSK(SK2,S2,PHI2,P2,FM2,SK1,S1,PHI1,P1,FM1,TMV0)
FMDF(2) = FMS(SK1,S1,P1,FM1,SK2,S2,P2,FM2,TMV0)
FMDF(5) = FMS(SK2,S2,P2,FM2,SK1,S1,P1,FM1,TMV0)
FMDF(3) = FMPH(SK1,PHI1,SK2,PHI2,TMV0)
FMDF(6) =-FMDF(3)
C
DELMSS = VXCOVR(FMDF,FV(MPTR+3),FV(LPTR+3),FMDF)
C
IF(DELMSS .LT. 0.0)DELMSS = 0.0
IF(DELMSS .GT. 0.0)DELMSS = SQRT(DELMSS)
C
C ----------------->> IF JVX(1) IS SECONDARY, THEN CALCULATE
C XI2(POINTING) FROM BEAM LINE I.E. (0.,0.,0.)
C-OBSOLETE IF( ID(JVX(1)+2) .EQ. 0 )GO TO 150
LPTR = KVX(NHDVTX)
LPTR = LPTR +LV(LPTR)
IF(LPTR + 15 .GT. 2040 )GO TO 150
CALL VZERO(FV(LPTR+6),9)
GO TO 160
C
150 LPTR = KVX(1)
160 MPTR = KVX(IVTX)
RTWO = SQRT((FV(LPTR+6)-FV(MPTR+6))**2+(FV(LPTR+7)-FV(MPTR+7))**2)
R3 = RTWO
CHI2 = -999.
IF(RTWO.LT.0.2)RETURN
C
R3 = SQRT((FV(LPTR+8)-FV(MPTR+8))**2+RTWO**2)
GTANLM = (FV(MPTR+8)-FV(LPTR+8))/RTWO
SINGPH = (FV(MPTR+7)-FV(LPTR+7))/RTWO
COSGPH = (FV(MPTR+6)-FV(LPTR+6))/RTWO
GPHI = ATAN2(SINGPH,COSGPH)
GPHIDF(1) =
+ GPHIX(FV(LPTR+6),FV(MPTR+6),SINGPH,COSGPH)
GPHIDF(4) = -GPHIDF(1)
GPHIDF(2) =
+ GPHIY(FV(LPTR+6),FV(MPTR+6),COSGPH)
GPHIDF(5) = -GPHIDF(2)
GPHIDF(3) = 0.0
GPHIDF(6) = 0.0
GTNLDF(1) = GTNLMX(FV(LPTR+6),FV(LPTR+8),FV(MPTR+6),FV(MPTR+8)
+ ,RTWO)
GTNLDF(4) = -GTNLDF(1)
GTNLDF(2) = GTNLMY(FV(LPTR+7),FV(LPTR+8),FV(MPTR+7),FV(MPTR+8)
+ ,RTWO)
GTNLDF(5) = -GTNLDF(2)
GTNLDF(3) = 1./RTWO
GTNLDF(6) = -GTNLDF(3)
VRGPHI = VXCOVR(GPHIDF,FV(LPTR+9),FV(MPTR+9),GPHIDF)
VRGTLM = VXCOVR(GTNLDF,FV(LPTR+9),FV(MPTR+9),GTNLDF)
COTNLP = VXCOVR(GTNLDF,FV(LPTR+9),FV(MPTR+9),GPHIDF)
C
COVPNT(1) = COV(4)+VRGTLM
COVPNT(2) = COV(5)+COTNLP
COVPNT(3) = COV(6)+VRGPHI
C
WTL = 1./COVPNT(1)
WTP = 1./COVPNT(3)
FNORM = 1. - COVPNT(2)**2*WTL*WTP
WTLP = -2.*COVPNT(2)*WTL*WTP
CHI2L = (TANL-GTANLM)**2*WTL
CHI2P = (PHI-GPHI)**2*WTP
CHI2 = CHI2L + CHI2P +WTLP*(GTANLM-TANL)*(GPHI-PHI)
C
RETURN
END
C 27/11/89 011011806 MEMBER NAME VXDMIN (ES) FVS
C
REAL FUNCTION VXDMIN(INDDAT,X)
C---------------------------------------------------------------------
C FUNCTION TO RETURN ESTIMATE OF THE UNSIGNED DISTANCE OF CLOSEST
C APPROACH OF THE TRACK IN TRACKBANK AD TO THE LINE THROUGH
C
C --- CALLED FROM VXMAIN
C
C X = (X,Y) ALONG Z
C VX = (X,Y,Z) OF TRACK
C
C USE DELTA**2=R**2+RHO**2-2*R*RHO*SIN(Q*BETA) AND |RHO-DELTA|=DMIN
C TO GET ESTIMATE OF CLOSEST APPROACH TO BEAM LINE
C I.E. SEE ARGUS SOFTWARE NOTE #1
C---------------------------------------------------------------------
$$IMPLICIT
$$INCLUDE 'K$INC:BCS.INC'
$$INCLUDE 'K$ITRK:CCONST.INC'
$$INCLUDE 'K$ITRK:DTFS.INC'
C
INTEGER I,INDDAT
REAL X(3),VX(3),V(3),VHFLD(3)
REAL R,PHI,SINBTA,HMAG,SGNH,ACUR,SGNC,RHO,RATIO,DELTA2
C
VXDMIN = 1.0E+30
C
C --- DISTANCE X0 - XBEAM
VX(1) = RW(INDDAT+DTFXCO)-X(1)
VX(2) = RW(INDDAT+DTFYCO)-X(2)
VX(3) = 0.
R = SQRT(VX(1)**2+VX(2)**2)
C
C --- CLOSE ENOUGH ALREADY
IF (R.LT.0.001) THEN
VXDMIN = R
RETURN
ENDIF
C
C --- BETA = ANGLE(T0,VX)
PHI = RW(INDDAT+DTFPHI)
SINBTA = (COS(PHI)*VX(2)-SIN(PHI)*VX(1))/R
C
C --- AVERAGE MAGNETIC FIELD
DO I=1,3
V(I)=0.5*VX(I)+X(I)
END DO
CALL MGFLD(V,VHFLD)
HMAG = ABS(VHFLD(3))
C
C --- NO FIELD --> STRAIGHT TRACK
IF (HMAG.LT.1.E-3) THEN
VXDMIN = ABS(R*SINBTA)
RETURN
ENDIF
C
SGNH = SIGN(1.0,VHFLD(3))
ACUR = ABS(RW(INDDAT+DTFCUR))
SGNC = SIGN(1.,RW(INDDAT+DTFCUR))
RHO = 1./(CONVERS*HMAG*ACUR)
RATIO = R/RHO
DELTA2 = RHO**2*(1.0+RATIO**2-2.0*RATIO*SGNC*SGNH*SINBTA)
VXDMIN = ABS(SQRT(DELTA2)-RHO)
C
RETURN
END
C 10/01/91 101151157 MEMBER NAME VXERRC (ES) FVS
SUBROUTINE VXERRC(TRKB,TRKE)
$$IMPLICIT
C
C --- D. COPPAGE 22/07/83 V 3.00 (ARG05)
C REVISED 27/01/84 V 3.1 (ARG06)
C REVISED 13.10.84 V 3.2 XJ(2),XJ(5) MODIF
C --- H. KAPITZA COMPLETE REVISION OF DERIVATIVES 13.11.86
C (HANDLE BOTH ORIENTATIONS OF MAG. FIELD)
C
C SUBROUTINE FOR CALCULATING THE JACOBIAN AND THEN CALCULATING
C THE COVARIANCE MATRIX AT A NEW POINT ON THE TRACK TRAJECTORY.
C
C --- CALLED FROM VXSWIM
C
C INPUT: TRKB,TRKE (=BEGINING TRKBNK AND END TRKBNK)
C OUTPUT: COVARIANCE MATRIX INTO TRKE
C TRKBNK( N , I , J ):
C N=
C 1 TRACK LENGTH
C 2,3,4 X,Y,Z
C 5,6,7 VTNG X,Y,Z
C 8,9,10 VNORM X,Y,Z (UNNORMALIZED)
C 11,12,13 VH X,Y,Z (UNIT VECTOR IN DIR OF MAG FIELD)
C 14 1./VHMAG (MAGNITUDE OF MAG FIELD)
C 15 - 29 COVARIANCE MATRIX FOR REGION I
C 30 SIGNED VALUE OF K
C 31 ABS(DK/DX) (DEFAULT MASS = PI MASS. K FROM REGION 1)
C 32 > FOR I=1, STATUS WORD; = 1 COPY BNK 1 TO TRKOUT
C = 2 COPY BNK 2 TO TRKOUT
C = 3 INIT TRKOUT FROM BEST BNK
C = 4 USE TRKOUT WITH MODIFICATION
C > FOR I=2, STATUS WORD; NUMBER OF LAST FILLED BANK
C =-1 NO BANKS FILLED
C > FOR I=3, STATUS WORD; = +1.0 FOR NEGATIVE SWIMS (NORMAL)
C = -1.0 FOR POSITIVE SWIMS (MUST BE
C SET WHEN NEEDED)
C > FOR I=4, STATUS WORD; NUMBER OF BANK USED TO INITIALIZE
C THE WORKING BANK WHEN LAST INIT.
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
$$INCLUDE 'K$ITRK:CCONST.INC'
$$INCLUDE 'K$ITRK:CFLAGS.INC'
REAL TRKB,TRKE,XJ
DIMENSION TRKB(31),TRKE(31),XJ(5)
REAL COSLAM,COSLAB,VNXB,VNYB,VNXE,VNYE,VDFX,VDFY,SWMLGH
C
C ----------------->> WE MUST NOT USE VN = H (X) T
C BUT VN = EZ (X) T
COSLAM = SQRT(1.-TRKE(7)**2)
COSLAB = SQRT(1.-TRKB(7)**2)
VNXB = -TRKB(6)/COSLAB
VNYB = TRKB(5)/COSLAB
VNXE = -TRKE(6)/COSLAM
VNYE = TRKE(5)/COSLAM
VDFX = TRKE(2)-TRKB(2)
VDFY = TRKE(3)-TRKB(3)
C
C ----- XJ(1,1) = VNE * VNB
C
XJ(1) = VNXE*VNXB + VNYE*VNYB
C
C ----- XJ(1,3) = (VXB - VXE) * VNE / KAPPA
C
XJ(2) = - (VDFX*VNXE + VDFY*VNYE) / TRKB(30)
CCC XJ(2) = -0.5*(VDFX**2 + VDFY**2) * CONVERS / TRKE(14)
C
C ----- XJ(1,5) = ( (VXE-VXB) (X) VNE ) (Z-COMP)
C
XJ(3) = VDFX*VNYE - VDFY*VNXE
C
C ----- XJ(2,4) = SWMLGH * COSLAM
C
SWMLGH = TRKB(1) - TRKE(1)
XJ(4) = SWMLGH * COSLAM
C
C ----- XJ(5,3) = - SIGN(HZ) * SWMLGH * COSLAM * E/C*H
C
XJ(5) = -SIGN(1.,TRKE(13)) * SWMLGH * COSLAM * CONVERS / TRKE(14)
C
C ----------------->> NOW GET NEW COVARIANCE MATRIX
C
TRKE(15) = XJ(1) * (TRKB(15)*XJ(1)+TRKB(17)*XJ(2)+TRKB(19)*XJ(3))
* +XJ(2) * (TRKB(17)*XJ(1)+TRKB(24)*XJ(2)+TRKB(26)*XJ(3))
* +XJ(3) * (TRKB(19)*XJ(1)+TRKB(26)*XJ(2)+TRKB(29)*XJ(3))
TRKE(16) = XJ(1) * (TRKB(16) + TRKB(18)*XJ(4))
* +XJ(2) * (TRKB(21) + TRKB(25)*XJ(4))
* +XJ(3) * (TRKB(23) + TRKB(28)*XJ(4))
TRKE(17) = XJ(1)*TRKB(17) + XJ(2)*TRKB(24) + XJ(3)*TRKB(26)
TRKE(18) = XJ(1)*TRKB(18) + XJ(2)*TRKB(25) + XJ(3)*TRKB(28)
TRKE(19) = XJ(1)*(TRKB(17)*XJ(5) + TRKB(19))
* +XJ(2)*(TRKB(24)*XJ(5) + TRKB(26))
* +XJ(3)*(TRKB(26)*XJ(5) + TRKB(29))
TRKE(20) = TRKB(20) + TRKB(22)*XJ(4)
* +XJ(4)*(TRKB(22) + TRKB(27)*XJ(4))
TRKE(21) = TRKB(21) + XJ(4)*TRKB(25)
TRKE(22) = TRKB(22) + XJ(4)*TRKB(27)
TRKE(23) = TRKB(23) + TRKB(21)*XJ(5)
* +XJ(4)*(TRKB(28) + TRKB(25)*XJ(5))
TRKE(24) = TRKB(24)
TRKE(25) = TRKB(25)
TRKE(26) = TRKB(24)*XJ(5) + TRKB(26)
TRKE(27) = TRKB(27)
TRKE(28) = TRKB(25)*XJ(5) + TRKB(28)
TRKE(29) = XJ(5)*(TRKB(24)*XJ(5) + TRKB(26))
* +(TRKB(26)*XJ(5) + TRKB(29))
C
RETURN
END
C 27/11/89 MEMBER NAME VXGMMA (ES) FVS
SUBROUTINE VXGMMA(MXCHGD,LERR)
$$IMPLICIT
C
C --- D. COPPAGE --- VERSION 18.05.84 V1.0 (ARG07)
C --- A. PHILLIP --- VERSION 04.07.84 V2.0 ARG07-SPEC FOR CONV GMMA
C 01.08.84 V2.01 ERR IN BNK DET FIXED
C 22.03.85 V2.02 INIT OF ILIST FIXED
C 26.04.85 V3.00 MOD FOR VDC - REMOVED DEDX
C ADJUSTMENT AT BOUNDRY
C
C CODING CONNECTED WITH CONVERTED GAMMAS REMOVED FROM VXMAIN
C --- CALLED FROM VXMAIN
C
C INPUT :
C MXCHGD = MAX NUMBER OF CHARGED TRKS UNDER CONSIDERATION
C KLOE TRACK BANKS
C ALMOST EVERYTHING IN /CWORK/
C OUTPUT :
C VERTEX BANKS IN /CWORK/
C LERR = ERROR FLAG (IF LT 0 EVENT PROCESSING TERMINATED)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
$$INCLUDE 'K$ITRK:CVXCUT.INC'
$$INCLUDE 'K$ITRK:CFLAGS.INC'
$$INCLUDE 'K$ITRK:CVXWORK.INC'
$$INCLUDE 'YBOS$LIBRARY:ERRCOD.INC'
$$INCLUDE 'K$INC:BCS.INC'
$$INCLUDE 'K$ITRK:DTFS.INC'
INTEGER MXCHGD,LERR
INTEGER STATUS,IND,INDDAT,NFLAG
INTEGER BLOCAT
REAL VXERR,XCN
DIMENSION VXERR(6),XCN(3)
INTEGER ILIST,IXVDC
INTEGER IHIPR,IHDSIZ,IHIPR1,J,JX1,JX2,IBNK,LWBK
INTEGER JJBNK,JJB1,JJB2,LERRCR,IHH,IFIT,ICALL
REAL AKUR2,AKUR1,TANL1,TANL2,CTCUT,DBEAM,CHISQ
REAL XINT
DIMENSION XINT(3),ILIST(3),
+ IXVDC(3,2)
LOGICAL CONSTR
DATA IXVDC / 1, 2, 3, 0, 1, 2/
C
NFLAG = 3
DO 120 IHIPR=2,MXCHGD
C IF(MSLIST(IGDTK(IHIPR)).NE.0)GO TO 120
ILIST(2)=IGDTK(IHIPR)
STATUS = BLOCAT(IW,'DTFS',
& DTFS_bnk_num_list(ILIST(2)),
& IND,INDDAT)
IHDSIZ=IW(INDDAT+DTFHDS)
INDDAT=INDDAT+IHDSIZ
AKUR2=RW(INDDAT+DTFCUR)
IF(ITKBNK(32,2,ILIST(2)) .LT. 0)GO TO 120
IHIPR1=IHIPR-1
DO 115 J=1,IHIPR1
C IF(MSLIST(IGDTK(J)).NE.0)GO TO 115
ILIST(2)=IGDTK(IHIPR)
ILIST(1)=IGDTK(J)
STATUS = BLOCAT(IW,'DTFS',
& DTFS_bnk_num_list(ILIST(1)),
& IND,INDDAT)
IHDSIZ=IW(INDDAT+DTFHDS)
INDDAT=INDDAT+IHDSIZ
AKUR1=RW(INDDAT+DTFCUR)
IF( IAND(MSLIST(ILIST(1)),MSLIST(ILIST(2))) .NE. 0 )
+ GO TO 115
IF(ITKBNK(32,2,ILIST(1)) .LT. 0)GO TO 115
IF( AKUR1*AKUR2.GT.0.0 )GO TO 115
IF(TRKBNK(27,1,ILIST(1)).LT.0.0 ) GO TO 119
IF(TRKBNK(27,1,ILIST(2)).LT.0.0 ) GO TO 114
C ----------------->> FIND APPROPIATE BANK LEVEL
JX1 = 1
JX2 = 1
IBNK=MIN0(ITKBNK(32,2,ILIST(1)),ITKBNK(32,2,ILIST(2)))
LWBK = 1
IF(IABS(ITKBNK(32,4,ILIST(1))-ITKBNK(32,4,ILIST(2)))
+ .LT. 10)GO TO 90
C ELSE ONE VDC FIT AND ONE DC FIT
LWBK = 2
JX1 = 1
JX2 = 2
IBNK=
+ MIN0(ITKBNK(32,2,ILIST(1)),ITKBNK(32,2,ILIST(2))+1)
IF(ITKBNK(32,4,ILIST(2)).GE.100)GO TO 90
JX1 = 2
JX2 = 1
IBNK=
+ MIN0(ITKBNK(32,2,ILIST(1))+1,ITKBNK(32,2,ILIST(2)))
90 CONTINUE
IF(LWBK.GT.IBNK)GO TO 115
C ----------------->> LOOP OVER AVAILABLE SURFACES
DO 110 JJBNK=LWBK,IBNK
JJB1 = IXVDC(JJBNK,JX1)
JJB2 = IXVDC(JJBNK,JX2)
TANL1 = TRKBNK(7,JJB1 ,ILIST(1))
IF( ABS(TANL1) .GT. 0.02 )
+ TANL1=SIGN( 1.0/SQRT(1.0/TANL1**2-1.0),TANL1 )
TANL2 = TRKBNK(7,JJB2 ,ILIST(2))
IF( ABS(TANL2) .GT. 0.02 )
+ TANL2=SIGN( 1.0/SQRT(1.0/TANL2**2-1.0),TANL2 )
CTCUT = ABS(TANL1-TANL2)/SQRT
+ ( TRKBNK(27,JJB1 ,ILIST(1))+TRKBNK(27,JJB2 ,ILIST(2)) )
IF( CTCUT .LT. 15.)GO TO 111
110 CONTINUE
C ----------------->> NO CUT PASSED IF HERE -> EXIT
GO TO 115
111 CONTINUE
C PULL1 = (TANL1-TANL2)/SQRT(TRKBNK(27,JJB1 ,ILIST(1))+
C + TRKBNK(27,JJB2 ,ILIST(2)))
CONSTR = .TRUE.
CALL VXCRSS(ILIST,XINT,LERRCR,CONSTR)
C
IF( LERRCR.NE.0 )GO TO 115
C
DBEAM = SQRT( XINT(1)**2 + XINT(2)**2 )
IF( .NOT.CONSTR .OR. DBEAM .LT. 0.75)GO TO 115
C OTHERWISE TRY A FIT
CALL UCOPY(XINT,XCN,3)
IHH=2
C
CALL VXXYZ(IHH,ILIST,XINT,VXERR,CHISQ,IFIT,XCN,CONSTR)
C
C ----------------->> FOR DEBUG OF PROBLEM VERTICES
ICALL=ICALL+1
IF(ICALL.EQ.ICLLVX)RETURN
IF(IFIT.NE.0)GO TO 115
C ----------------->> STORE VERTEX
C COME BACK AND LOOK FOR MORE
C===================>>THE FOLLOWING CODE TO MODIFY DEDX AT BOUNDARIES
C REMOVED 26.04.85 BECAUSE OF CONFLICT WHEN ONE OF
C THESE TRACKS ALSO CAN BELONG TO THE PRIMARY.
CC AFTER MAKING DEDX CORRECTION FOR
CC MIDDLE OF CORRECT CONVERTER
CC IF(ID(JTK(ILIST(1))+3).GT.200 .OR.
CC + ID(JTK(ILIST(2))+3).GT.200 )GO TO 112
CC RVXY = SQRT(XINT(1)**2+XINT(2)**2)
CC LBNK = 99
CC IF(ABS(RVXY-14.5).LT.2.5)LBNK = 2
CC IF(ABS(RVXY-6.0).LT.6.0)LBNK = 3
CC MXBNK1 = ITKBNK(32,2,ILIST(1))
CC MXBNK2 = ITKBNK(32,2,ILIST(2))
CC IBNK = MIN0(MXBNK1,MXBNK2)
CC IF(LBNK .GT. IBNK)GO TO 112
CC TRKBNK(30,4,ILIST(1)) =
CC + SIGN(ABS(TRKBNK(30,LBNK,ILIST(1)))+DEDK(ILIST(1),LBNK-1)
CC + ,TRKBNK(30,LBNK,ILIST(1)))
CC TRKBNK(30,4,ILIST(2)) =
CC + SIGN(ABS(TRKBNK(30,LBNK,ILIST(2)))+DEDK(ILIST(2),LBNK-1)
CC + ,TRKBNK(30,LBNK,ILIST(2)))
C112 CONTINUE
CALL VXSTOR(ILIST,2,XINT,VXERR,CHISQ,NFLAG,IFIT)
COTCUT(NHDVTX) = CTCUT
GO TO 115
114 CALL INERR(515,1)
115 CONTINUE
GO TO 120
119 CALL INERR(515,1)
120 CONTINUE
C
130 CONTINUE
C
LERR = 0
RETURN
END
C 27/11/89 911301534 MEMBER NAME VXPREP (ES) FVS
C 28/06/84 MEMBER NAME VXPREP (ES) FORTRAN
SUBROUTINE VXPREP(MAX,ILIST,X,XGA,XGB,CSQ,IBADTK,XCN,CONSTR)
$$IMPLICIT
C
C SERVICE ROUTINE FOR VXXYZ FOR INITIALIZING MATRICES AND CHISQ
C AND DRIVER FOR SWIM ROUTINES
C --- CALLED FROM VXXYZ
C
$$INCLUDE 'K$ITRK:CVXCUT.INC'
$$INCLUDE 'K$ITRK:CVXWORK.INC'
C
LOGICAL CONSTR
INTEGER MAX,ILIST(64),IBADTK
REAL X(3),XGA(3,3),XGB(3),CSQ,XCN(3)
C
INTEGER JMAX,ITK,LTK,LERR,KTK
REAL GRDDR(2),GRDDZ(2)
REAL DEVMAX,VMIV,DR,TANLAM,DZ,WR,WZ,WRZ,DENOM
REAL DEV,TAUX,TAUY,DR0C,GRDDRX,GRDDRY
REAL WWR,WWZ
C DATA WWR,WWZ/12.0,1.2/
C ----------------->> INIT
C
WWR = WWRVX
WWZ = WWZVX
DEVMAX=0.0
CSQ=0.0
CALL VZERO(XGA,12)
CALL VZERO(XGB,3)
C
JMAX=MAX
DO 50 ITK=1,MAX
IF(ITK.GT.JMAX)GO TO 52
12 CONTINUE
LTK = ILIST(ITK)
CALL VXSWIM( X, LTK, TRKBNK(1,4,LTK), LERR)
IF(LERR.EQ.0)GO TO 40
C ELSE BAD TRACK
IF(ITK.LT.JMAX)GO TO 15
C ----------------->> ELSE NO TRKS LEFT - SO DECREMENT
C JMAX AND EXIT
JMAX=JMAX-1
IF( ITK .GE. 2 ) GO TO 52
GO TO 60
C
15 CONTINUE
C ----------------->> REMOVE BAD TRACK
LTK=ILIST(ITK)
JMAX=JMAX-1
DO 20 KTK=ITK,JMAX
20 ILIST(KTK)=ILIST(KTK+1)
ILIST(JMAX+1)=LTK
GO TO 12
C
40 CONTINUE
C ----------------->> GET DERIVATIVES,DISTANCES, AND WTS
C
VMIV = 1./SQRT(TRKBNK(5,4,LTK)**2 + TRKBNK(6,4,LTK)**2)
DR = ( (TRKBNK(2,4,LTK)-X(1)) * TRKBNK(6,4,LTK) +
+ (X(2)-TRKBNK(3,4,LTK)) * TRKBNK(5,4,LTK) ) * VMIV
GRDDR(1) = -SIGN( VMIV , DR) * TRKBNK(6,4,LTK)
GRDDR(2) = SIGN( VMIV , DR) * TRKBNK(5,4,LTK)
TANLAM = TRKBNK(7,4,LTK)
IF( ABS(TANLAM) .GT. 0.01 )TANLAM =
+ SIGN(1./SQRT(1./TRKBNK(7,4,LTK)**2-1.),TRKBNK(7,4,LTK))
DZ = TRKBNK(4,4,LTK) - X(3)
GRDDZ(1) = -TRKBNK(5,4,LTK) * TANLAM * VMIV
GRDDZ(2) = TRKBNK(6,4,LTK) * TANLAM * VMIV
WR = 1./TRKBNK(15,4,LTK)
WZ = 1./TRKBNK(20,4,LTK)
C
C ----------------->> GET CSQ
C
C QUESTION ABOUT SIGN OF DR REMAINS - 26.07.84
WRZ = -2.0*TRKBNK(16,4,LTK)*WR*WZ
DENOM = 1. - TRKBNK(16,4,LTK)**2*WR*WZ
DEV = ( DR**2*WR + DR*DZ*WRZ + DZ**2*WZ ) / DENOM
IF(DEV .LT. 0.0)DEV = 9999.
CSQ=CSQ+WR*DR**2 + WZ*DZ**2
IF(DEV.LT.DEVMAX)GO TO 45
DEVMAX=DEV
IBADTK=ITK
45 CONTINUE
C
DR = ABS(DR)
XGB(1)=XGB(1)+WR*DR*GRDDR(1)+WZ*DZ*GRDDZ(1)
XGB(2)=XGB(2)+WR*DR*GRDDR(2)+WZ*DZ*GRDDZ(2)
XGB(3)=XGB(3) -WZ*DZ
XGA(1,1)=XGA(1,1)+WR*GRDDR(1)*GRDDR(1)+WZ*GRDDZ(1)*GRDDZ(1)
XGA(1,2)=XGA(1,2)+WR*GRDDR(1)*GRDDR(2)+WZ*GRDDZ(1)*GRDDZ(2)
XGA(1,3)=XGA(1,3) -WZ*GRDDZ(1)
XGA(2,2)=XGA(2,2)+WR*GRDDR(2)*GRDDR(2)+WZ*GRDDZ(2)*GRDDZ(2)
XGA(2,3)=XGA(2,3) -WZ*GRDDZ(2)
XGA(3,3)=XGA(3,3) +WZ
50 CONTINUE
52 CONTINUE
DEVMAX = SQRT(DEVMAX)
IF( DEVMAX .LT. DVMXVX ) IBADTK = 0
C ----------------->> IF CONSTRAINT ,FIX UP
IF(.NOT.CONSTR)GO TO 57
C ELSE
TAUX = TRKBNK(6,4,LTK)/VMIV
TAUY = -TRKBNK(5,4,LTK)/VMIV
DR0C = (XCN(1)-X(1))*TAUY+(X(2)-XCN(2))*TAUX
IF(ABS(DR0C) .LT. 1.0E-6)DR0C = 1.0E-6
GRDDRX = -SIGN(1.,DR0C)*TAUY
GRDDRY = SIGN(1.,DR0C)*TAUX
XGA(1,1)=XGA(1,1)+WWR*GRDDRX**2
XGA(2,2)=XGA(2,2)+WWR*GRDDRY**2
XGA(1,2)=XGA(1,2)+WWR*GRDDRX*GRDDRY
XGB(1)=XGB(1)+WWR*DR0C*GRDDRX
XGB(2)=XGB(2)+WWR*DR0C*GRDDRY
CSQ=CSQ+WWR*DR0C**2
57 CONTINUE
XGA(2,1)=XGA(1,2)
XGA(3,1)=XGA(1,3)
XGA(3,2)=XGA(2,3)
C
60 CONTINUE
MAX=JMAX
C
RETURN
END
C 27/11/89 911301535 MEMBER NAME VXSCND (ES) FVS
C 07/05/84 412072217 MEMBER NAME VXSCND (NOV84) FORTRAN
SUBROUTINE VXSCND(MXCHGD,NHDSTR,LERR)
$$IMPLICIT
C
C --- D. COPPAGE --- VERSION 18.05.84 V1.0 (ARG07)
C 19.06.84 V1.01 (ARG07)
C 07.12.84 V1.10 (ARG08) SQRT(-|X|) FIXED
C
C CODING CONNECTED WITH SECONDARY VERTICES REMOVED FROM VXMAIN
C --- CALLED FROM VXMAIN
C
C INPUT :
C MXCHGD = MAX NUMBER OF CHARGED TRKS UNDER CONSIDERATION
C NHDSTR = VALUE OF NHDVTX AT WHICH ALL FLAG 1,2, & 3
C FITS FINISHED
C KLOE TRACK BANKS
C ALMOST EVERYTHING IN /CWORK/
C OUTPUT :
C VERTEX BANKS IN /CWORK/
C LERR = ERROR FLAG (IF LT 0 EVENT PROCESSING TERMINATED)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
INTEGER MXCHGD,NHDSTR,LERR
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
$$INCLUDE 'K$INC:BCS.INC'
$$INCLUDE 'YBOS$LIBRARY:ERRCOD.INC'
$$INCLUDE 'K$ITRK:CVXWORK.INC'
C
LOGICAL IN_DC,ACCEPT,CONSTR,FREETR,ANOTHR
INTEGER NFLAG,IHIPR,IHIPR1,J,LERRCR,NTKFIT,ILIST(3)
INTEGER K,IFIT
REAL XINT(3),VXERR(6),XCN(3)
REAL X1,Y1,D1INT,D2INT,TOTCHG,CHISQ
C
REAL RDCMIN,DISMX1,DISMX2
PARAMETER (RDCMIN=30.,DISMX1=40.,DISMX2=50.)
C
C
C =================>> STARTING WITH PAIR (1,2) AND
C CONTINUING, IF NECESSARY, WITH (1,3),
C (2,3),(1,4),(2,4),... , FIND 1ST PAIR
C THAT INTERSECTS WITHIN CUTS AND ALL
C TRACKS WHICH COME CLOSE TO THIS
C INTERSECTION (WITHIN CUTS)
LERR = 0
C
DO 200 IHIPR=2,MXCHGD
ILIST(2) = IGDTK(IHIPR)
IHIPR1 = IHIPR-1
DO 180 J=1,IHIPR1
IF (MSLIST(IGDTK(IHIPR)) .NE. 0) GO TO 200
IF (MSLIST(IGDTK(J)) .NE. 0) GO TO 180
ILIST(1) = IGDTK(J)
C
CALL VXCRSS(ILIST,XINT,LERRCR,CONSTR)
IF (LERRCR.NE.0) GO TO 180
C
C DO NOT ATTEMPT THIS FIT IF THE TWO START POINTS ARE TOO FAR AWAY IN R-PHI
IN_DC = SQRT(XINT(1)**2+XINT(2)**2) .GT. RDCMIN
IF (IN_DC) THEN
X1 = TRKBNK(2,1,ILIST(1))-TRKBNK(2,1,ILIST(2))
Y1 = TRKBNK(3,1,ILIST(1))-TRKBNK(3,1,ILIST(2))
D1INT = SQRT(X1*X1+Y1*Y1)
IF (D1INT .GT. DISMX1) GO TO 180
ELSE
X1 = TRKBNK(2,1,ILIST(1))-XINT(1)
Y1 = TRKBNK(3,1,ILIST(1))-XINT(2)
D1INT = SQRT(X1*X1+Y1*Y1)
X1 = TRKBNK(2,1,ILIST(2))-XINT(1)
Y1 = TRKBNK(3,1,ILIST(2))-XINT(2)
D2INT = SQRT(X1*X1+Y1*Y1)
IF (D1INT.GT.DISMX2 .AND. D2INT.GT.DISMX2) GOTO 180
ENDIF
C
C ----------------->> FOUND INTERSECTION - LOOK FOR OTHER CLOSE TRACKS
C
NTKFIT = 2
JGDTK(1)=ILIST(1)
JGDTK(2)=ILIST(2)
TOTCHG = SIGN(1.,TRKBNK(30,1,ILIST(1)))+
+ SIGN(1.,TRKBNK(30,1,ILIST(2)))
DO K=1,MXCHGD
FREETR = MSLIST(IGDTK(K)) .EQ. 0
ANOTHR = (IGDTK(K).NE.JGDTK(1)) .AND. (IGDTK(K).NE.JGDTK(2))
IF (FREETR .AND. ANOTHR) THEN
X1 = TRKBNK(2,1,IGDTK(K))-XINT(1)
Y1 = TRKBNK(3,1,IGDTK(K))-XINT(2)
D1INT = SQRT(X1*X1+Y1*Y1)
IF (IN_DC) THEN
IF (D1INT .LE. DISMX1) THEN
NTKFIT = NTKFIT+1
JGDTK(NTKFIT)=IGDTK(K)
TOTCHG = TOTCHG + SIGN(1.,TRKBNK(30,1,IGDTK(K)))
ENDIF
ELSE
IF (D1INT .LE. DISMX2) THEN
NTKFIT = NTKFIT+1
JGDTK(NTKFIT)=IGDTK(K)
TOTCHG = TOTCHG + SIGN(1.,TRKBNK(30,1,IGDTK(K)))
ENDIF
ENDIF
ENDIF
ENDDO
C
C ----------------->> TRY A FIT, IF THE TOTAL CHARGE IS NOT TOO IMBALANCED
C
IF (ABS(TOTCHG) .LE. 1.) THEN
CALL VXXYZ(NTKFIT,JGDTK,XINT,VXERR,CHISQ,IFIT,XCN,CONSTR)
ACCEPT = IFIT.EQ.0 .OR. IFIT.EQ.6 .OR. IFIT.EQ.7
IF (ACCEPT) THEN
NFLAG = 4
CALL VXSTOR(JGDTK,NTKFIT,XINT,VXERR,CHISQ,NFLAG,IFIT)
ENDIF
ENDIF
180 CONTINUE
200 CONTINUE
C
RETURN
END
C 27/11/89 911301536 MEMBER NAME VXSTOR (ES) FVS
C 04/07/83 512092357 MEMBER NAME VXSTOR (DEC85) FORTRAN
SUBROUTINE VXSTOR(ILIST,MAX,XINT,VXERR,CHISQ,IFLAG,IFIT)
$$IMPLICIT
C
C --- D. COPPAGE --- VERSION 19.01.84 V4.0 (ARG07)
C 18.01.84 V4.01 (ARG07)
C 11.06.85 V4.02 (ARG09)NHDVTX=20 PROB
C 09.12.85 V4.03 (ARG09)PROTECT SINLAM = 0.
C
C SUBROUTINE FOR STORING THE RESULTS OF A SUCCESSFUL FIT INTO
C THE SAVE BANKS IN CWORK
C --- CALLED FROM VXMAIN
C
C INPUT :
C ILIST(64) = TRACK NUMBERS OF TRACKS IN FIT
C MAX = NUMBER OF TRACKS IN FIT
C XINT(3) = (X,Y,Z) OF FIT VERTEX
C VXERR(6) = X,Y,Z COVARIANCE MATRIX
C CHISQ = CHI SQUARED OF FIT
C IFLAG = CURRENTLY FLAG FOR INTERNAL INFORMATION
C 1 - FIT FROM PRIMARY SECTION
C 2 - FIT FROM COLINEAR SECTION (BHABHAS, ETC.)
C 3 - FIT FROM TANGENT TRACKS ( GAMMAS, ETC)
C 4 - FIT FROM SECONDARY SECTION
C 5 - FIT FROM SECONDARY SECTION(2 PRONG WITH
C NET 0 IS PERMITTED ONE PRIMARY ASSOC TRK
C 15 - FIT FROM DECAYING CHARGED TRACKS
C
C OUTPUT: NHDVTX = CURRENT VERTEX NUMBER
C TEMPORARY VERTEX BANKS IN CWORK ACCORDING TO THE FOLLOWING
C SCHEME.
C LV(LTR ) = LENGTH
C LV(LTR+ 1) = IFLAG (DEFINED ABOVE)
C LV(LTR+ 2) = 0 (MAIN VERTEX)
C -1 (SECONDARY VERTEX)
C NTK (NEUTRAL TRACK POINTING TO THIS VERTEX)
C FV(LTR+ 3) = TRACK LIST ( BITS 1 32 = TRACKS 1-32 )
C FV(LTR+ 4) = TRACK LIST ( BITS 1 32 = TRACKS 33-64 )
C LV(LTR+ 5) = NUMBER OF TRACKS
C FV(LTR+ 6) = X (OF VERTEX)
C FV(LTR+ 7) = Y (OF VERTEX)
C FV(LTR+ 8) = Z (OF VERTEX)
C FV(LTR+ 9) = VAR(X,X)
C FV(LTR+10) = VAR(X,Y)
C FV(LTR+11) = VAR(X,Z)
C FV(LTR+12) = VAR(Y,Y)
C FV(LTR+13) = VAR(Y,Z)
C FV(LTR+14) = VAR(Z,Z)
C FV(LTR+15) = CHISQ OF FIT
C FV(LTR+16) = FREE(|P-TRANS| IF MAX=2 & Q1.NE.Q2)
C FV(LTR+17) = FREE( P1 * P2 IF MAX=2 & Q1.NE.Q2)
C 1 LV(LTR+18) = TRK NUMBER (FOR TRACKS BELONGING TO FIT)
C 2 FV(LTR+19) = K
C 3 FV(LTR+20) = COT(THETA) ( = S )
C 4 FV(LTR+21) = PHI
C 5 FV(LTR+22) = VAR(K,K)
C 6 FV(LTR+23) = VAR(K,S)
C 7 FV(LTR+24) = VAR(K,PHI)
C 8 FV(LTR+25) = VAR(S,S)
C 9 FV(LTR+26) = VAR(S,PHI)
C 10 FV(LTR+27) = VAR(PHI,PHI)
C 11 FV(LTR+28) = TRK LENGTH
C 12 FV(LTR+29) = D0 ( DISTANCE OF CLOSEST APPROACH IN R-PHI )
C 13 FV(LTR+30) = DZ ( DISTANCE OF CLOSEST APPROACH IN Z )
C 14 FV(LTR+31) = VAR(D0,D0)
C 15 FV(LTR+32) = VAR(D0,DZ)
C 16 FV(LTR+33) = VAR(DZ,DZ)
C 17 FV(LTR+34) = TRK CHISQ(R,Z) FOR BELONGING TO THIS VTX
C 1 LV(LTR+35) = TRK NUMBER (FOR TRACK BELONGING TO VTX)
C ... REPEAT 1 - 17 FOR REMAINING TRACKS
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
$$INCLUDE 'K$INC:BCS.INC'
$$INCLUDE 'K$INC:ERLEVL.INC'
$$INCLUDE 'YBOS$LIBRARY:ERRCOD.INC'
C
$$INCLUDE 'K$ITRK:CFLAGS.INC'
$$INCLUDE 'K$ITRK:CCONST.INC'
$$INCLUDE 'K$ITRK:CVXWORK.INC'
$$INCLUDE 'K$ITRK:DTFS.INC'
C
INTEGER IFIT
INTEGER ILIST,MAX,IFLAG
REAL XINT,VXERR,CHISQ
C
INTEGER STATUS,INDDAT,LTR,LTRS,I,K
INTEGER INDC,IHDSIZ
INTEGER JBIT
INTEGER BLOCAT
REAL CROSS,DEN,PHI,PROXIM
DIMENSION XINT(3),VXERR(6),ILIST(64)
REAL P1,P2,DOT
REAL FPMG,FK,SINL
REAL FDR0,X,Y,VX,VY,TX,TY,TZ
FPMG(FK,SINL) = ABS(1./(FK*SQRT(1.-SINL**2)))
FDR0(X,Y,VX,VY,TX,TY,TZ) = ( (X-VX)*TY+(VY-Y)*TX )/SQRT(1.-TZ**2)
C
IF (NHDVTX.GE.20) THEN
CALL ERLOGR('VXSTOR',ERWARN,0,0,
+ 'Vertex internal banks full.')
RETURN
ENDIF
C
NHDVTX = NHDVTX+1
IF(NHDVTX .EQ. 1)KVX(1) = 1
LTR = KVX(NHDVTX)
IF( LTR + (MAX+1)*17 .LT. 2040 )GO TO 806
CALL INERR(519,1)
RETURN
C
806 CONTINUE
LV(LTR ) = (MAX+1)*17
LV(LTR + 1) = IFLAG
CC LV(LTR + 2) = -1
LV(LTR + 2) = ILIST(1)
CC MODIFICATO AA 3/APR/95 LV(LTR+2) NON E' USATO QUINDI CI IMMAGAZZIONO LA
CC MADRE PER I KINK CHE UTILIZZO IN VXMAIN
LV(LTR + 5) = MAX
FV(LTR + 6) = XINT(1)
FV(LTR + 7) = XINT(2)
FV(LTR + 8) = XINT(3)
FV(LTR + 9) = VXERR(1)
FV(LTR + 10) = VXERR(2)
FV(LTR + 11) = VXERR(3)
FV(LTR + 12) = VXERR(4)
FV(LTR + 13) = VXERR(5)
FV(LTR + 14) = VXERR(6)
FV(LTR + 15) = CHISQ
IF( MAX .NE. 2 .OR.
+ TRKBNK(30,4,ILIST(1))*TRKBNK(30,4,ILIST(2)) .GT. 1. )GO TO 810
C ----------------->> CALC P1*P2 AND P1XP2/|P1+P2|
P1 = FPMG(TRKBNK(30,4,ILIST(1)),TRKBNK(7,4,ILIST(1)))
P2 = FPMG(TRKBNK(30,4,ILIST(2)),TRKBNK(7,4,ILIST(2)))
DOT = TRKBNK(5,4,ILIST(1))*TRKBNK(5,4,ILIST(2))+
+ TRKBNK(6,4,ILIST(1))*TRKBNK(6,4,ILIST(2))+
+ TRKBNK(7,4,ILIST(1))*TRKBNK(7,4,ILIST(2))
FV(LTR + 17) = P1*DOT*P2
C
FV(LTR + 16) = 0.
C PTOT = SQRT( P1**2 + P2**2 +2*FV(LTR+16) )
810 CONTINUE
C ----------------->> FIX UP TRACK LIST
LV(LTR + 3)=0
c LV(LTR + 4)=0
LV(LTR + 4)=IFIT
LTRS = LTR
DO 830 I= 1,MAX
c
c Pack into LV(LTR + 3) GEANT track number
c
K = ILIST(I)
IF(ILIST(I).LE.32)CALL SBIT1(LV(LTRS+3),K)
c original code --------------- beg. ----
c IF(ILIST(I).LE.32)CALL SBIT1(LV(LTRS+3),ILIST(I))
c IF(ILIST(I).GT.32)CALL SBIT1(LV(LTRS+4),ILIST(I)-32)
c K = ILIST(I)
c original code --------------- end -----
LTR = KVX(NHDVTX) + I*17
LV(LTR + 1) = K
FV(LTR + 2) = ABS(TRKBNK(30,4,K))
C TRKBNK(.+3) CAN BE ZERO WITH VD ON SO PROTECT -
FV(LTR + 3) = TRKBNK(7,4,K)
IF( ABS(TRKBNK(7,4,K)) .GT. 1.0E-5 )
+ FV(LTR + 3) =
+ SIGN(1./SQRT(1./TRKBNK(7,4,K)**2-1.),TRKBNK(7,4,K))
C
C THE FOLLOWING SHOULD NEVER HAPPEN!!
IF (TRKBNK(6,4,K).EQ.0. .AND. TRKBNK(5,4,K).EQ.0.) THEN
CALL ERLOGR('VXSTOR',ERWARN,0,0,
+ 'Impossible tangent. Phi set=0.')
FV(LTR + 4) = 0.
ELSE
FV(LTR + 4) = ATAN2(TRKBNK(6,4,K),TRKBNK(5,4,K))
ENDIF
IF (IFLAG.EQ.15 .AND. I.EQ.1) THEN
FV(LTR + 3) = -FV(LTR+3)
FV(LTR+4) = FV(LTR+4)+ PI
ENDIF
FV(LTR+4) = PROXIM(FV(LTR+4),PI)
CALL UCOPY(TRKBNK(24,4,K),FV(LTR+5),6)
FV(LTR + 11) = TRKBNK(1,4,K)
IF( I.NE.1 .OR. IFLAG .NE. 15 )GO TO 820
STATUS = BLOCAT(IW,'DTFS',DTFS_bnk_num_list(K),INDC,INDDAT)
IHDSIZ=IW(INDDAT+DTFHDS)
INDDAT=INDDAT+IHDSIZ
IW(INDDAT+DTFPVS)=NHDVTX
820 CONTINUE
C ----------------->> SET DR,DZ,<RR>,<RZ>,AND <ZZ>
C INTO VERTEX BANK
FV(LTR + 12) =
+ FDR0(TRKBNK(2,4,K),TRKBNK(3,4,K),XINT(1),XINT(2),
+ TRKBNK(5,4,K),TRKBNK(6,4,K),TRKBNK(7,4,K))
FV(LTR + 13) = TRKBNK( 4,4,K) - XINT(3)
FV(LTR + 14) = TRKBNK(15,4,K)
FV(LTR + 15) = TRKBNK(16,4,K)
FV(LTR + 16) = TRKBNK(20,4,K)
C ----------------->> CALCULATE TRK CHISQ(R,Z) FOR THIS VTX
C
CDBG
C
C THE FOLLOWING SHOULD NEVER HAPPEN!!
IF (FV(LTR+14)*FV(LTR+16).EQ.0.) THEN
CALL ERLOGR('VXSTOR',ERWARN,0,0,
+ 'Null division!')
FV(LTR+14) = 1.
FV(LTR+16) = 1.
ENDIF
CROSS = -FV(LTR+15)/(FV(LTR+14)*FV(LTR+16))
DEN = 1. + CROSS*FV(LTR+15)
FV(LTR + 17) = ( FV(LTR+12)**2/FV(LTR+14) +
+ FV(LTR+13)**2/FV(LTR+16) +
+ 2.*FV(LTR+12)*FV(LTR+13)*CROSS )/DEN
C
IF( JBIT(LFLVXR,8) .EQ. 0 )GO TO 830
C ----------------->> REFILL TRKBNK FOR DEBUG
RW(INDDAT+DTFLNG) = TRKBNK(1,4,K)
RW(INDDAT+DTFXCO) = TRKBNK(2,4,K)
RW(INDDAT+DTFYCO) = TRKBNK(3,4,K)
RW(INDDAT+DTFZCO) = TRKBNK(4,4,K)
C
C THE FOLLOWING SHOULD NEVER HAPPEN!!
IF (TRKBNK(6,4,K).EQ.0. .AND. TRKBNK(5,4,K).EQ.0.) THEN
CALL ERLOGR('VXSTOR',ERWARN,0,0,
+ 'Impossible tangent. Phi set=0.')
PHI = 0.
ELSE
PHI = ATAN2(TRKBNK(6,4,K),TRKBNK(5,4,K))
ENDIF
RW(INDDAT+DTFPHI) = PHI
IF(PHI .LT. 0.)
+ RW(INDDAT+DTFPHI) = PHI + PI2
RW(INDDAT+DTFCTT) =
+ SIGN(1./SQRT(1./TRKBNK(7,4,K)**2-1.),TRKBNK(7,4,K))
C ----------------->> END OF DEBUG
830 CONTINUE
C
C ----------------->> SET MSLIST TRK POINTERS
DO 840 I=1,MAX
840 CALL SBIT1( MSLIST(ILIST(I)),NHDVTX)
IF( NHDVTX .LT. 20 )KVX( NHDVTX+1 ) = LTR + 18
C
RETURN
END
C 27/11/89 004101023 MEMBER NAME VXTADE (ES) FVS
C
SUBROUTINE VXTADE(P,D,RM,DZAR,RMBPOT,POUT)
$$IMPLICIT
C
C NUMERICAL INTEGRATION ROUTINE
C CALCULATES ENERGY LOSS OF CHARGED PARTICLES
C
C INPUT:
C P = PARTICLE MOMENTUM
C D = TRAVELLED DISTANCE IN MATTER (NEGATIVE: ENERGY WIN DURING
C TRACEBACK)
C RM = REST MASS OF PARTICLE
C DZAR = 0.3070E-3*Z/A*RHO OF MEDIUM WANTED FROM CTIDRI
C MSBPOT = 2*RM(E)/POT FROM CTIDRI
C
C OUTPUT:
C POUT = MOMENTUM AFTER (OR IF D NEGATIVE BEFORE) ENERGY LOSS
C
C --- ROLAND WALDI --- 05/84 --- VERSION 1-05/84
C D. COPPAGE 11.11.84 VERSION 1.1
C 23.03.85 VERSION 1.2 DP FOR G VARIABLES
C HKAP 10.04.90 VERSION 1.3 PO = PI IF D = 0.0
C
REAL P,D,RM,DZAR,RMBPOT,POUT
DOUBLE PRECISION A,B,G,X,H,H1,H2,H3,H4,H5,H6,DERIV
DOUBLE PRECISION G2,G3,G4,G5,G6
C --- STATEMENT FUNCTION
DERIV(G) = A * (G/(G-1.D0)*DLOG(B*(G-1.D0))-1.D0)
C
C --- SKIP IF NO MATTER
C
IF (D.EQ.0.0) GOTO 700
C
C --- G = GAMMA
G = DSQRT(1.D0+DBLE(P/RM)**2)
C
C --- SOLVE DIFF. EQU. DG = A ( G**2/G**2-1 LN B(G**2-1) - 1 ) DX
C
A = DZAR / RM
B = RMBPOT
C
C --- INTEGRATE RUNGE/KUTTA 5TH ORDER
C
X = ABS(D)
100 CONTINUE
IF (G.LT.1.0001 .AND. D.GT.0.) GOTO 800
H = (G-1.)*0.2 / DERIV (G**2)
H = DSIGN(H,DBLE(D))
IF (DABS(H).GT.X) H = SIGN(SNGL(X),D)
H1 = DERIV(G**2)
G2 = DMAX1(1.00001D00,G-0.25*H*H1)
H2 = DERIV(G2**2)
G3 = DMAX1(1.00001D00,G-0.125*H*(H1+H2))
H3 = DERIV(G3**2)
G4 = DMAX1(1.00001D00,G-H*(H3-0.5*H2))
H4 = DERIV(G4**2)
G5 = DMAX1(1.00001D00,G-3.*H*(H1+3.*H4)/16.)
H5 = DERIV(G5**2)
G6 = DMAX1(1.00001D00,G-H*(8.*H5-3.*H1+2.*H2+12.*(H3-H4))/7.)
H6 = DERIV(G6**2)
G = G-H*(7.*(H1+H6)+32.*(H3+H5)+12.*H4)/90.
X = X-DABS(H)
IF (X.GT.0.) GOTO 100
POUT = DSQRT(G**2-1.D0)*RM
RETURN
700 CONTINUE
POUT = P
RETURN
800 CONTINUE
POUT = 0.
RETURN
END
C 27/11/89 010291746 MEMBER NAME VXTKIN (ES) FVS
C 31/07/83 703021751 MEMBER NAME VXTKIN (DS) FORTRAN
C
SUBROUTINE VXTKIN(MAX,MSFRCE)
$$IMPLICIT
C---------------------------------------------------------------------
C SUBROUTINE TO INITIALIZE THE WORKING TRACK BANKS FOR THE VERTEX
C ROUTINES.
C CALLED FROM VXMAIN.
C---------------------------------------------------------------------
C --- D. COPPAGE : VERSION 1.08.83 V3.01 (ARG06)
C REVISED 29.01.84 V3.1
C REVISED 24.03.84 V3.11 CHANGED RSURF(I,J)
C VERSION 14.05.84 V4.00 MASS FROM <DEDX>
C ARG07 EXPANDED CTIDRI
C REVISED 27.06.84 V4.01 CSOMGA -> |CSOMGA|
C 07.07.84 V4.03 NEW E- DEDX (A.PHILIPP)
C CTIDRI EXPNDED - NEW CALL SEQ NOT BKWRDS COMP
C 07.09.84 V4.04 VDC CONSTANTS ADDED
C 11.11.84 V4.04 DK/DX->DP/DX IN TRKOUT(31,I,K)
C 27.01.85 V4.10 MSFRCE 1-> 5
C DP/DX CALC IN MODIFIED
C TADE1 BY R. WALDI
C 31.01.85 V4.20 FIX DEDX LOW PT TRKS-
C BAD DUE TO WRONG BNDRY
C INTERSECTION.
C 23.03.85 V4.21 DEDK INIT FOR ELEC
C 19.04.85 V5.00 MOD FOR VDC FITS
C 08.10.85 V5.00 FIXED BUG IN INTERCEPT
C CALCULATION
C 13.11.85 V4.30 VH3 DEF FIXED
C 02.12.85 V4.40 REV SGN D COV MAT
C INTRSCT ALG IMPROVD
C 10.10.86 V4.50 COUL SCATT BOOSTED BY
C SCS(THETA)**2
C REVISED 14.11.85 V4.60 VXERRC NOW IN DF COORD
C SYS. COV MAT->DF COORD
C HKAP 10.04.90 NEW CTIDRI STRUCTURE
C---------------------------------------------------------------------
C IMPORTANT NOTE:
C THE DISTANCE IN THE R-THETA PLANE PERPENDICULAR TO THE TRACK IS
C MEASURED POSITIVE ALONG THE DIRECTION K X T WHERE T IS THE
C TANGENT TO THE TRACK POINTING AWAY FROM THE INTERACTION REGION,
C X INDICATES VECTOR CROSS PRODUCT, AND K IS THE UNIT VECTOR IN THE
C ARGUS Z-DIRECTION. THE ERROR SWIM ROUTINE NOW IS CORRECT FOR
C MAGNETIC FIELDS IN THE -Z DIRECTION, I.E. THE VX COVARIANCE
C MATRIX IS IN THE DF COORDINATE SYSTEM.
C---------------------------------------------------------------------
C INPUT: IGDTK = LIST OF TRACK TO BE INITIALIZED
C MAX = NUMBER OF TRACKS IN IGDTK TO INITIALIZE
C MSFRCE = -1 : USE DEDX TO DECIDE MASS HYP
C IN CASE OF AMBIGUITIES, LIGHTEST HADRON
C MASS WITH <DEDX> LIKELIHOOD RATIO .GT. 0.05
C IS TAKEN (ONLY 1,2,3,4 POSSIBLE)
C = 1 : FORCE ELECTRON MASS HYP (IONIZATION ONLY)
C = 2 : FORCE PI MASS HYP
C = 3 : FORCE K MASS HYP
C = 4 : FORCE P MASS HYP
C
C OUTPUT: TRKBNK(32,4,64) IN COMMON/CWORK/
C---------------------------------------------------------------------
C DESCRIPTION OF WORKING TRACK BANK TRKBNK(N,I,J):
C *************
C I = REGION NUM (1=DC, 2=BETWEEN DC AND BT, 3=INSIDE BT, 4=CURRENT)
C J = TRACK NUMBER
C N = 1 TRACK LENGTH
C 2,3,4 X,Y,Z
C 5,6,7 VTNG X,Y,Z
C 8,9,10 VNORM X,Y,Z (UNNORMALIZED)
C 11,12,13 VH X,Y,Z (UNIT VECTOR IN DIR OF MAG FIELD)
C 14 1/VHMAG (MAGNITUDE OF MAG FIELD)
C 15 - 29 COVARIANCE MATRIX FOR REGION I (IN DF COORDINATE SYS)
C 30 SIGNED VALUE OF K
C 31 ABS(DP/DX) (DEFAULT MASS = SEE ABOVE. K FROM REGION 1)
C USE OF STATUS WORDS IN THIS ROUTINE:
C 32, I=1: 1 OR 2 = INPUT BNK FOR VXSWIM
C 3 = SIGNAL VXTKIN FINISHED
C I=2: = NUMBER OF LAST FILLED BANK
C = -1 IF NO BANKS FILLED
C I=3: = +1.0 FOR NEGATIVE SWIMS (NORMAL)
C = -1.0 FOR POSITIVE SWIMS (MUST BE
C SET WHEN NEEDED)
C I=4: 0/100 = DC/VDC TRACK
C---------------------------------------------------------------------
C BETA**2 = 1./(1.+(M/P)**2) = 1./(1.+(M*K*COSLAM)**2)
C M TAKEN FROM <DEDX> : DEFAULT = SEE ABOVE
C
C DE/DX = C1*(1./BETA**2)*(ALOG(C2*(P/MASS)**2)-BETA**2)
C
C C1,C2 = MATERIAL CONSTANTS STORED IN TIDEVX IN COMMON CTIDRI.
C C1 IS IN UNITS OF GEV/(G/CM**2).
C
C INNER RADIUS OF MDC RELATED MATERIALS = TIRGVX(1)
C INNER RADIUS OF VDC RELATED MATERIALS = TIRGVX(2)
C THICKNESSES (IN G/CM**2) FOR THESE MATERIALS ARE STORED IN TIRGVX.
C---------------------------------------------------------------------
C A.PHILIPP DE/DX FOR ELECTRONS:
C
C DE/DX = ((CA1 + CA2/ENRGY**CA3)*CORR + 1 + FAC*LOG(ENRGY))*XRAD
C
C WHERE THE CONSTANTS CA(I), CORR AND FAC HAVE BEEN CHECKED WITH
C THE EFF MASS FOR PI0'S FROM CONV GAMMAS.
C
C TICAVX(1-3) = CA(1-3) ; TICAVX(4) = CORR (=1 FOR AL):DRIFT CH
C TIALVX(1-3) = AL(1-3) ; TICAVX(4) = FAC:BEAMTUBE
C---------------------------------------------------------------------
C
$$INCLUDE 'K$ITRK:CCONST.INC'
$$INCLUDE 'K$ITRK:CFLAGS.INC'
$$INCLUDE 'K$ITRK:CTIDRI.INC'
$$INCLUDE 'K$ITRK:CVXCUT.INC'
$$INCLUDE 'K$ITRK:CVXWORK.INC'
$$INCLUDE 'YBOS$LIBRARY:ERRCOD.INC'
$$INCLUDE 'K$INC:BCS.INC'
$$INCLUDE 'K$ITRK:DTFS.INC'
C
INTEGER MAX,MSFRCE
C
INTEGER IHYPSV,IHYP,ISM,JHYP,MH,NRMX,ISURF
INTEGER NR,JSURF,IFLG,NUM,NDX
INTEGER LERR,KSURF
REAL RCK,DMAG,BETA2,CSOMGA,RMAG,DPHI2
REAL DCTGT2,BG2,ERG,DK,DMAT,PO
REAL PX,FMASS,CHIMN,PXI2TO,PT1,VH3,RHO,CSLMIV,D1,D2
INTEGER STATUS,INDDAT
INTEGER BLOCAT
C
REAL CA,AL
DIMENSION CA(3),AL(3)
c EQUIVALENCE (TICAVX(1),CA(1)),(TICAVX(4),CORR)
c EQUIVALENCE (TIALVX(1),AL(1)),(TIALVX(4),FAC)
C ASSUME NEW ORGANIZATION OF CTIDRI AS BELOW
REAL DEPXY,EPXYI,XREPXY,DAL,ALI,XRAL
REAL DFE,FEI,XRFE,DCU,CUI,XRCU,DAG,AGI,XRAG
REAL DPBO,PBOI,XRPBO,DBE,BEI,XRBE
EQUIVALENCE
+(TIDEVX(1,1),DEPXY),(TIDEVX(2,1),EPXYI),(TIDEVX(3,1),XREPXY),
+(TIDEVX(1,2),DAL), (TIDEVX(2,2),ALI), (TIDEVX(3,2),XRAL),
+(TIDEVX(1,3),DFE), (TIDEVX(2,3),FEI), (TIDEVX(3,3),XRFE),
+(TIDEVX(1,4),DCU), (TIDEVX(2,4),CUI), (TIDEVX(3,4),XRCU),
+(TIDEVX(1,5),DAG), (TIDEVX(2,5),AGI), (TIDEVX(3,5),XRAG),
+(TIDEVX(1,6),DPBO), (TIDEVX(2,6),PBOI), (TIDEVX(3,6),XRPBO),
+(TIDEVX(1,7),DBE), (TIDEVX(2,7),BEI), (TIDEVX(3,7),XRBE)
REAL RMN1,RMN2,XEPXY1,XFE1,XAG1,XAL1,XEPXY2,XAL2,XCU2,XPBO2,XBE2
EQUIVALENCE
+(TIRGVX( 1),RMN1),(TIRGVX( 2),RMN2),(TIRGVX( 3),XEPXY1),
+(TIRGVX( 4),XFE1),(TIRGVX( 5),XAG1),(TIRGVX( 6),XAL1),
+(TIRGVX( 7),XEPXY2),(TIRGVX( 8),XAL2),(TIRGVX( 9),XCU2),
+(TIRGVX(10),XPBO2),(TIRGVX(11),XBE2)
C
INTEGER L,K,NSURF,INDC,IHDSIZ
REAL PHI,CTT,SINPHI,COSPHI,COSLAM
REAL XINT,CIRCL,VH,XRAD,RSURF,PXI2
INTEGER IDTEIL,LIST
DIMENSION XINT(5),CIRCL(3,2),VH(3),XRAD(2),RSURF(2),
+ IDTEIL(5),LIST(5),PXI2(4)
DATA IDTEIL/22,24,1,4,29/, LIST/1,3,4,5,1/
DATA CIRCL(2,1),CIRCL(3,1)/2*0.0/
LOGICAL FLGVDC,FLGDCW,FLGEE2
REAL FAC,CORR
data fac/0./, corr/0./
C
C --- INITIALIZE
C
RSRFCO(1) = RMN1
RSRFCO(2) = RMN2
XRAD(1) = XEPXY1/XREPXY + XAG1/XRAG + XFE1/XRFE + XAL1/XRAL
XRAD(2) = XEPXY2/XREPXY + XCU2/XRCU + XBE2/XRBE + XAL2/XRAL +
+ XPBO2/XRPBO
C
C --- LOOP OVER TRACKS
C
DO 400 L=1,MAX
K = IGDTK(L)
CC LTR = JTK(K)
C ------ SET UP INIT FOR NO VDC HITS
RSURF(1) = RMN1
RSURF(2) = RMN2
NSURF = 2
FLGVDC = .FALSE.
ITKBNK(32,4,K) = 0
C ------ IF VDC HITS, CHANGE BANKS FILLED
CCC IF (ID(LTR+26).GE.1000000) THEN
CCC FLGVDC = .TRUE.
CCC ITKBNK(32,4,K) = 100
CCC NSURF = 1
CCC RSURF(1) = RMN2
CCC RSURF(2) = 0.0
CCC ENDIF
C
C ------ FILL TRACK BUFFER
C
STATUS = BLOCAT(IW,'DTFS',DTFS_bnk_num_list(K),INDC,INDDAT)
IHDSIZ=IW(INDDAT+DTFHDS)
INDDAT=INDDAT+IHDSIZ
ITKBNK(32,2,K) = -1
TRKBNK( 1,1,K) = RW(INDDAT+DTFLNG)
TRKBNK( 2,1,K) = RW(INDDAT+DTFXCO)
TRKBNK( 3,1,K) = RW(INDDAT+DTFYCO)
C
C--- KLOE code modification ----- begin ------ A.Andryakov----
C I don't understand why fid. vol. is 100 cm along z.
CCC METTERE IL VALORE DAL DATA BASE IN 200.1
C
IF (ABS(RW(INDDAT+DTFZCO)).GT.200.1) GOTO 400
C
C--- KLOE code modification ----- end -------- A.Andryakov----
C
TRKBNK( 4,1,K) = RW(INDDAT+DTFZCO)
CALL MGFLD(TRKBNK(2,1,K),VH)
TRKBNK(14,1,K) = 1./SQRT(VH(1)**2+VH(2)**2+VH(3)**2)
TRKBNK(11,1,K) = VH(1)*TRKBNK(14,1,K)
TRKBNK(12,1,K) = VH(2)*TRKBNK(14,1,K)
TRKBNK(13,1,K) = VH(3)*TRKBNK(14,1,K)
PHI=RW(INDDAT+DTFPHI)
CTT=RW(INDDAT+DTFCTT)
SINPHI = SIN(PHI)
COSPHI = COS(PHI)
COSLAM = 1./SQRT(1.+CTT**2)
TRKBNK( 5,1,K) = COSLAM * COSPHI
TRKBNK( 6,1,K) = COSLAM * SINPHI
TRKBNK( 7,1,K) = SIGN(SQRT(1.-COSLAM**2),CTT)
TRKBNK( 8,1,K) =
+ TRKBNK(6,1,K)*TRKBNK(13,1,K)-TRKBNK(7,1,K)*TRKBNK(12,1,K)
TRKBNK( 9,1,K) =
+ TRKBNK(7,1,K)*TRKBNK(11,1,K)-TRKBNK(5,1,K)*TRKBNK(13,1,K)
TRKBNK(10,1,K) =
+ TRKBNK(5,1,K)*TRKBNK(12,1,K)-TRKBNK(6,1,K)*TRKBNK(11,1,K)
C ------ COVARIANCE MATRIX
CALL UCOPY(RW(INDDAT+DTFCVM),TRKBNK(15,1,K),15)
TRKBNK(30,1,K) = RW(INDDAT+DTFCUR)
C
C ------ IDENTIFY PARTICLE USING DE/DX (UNLESS MSFRCE > 0)
C
CCC QUESTA PARTE DEL CODICE E SALTATA DA RIVEDERE
CCC SE SI HA LA MASSA CON IL DE/DX
IHYPSV = 2
IF (MSFRCE.GT.0) IHYPSV = MSFRCE
IF (IDTEIL(LIST(IHYPSV)).EQ.1) THEN
FMASS = PION_MASS
ELSEIF (IDTEIL(LIST(IHYPSV)).EQ. 4) THEN
FMASS = KAON_MASS
ELSEIF (IDTEIL(LIST(IHYPSV)).EQ.22) THEN
FMASS = ELEC_MASS
ELSEIF (IDTEIL(LIST(IHYPSV)).EQ.29) THEN
FMASS = PROTON_MASS
ENDIF
TRKBNK(31,1,K) = 0.0
C-OBSOLETE IF (ID(LTR+63).LE.0 .OR. MSFRCE.GT.0) GOTO 110
IF (MSFRCE.GT.0) GOTO 110
C-OBSOLETE CHIMN = AMIN1(AD(LTR+66),AD(LTR+68),AD(LTR+69),AD(LTR+70))
IF (CHIMN.GT.50.) GOTO 110
C ------ CALCULATE PROBABILITIES
C DO 100 IHYP=1,4
C PXI2(IHYP) = 0.0
C 100 IF (AD(LTR+65+LIST(IHYP)).LT.140.)
C + PXI2(IHYP) = EXP(-AD(LTR+65+LIST(IHYP)))
C ------ WEIGHT 5 FOR PI'S
PXI2(2) = 5.*PXI2(2)
PXI2TO = PXI2(1)+PXI2(2)+PXI2(3)+PXI2(4)
C ------ NORMALIZED PROBABILITIES
DO 102 IHYP=1,4
102 PXI2(IHYP) = PXI2(IHYP)/PXI2TO
ISM = -1
C ------ CHECK HYPOTHESES > 5 %
DO 104 IHYP=1,4
IF (PXI2(5-IHYP).LT.0.05) GOTO 104
ISM = ISM + 1
IF (IHYP.LT.4 .OR. ISM.EQ.0) JHYP = 5-IHYP
104 CONTINUE
IF (ISM.LT.0) GOTO 110
IHYPSV = JHYP
IF (IDTEIL(LIST(IHYPSV)).EQ.1) THEN
FMASS = PION_MASS
ELSEIF (IDTEIL(LIST(IHYPSV)).EQ. 4) THEN
FMASS = KAON_MASS
ELSEIF (IDTEIL(LIST(IHYPSV)).EQ.22) THEN
FMASS = ELEC_MASS
ELSEIF (IDTEIL(LIST(IHYPSV)).EQ.29) THEN
FMASS = PROTON_MASS
ENDIF
C ------ MOMENTUM LOSS IN GEV/CM
C TRKBNK(31,1,K) = SQRT((FMASS*AD(LTR+30)*COSLAM)**2+1.)*
C + 0.5*AD(LTR+64)*1.E-6
110 CONTINUE
MH = 1
IF (IHYPSV.GT.1) MH = IHYPSV + 1
C IW(INDDAT+DTFPID)=MH
ITKBNK(32,2,K) = 1
C
C ------ NOW FIND INTERSECTIONS OF TRACK WITH
C DC INNER WALL AND BEAM TUBE
C
TRKBNK(32,3,K) = 1.0
PT1 = 1./ABS(TRKBNK(30,1,K))
C ------ FOR LOW MOMENTUM SWIM TWICE
NRMX = 2
IF (PT1.GT.0.3) NRMX = 1
C
C ------ LOOP OVER SCATTERING SURFACES
C
DO 300 ISURF=1,NSURF
DO 200 NR=1,NRMX
JSURF = ISURF + NR - 1
VH3 = TRKBNK(13,JSURF,K)/TRKBNK(14,JSURF,K)
RHO = 1./(CONVERS*VH3*TRKBNK(30,JSURF,K))
IF (ABS(RHO).LE.3000.) THEN
C --------------- TRACK IS CIRCLE
CSLMIV =
+ 1./SQRT(TRKBNK(5,JSURF,K)**2+TRKBNK(6,JSURF,K)**2)
COSPHI = TRKBNK(5,JSURF,K)*CSLMIV
SINPHI = TRKBNK(6,JSURF,K)*CSLMIV
CIRCL(1,2) = ABS(RHO)
CIRCL(2,2) = TRKBNK(2,JSURF,K) + RHO * SINPHI
CIRCL(3,2) = TRKBNK(3,JSURF,K) - RHO * COSPHI
IFLG = 0
ELSE
C --------------- TRACK APPROXIMATED AS STRAIGHT LINE
CIRCL(1,2) = SINPHI
CIRCL(2,2) = -COSPHI
CIRCL(3,2) = COSPHI*TRKBNK(3,JSURF,K)-
+ SINPHI*TRKBNK(2,JSURF,K)
IFLG = 2
ENDIF
CIRCL(1,1) = RSURF(ISURF)
CALL VXXFND(CIRCL,XINT,IFLG)
C ------------ CHECK # INTERSECTIONS
NUM = XINT(1) + 0.01
IF (NUM.LT.1 .AND. NR.EQ.2) GOTO 350
IF (NUM .GT. 0) GOTO 230
XINT(1) = 0.0
XINT(2) = 0.0
NDX = 1
GOTO 250
C ------------ AT LEAST ONE INTERSECTION
230 CONTINUE
NDX = 2
IF (NUM .EQ. 1) GOTO 240
C ------------ FIND CLOSEST INTERSECTION IF MORE THAN ONE
D1 =(XINT(2)-TRKBNK(2,ISURF,K))**2 +
+ (XINT(3)-TRKBNK(3,ISURF,K))**2
D2 =(XINT(4)-TRKBNK(2,ISURF,K))**2 +
+ (XINT(5)-TRKBNK(3,ISURF,K))**2
IF (D2.LT.D1) NDX = 4
C ------------ CHECK FOR BAD SOLUTION
240 CONTINUE
RCK = SQRT(XINT(NDX)**2+XINT(NDX+1)**2)
IF (ABS(RCK-RSURF(ISURF)).LT.2.0) GOTO 250
CALL INERR(573,1)
GOTO 350
C ------------ SWIM TRACK
250 CONTINUE
ITKBNK(32,1,K) = ISURF
CALL VXSWIM( XINT(NDX), K, TRKBNK(1,ISURF+1,K), LERR)
IF (LERR.NE.0) GOTO 350
IF (NUM .GT. 0) GOTO 200
DMAG =
+ SQRT(TRKBNK(2,ISURF+1,K)**2+TRKBNK(3,ISURF+1,K)**2)
IF (DMAG.GT.RSURF(ISURF) .OR. NRMX.EQ.1) GOTO 350
200 CONTINUE
ITKBNK(32,2,K) = ISURF+1
C
C --------- NOW ADD COULOMB SCATTERING FOR APPROPRIATE BOUNDARY
C
COSLAM = SQRT(1.-TRKBNK(7,ISURF+1,K)**2)
BETA2 = 1./(1. + (FMASS*TRKBNK(30,ISURF+1,K)*COSLAM)**2)
C
C --------- OMEGA = SPATIAL ANGLE BETWEEN TRACK AND MATERIAL SURFACE
C COS(OMEGA) = (P(X)*T(X)+P(Y)*T(Y))/SQRT(P(X)**2+P(Y)**2)
C WHERE P(I) = POSITION VECTOR OF TRACK AT SURFACE INTERSECTION
C T(I) = UNIT TANGENT VECTOR OF TRACK AT P(I)
C I = 1,2,3
C
CSOMGA = TRKBNK(2,ISURF+1,K) * TRKBNK(5,ISURF+1,K) +
+ TRKBNK(3,ISURF+1,K) * TRKBNK(6,ISURF+1,K)
RMAG = SQRT( TRKBNK(2,ISURF+1,K)**2 +
+ TRKBNK(3,ISURF+1,K)**2 )
CSOMGA = ABS(CSOMGA / RMAG)
C
C --------- <DPHI,DPHI> = (0.0141/P/BETA)**2 * X/XRAD / COSLAM**2
C
KSURF = ISURF
IF (FLGVDC) KSURF = 2
CNOV 86 DPHI2 = (0.0141*TRKBNK(30,ISURF+1,K)*COSLAM)**2
DPHI2 = (0.0141*TRKBNK(30,ISURF+1,K) )**2
+ * XRAD(KSURF) / (CSOMGA * BETA2 )
C
C --------- <DCTGT,DCTGT> = (0.0141/P/BETA)**2 * X/XRAD / COSLAM**4
C
DCTGT2 = DPHI2 / (COSLAM)**2
TRKBNK(27,ISURF+1,K) = TRKBNK(27,ISURF+1,K) + DCTGT2
TRKBNK(29,ISURF+1,K) = TRKBNK(29,ISURF+1,K) + DPHI2
C
C --------- DK/DX = DE/DX * K**2 * COS(LAMBDA) / BETA
C DE/DX = CONST1(I) / BETA**2 *
C (ALOG(CONST2(I)*(P/MASS)**2) - BETA**2)
C = BETHE-BLOCH-FORMULA
C
BG2 = 1./(TRKBNK(30,ISURF+1,K)*COSLAM*FMASS)**2
ERG = SQRT(BG2/BETA2)*ELEC_MASS
FLGDCW = ISURF.EQ.1 .AND. .NOT.FLGVDC
FLGEE2 = IHYPSV.EQ.5 .AND. XFE1+XAL1.LT.1E-5
C
IF (FLGDCW) THEN
C ------------ NOW AT DC WALL
IF (FLGEE2) THEN
C --------------- NOW ELECTRONS EXP 2
DK = ( (CA(1)-CA(2)/ERG**CA(3))*CORR +
+ (1.+FAC*ALOG(ERG))*ERG)*XRAD(1)
ELSE
C --------------- NOW ALL OTHER CASES
PX = ABS(1./(TRKBNK(30,ISURF+1,K)*COSLAM))
DMAT = -XEPXY1/CSOMGA
CALL VXTADE(PX,DMAT,FMASS,DEPXY,EPXYI,PO)
DMAT = -XAG1/CSOMGA
CALL VXTADE(PO,DMAT,FMASS,DAG,AGI,PO)
DMAT = -XFE1/CSOMGA
CALL VXTADE(PO,DMAT,FMASS,DFE,FEI,PO)
DMAT = -XAL1/CSOMGA
CALL VXTADE(PO,DMAT,FMASS,DAL,ALI,PO)
ENDIF
ELSE
C ------------ NOW AT BEAM TUBE WALL
IF (FLGEE2) THEN
C --------------- NOW ELECTRONS EXP 2
DK =(AL(1)-AL(2)/ERG**AL(3) + (1.+FAC*ALOG(ERG))*ERG)
+ *XRAD(2)
ELSE
C --------------- NOW ALL OTHER CASES
PX = ABS(1./(TRKBNK(30,ISURF+1,K)*COSLAM))
DMAT = -XEPXY2/CSOMGA
CALL VXTADE(PX,DMAT,FMASS,DEPXY,EPXYI,PO)
DMAT = -XPBO2/CSOMGA
CALL VXTADE(PO,DMAT,FMASS,DPBO,PBOI,PO)
DMAT = -XAL2/CSOMGA
CALL VXTADE(PX,DMAT,FMASS,DAL,ALI,PO)
DMAT = -XBE2/CSOMGA
CALL VXTADE(PO,DMAT,FMASS,DBE,BEI,PO)
DMAT = -XCU2/CSOMGA
CALL VXTADE(PO,DMAT,FMASS,DCU,CUI,PO)
ENDIF
ENDIF
C
IF (FLGEE2) THEN
DK = DK * TRKBNK(30,ISURF+1,K)**2 * COSLAM /
+ ( SQRT( BETA2 ) * CSOMGA )
DEDK(K,ISURF) = 0.5*DK
TRKBNK(30,ISURF+1,K) =
+ SIGN(ABS(TRKBNK(30,ISURF+1,K))-DK,TRKBNK(30,ISURF+1,K))
ELSE
DEDK(K,ISURF) = 0.0
TRKBNK(30,ISURF+1,K) =
+ SIGN(1.0/(PO*COSLAM),TRKBNK(30,ISURF+1,K))
ENDIF
TRKBNK(31,ISURF+1,K) = 0.0
300 CONTINUE
C ------ MARK VXTKIN FINISHED (FOR VXSWIM)
350 ITKBNK(32,1,K) = 3
400 CONTINUE
C
C --- IF DEBUG, FILL FOR GRAPHICS
C USE IBRPVX TO PICK BANKS
C
IF (IBRPVX.LT.1 .OR. IBRPVX.GT.4) RETURN
DO 500 L=1,MAX
K = IGDTK(L)
IF (ITKBNK(32,2,K).LT.IBRPVX) GOTO 500
STATUS = BLOCAT(IW,'DTFS',DTFS_bnk_num_list(K),INDC,INDDAT)
IHDSIZ=IW(INDDAT+DTFHDS)
INDDAT=INDDAT+IHDSIZ
C ------ REFILL TRKBNK FOR DEBUG
RW(INDDAT+DTFLNG) = TRKBNK(1,IBRPVX,K)
RW(INDDAT+DTFXCO) = TRKBNK(2,IBRPVX,K)
RW(INDDAT+DTFYCO) = TRKBNK(3,IBRPVX,K)
RW(INDDAT+DTFXCO) = TRKBNK(4,IBRPVX,K)
RW(INDDAT+DTFPHI) =
+ ATAN2(TRKBNK(6,IBRPVX,K),TRKBNK(5,IBRPVX,K))
PHI = RW(INDDAT+DTFPHI)
IF (PHI.LT.0.)
+ RW(INDDAT+DTFPHI) = RW(INDDAT+DTFPHI) + PI2
RW(INDDAT+DTFCTT) =
+ SIGN(1./SQRT(1./TRKBNK(7,IBRPVX,K)**2-1.),TRKBNK(7,IBRPVX,K))
500 CONTINUE
C
RETURN
END
C 27/11/89 MEMBER NAME VXXFND (ES) FVS
SUBROUTINE VXXFND(CIRCL,XINT,IFLG)
$$IMPLICIT
C
C --- D. COPPAGE 25/07/83 V1.0
C REVISED 19.05.84 V1.01 (ARG07) F15PPP FIXED
C WRONG SNG. ONLY LOW PT AFFCTD
C REVISED 10.07.84 V1.02 FIXED FOR ABS(B) APRX 0
C REVISED 30.07.84 V1.03 FIXED FOR IFLG=2
C
C SUBROUTINE TO CALCULATE THE INTERSECTION OF TWO CIRCLES
C IF ONE OR BOTH DEGENERATE, IFLG CONTROLS PROGRAM FLOW
C --- CALLED FROM VXTKIN
C
C INPUT:
C CIRCL(3,2)
C CIRCL(*,1) 1 2 3
C IFLG=0 UNSIGNED RADIUS X-COORD CENTER Y-COORD CENTER
C IFLG=1 (SAY) TANGENT(Y) -TANGENT(X) T(X)*Y(0)-T(Y)*X(0)
C IFLG= 0 1 2 3
C 2 CIRCLES CIRCL(*,1)=LINE CIRCL(*,2)=LINE BOTH LINES
C OUTPUT:
C XINT(5)
C XINT(*) 1 2 3 4 5
C #INTERSECTS X-COORD(1) Y-COORD(1) X-COORD(2) Y-COORD(2)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
REAL CIRCL,XINT,XM,XMB
INTEGER NDX,MDX,IFLG,ISM,NERROR,IREVRS,J2,J3
REAL A,B,C,SAV,AA,BB,CC,DISC
DIMENSION CIRCL(3,2),XINT(5),XM(2,2),NDX(2),xmb(2)
DIMENSION MDX(4,2)
DATA MDX/2,3,4,5,3,2,5,4/
C
IF(IFLG.EQ.0)GO TO 300
IF(IFLG.EQ.3)GO TO 200
XINT(1)=0.
IF(IFLG.GT.3)RETURN
C ----------------->> CIRCLE AND LINE
A = CIRCL(1,IFLG)
B = CIRCL(2,IFLG)
C = CIRCL(3,IFLG)
ISM = 3 - IFLG
GO TO 305
C ----------------->> LINE AND LINE
200 CONTINUE
XM(1,1) = CIRCL(2,1)
XM(1,2) = CIRCL(3,1)
XM(2,1) = CIRCL(2,2)
XM(2,2) = CIRCL(3,2)
xmb(1) =-CIRCL(1,1)
xmb(2) =-CIRCL(1,2)
CALL reqn(2,XM,2,NDX,NERROR,1,xmb)
XINT(1) = 0.
IF(NERROR.NE.0)GO TO 900
XINT(1) = 1.
XINT(2) = xmb(1)
XINT(3) = xmb(2)
GO TO 900
C ----------------->> CASE OF TWO CIRCLES
300 CONTINUE
A = 2. * (CIRCL(2,2) - CIRCL(2,1))
B = 2. * (CIRCL(3,2) - CIRCL(3,1))
C = CIRCL(2,1)**2 - CIRCL(2,2)**2
+ + CIRCL(3,1)**2 - CIRCL(3,2)**2
+ - CIRCL(1,1)**2 + CIRCL(1,2)**2
ISM = 1
IF(CIRCL(1,1) .GT. CIRCL(1,2))ISM=2
C
305 CONTINUE
IREVRS = 1
IF( ABS(B).GT.ABS(A) )GO TO 310
IREVRS = 2
SAV = A
A = B
B = SAV
310 CONTINUE
J2 = MDX(1,IREVRS)
J3 = MDX(2,IREVRS)
AA = 1. + (A/B)**2
BB = 2 * (A/B * (C/B + CIRCL(J3,ISM)) - CIRCL(J2,ISM))
CC = CIRCL(J2,ISM)**2 + (C/B+CIRCL(J3,ISM))**2 - CIRCL(1,ISM)**2
DISC = BB**2 - 4. * AA * CC
XINT(1) = 0.
IF(DISC .LT. 0. )GO TO 900
XINT(1) = 1.
IF( ABS(DISC) .GT. 1.E-2 )GO TO 350
XINT(MDX(1,IREVRS)) = -0.5 * BB / AA
XINT(MDX(2,IREVRS)) = -0.5 * (A * XINT(MDX(1,IREVRS)) + C)/B
GO TO 900
350 CONTINUE
XINT(1) = 2.
DISC = SQRT(DISC)
XINT(MDX(1,IREVRS)) = 0.5 * (DISC - BB) / AA
XINT(MDX(3,IREVRS)) = 0.5 * (-DISC - BB) / AA
XINT(MDX(2,IREVRS)) = - (A * XINT(MDX(1,IREVRS)) + C) / B
XINT(MDX(4,IREVRS)) = - (A * XINT(MDX(3,IREVRS)) + C) / B
C
900 CONTINUE
RETURN
END
C 27/11/89 MEMBER NAME VXXYZ (ES) FVS
C 15/02/83 407102203 MEMBER NAME VXXYZ (DS) FORTRAN
SUBROUTINE VXXYZ(MAX,ILIST,X,VXERR,CSQO,IFIT,XCN,CONSTR)
$$IMPLICIT
C
C **********************************************************************
C * SUBROUTINE FOR ITERATING TO FIND A FIT VALUE FOR A VERTEX *
C * --- CALLED FROM VXMAIN *
C * *
C * --- D. COPPAGE --- VERSION 15/02/83 V1.00 *
C * 17/07/83 V2.00 (NOT ARGNEW COMPATIBLE) *
C * 04/10/83 V3.00 (ARG05) *
C * 27/06/84 V3.01 (ARG07) *
C * *
C * VXXYZ I/O DESCRIPTION *
C * INPUT: *
C * MAX = NUMBER OF TRACKS INPUT TO THE FIT *
C * ILIST(64) = LIST OF INPUT TRACKS OF WHICH THERE ARE 'MAX'*
C * X(3) = INPUT APPROXIMATION TO THE VERTEX *
C * XCN(3) = CONSTRAINT POSITION WHICH WILL BE SET UP LIKE*
C * AN EXTRA TRACK WHEN CONSTRA = .TRUE. *
C * CONSTR = LOGICAL VARIABLE WHICH WILL FORCE A *
C * CONSTRAINED FIT TO XCN(3) WHEN SET TRUE *
C * OUTPUT: *
C * MAX = NUMBER OF TRACKS FIT (CAN BE DIFFERENT FROM *
C * MAX OF INPUT) *
C * ILIST(64) = LIST OF 'MAX' TRACKS WHICH ARE INCLUDED IN *
C * THE FINAL FIT *
C * X(3) = X,Y,Z OF FINAL FIT *
C * VXERR(6) = COVARIANCE MATRIX OF THE VERTEX FIT *
C * CSQ = CHI SQUARED OF THE FIT *
C * IFIT = FLAG FOR THE FIT *
C * = 0 -> FIT GOOD *
C * <> 0 -> FIT NOT GOOD *
C * *
C * 2 number of iterations is too small *
C * 3 dchsq less than zero *
C * 4 error from matin1 *
C * 5 don't have 2 trks to start with because*
C * of vxprep in primer to vtx fit loop *
C * 6 errors on x,y,z > cut values *
C * 7 dchsq > dchssv *
C * 8 too few tracks to continue because of *
C * vxprep in interations for fit *
C * 9 labelled bad track *
C * 10 error matrix has neg diag elements *
C * *
C **********************************************************************
$$INCLUDE 'K$ITRK:CVXCUT.INC'
$$INCLUDE 'K$ITRK:CVXWORK.INC'
$$INCLUDE 'K$ITRK:CFLAGS.INC'
LOGICAL CONSTR
INTEGER MAX,ILIST(64),IFIT
REAL X(3),VXERR(6),CSQO,XCN(3)
C
INTEGER IDBGSV
REAL SCALE,CTERR2
INTEGER NDX(3),MXITR
INTEGER MTKS,NUMTKS,IBADTK,NUMT,IAVAIL,ITER,NERROR
REAL DCHMIN,CTR,CTZ,CTRM2,DEVOLD,DCHSSV,DCHSQ,CSQTST
REAL XSV(3),DV(3)
REAL VY(3),XGA(3,3),XGB(3),DENOM
C
C ----------------->> INIT
MXITR=ITRXVX
DCHMIN=CHGMVX
CTR=CTRVX
CTZ=CTZVX
CTRM2=(CTR**2)*.75
DEVOLD = -1.
XSV(1) = X(1)
XSV(2) = X(2)
XSV(3) = X(3)
DO MTKS= 1,MAX
ITKBNK(32,1,ILIST(MTKS)) = 3
ENDDO
C
NUMTKS=MAX
CALL VXPREP(NUMTKS,ILIST,X,XGA,XGB,CSQO,IBADTK,XCN,CONSTR)
IF(NUMTKS.LT.2)GO TO 510
DO MTKS= 1,MAX
TRKBNK(32,1,ILIST(MTKS)) = 4
ENDDO
NUMT=NUMTKS
DO 500 IAVAIL=2,NUMT
IF( NUMTKS .LT. 2 ) GO TO 510
DCHSSV = 1.0E7
C
DO 200 ITER=1,MXITR
VY(1)=XGB(1)
VY(2)=XGB(2)
VY(3)=XGB(3)
C
CALL REQINV(3,XGA,3,NDX,NERROR,1,XGB)
IF (NERROR.GT.0) THEN
IFIT=4
RETURN
ENDIF
C
IF( AMIN1(XGA(1,1),XGA(2,2),XGA(3,3)) .LT. 0.0)GO TO 529
DV(1)=XGB(1)
DV(2)=XGB(2)
DV(3)=XGB(3)
DCHSQ=VY(1)*DV(1)+VY(2)*DV(2)+VY(3)*DV(3)
C
IF(DCHSQ.LT.0.)GO TO 40
IF(DCHSQ.GT.DCHSSV)GO TO 380
DCHSSV = DCHSQ
MAX = NUMTKS
C
C ----------------->> DONT PERMIT CORRECTIONS TOO LARGE
36 DENOM=AMAX1(DV(1)/CTR,DV(2)/CTR,DV(3)/CTZ)
IF (ABS(DENOM).LT.1.E+6) GOTO 38
SCALE=0.3*ABS(1./AMAX1(DV(1)/CTR,DV(2)/CTR,DV(3)/CTZ))
IF( SCALE .GT. 1. )GO TO 38
DV(1) = DV(1)*SCALE
DV(2) = DV(2)*SCALE
DV(3) = DV(3)*SCALE
38 CONTINUE
X(1)=X(1)-DV(1)
X(2)=X(2)-DV(2)
X(3)=X(3)-DV(3)
C
C =================>> CONVERGENCE DECIDED HERE
IF(DCHSQ.LT.DCHMIN)GO TO 300
c
CALL VXPREP
+ (NUMTKS,ILIST,X,XGA,XGB,CSQTST,IBADTK,XCN,CONSTR)
IF(NUMTKS.LT.2)GO TO 510
CSQO=CSQTST
GO TO 200
C
40 CONTINUE
IFIT=3
CALL INERR(522,1)
C 0522 1 10VXXYZ : INCOMPLETE CHISQ CONVERGENCE IN MXITR ITERATIONS
GO TO 999
200 CONTINUE
C ----------------->> IF HERE, THEN NUMBER OF ITERATIONS
C (ITER) IS TOO SMALL.
IFIT=2
CALL INERR(522,1)
C 0522 1 10VXXYZ : INCOMPLETE CHISQ CONVERGENCE IN MXITR ITERATIONS
GO TO 999
300 CONTINUE
C
C =================>> IF HERE, THEN PREDICTED CHANGE IN
C CHISQ ACCEPTABLY SMALL. CHECK FOR
C BAD TRACKS AND IF NONE , RETURN
C WITH GOOD FIT.
IF(IBADTK .NE. 0)GO TO 380
C ----------------->> UPDATE EVERYTHING
VXERR(1)=XGA(1,1)
VXERR(2)=XGA(1,2)
VXERR(3)=XGA(1,3)
VXERR(4)=XGA(2,2)
VXERR(5)=XGA(2,3)
VXERR(6)=XGA(3,3)
C ----------------->> PERMIT A CUT ON MAX ERRS FROM FIT
CTERR2=CERRVX**2
IF( XGA(1,1) .GT. CTERR2 .OR.
+ XGA(2,2) .GT. CTERR2 .OR.
+ XGA(3,3) .GT. 36.0*CTERR2 ) GO TO 370
C ----------------->> FIT OK IF HERE
IFIT=0
GO TO 999
370 CALL INERR(526,1)
C 0526 1 10VXXYZ : VERTEX FIT FAILED - ERRORS ON X,Y,Z .GT. CUTOFF
IFIT=6
GO TO 999
C
380 CONTINUE
C ----------------->> TRK DV TOO LARGE - TRY TO REMOVE WORST
C TRACK
IDBGSV = ILIST(IBADTK)
c IF(NUMTKS.LE.2)GO TO 510
IF(NUMTKS.LE.2)GO TO 522
IF(NUMTKS.EQ.IBADTK)GO TO 400
IDBGSV = ILIST(IBADTK)
ILIST(IBADTK)=ILIST(NUMTKS)
400 NUMTKS=NUMTKS-1
C
DO 415 MTKS= 1,NUMTKS
415 ITKBNK(32,1,ILIST(MTKS)) = 4
C
X(1) = XSV(1)
X(2) = XSV(2)
X(3) = XSV(3)
CALL VXPREP(NUMTKS,ILIST,X,XGA,XGB,CSQO,IBADTK,XCN,CONSTR)
IF(NUMTKS.LT.2)GO TO 510
DO 420 MTKS= 1,NUMTKS
420 ITKBNK(32,1,ILIST(MTKS)) = 4
MAX=NUMTKS
500 CONTINUE
C
510 CONTINUE
C ----------------->> IF HERE, TOO FEW TRACKS TO CONTINUE
IFIT=5
C CALL INERR(525,1)
C 0525 1 10VXXYZ : TOO FEW TRACKS TO CONTINUE
GO TO 999
522 continue ! tried to remove a track since dchsq > dchssv
ifit=7 ! have too few tracks now
C ----------------->> UPDATE EVERYTHING
VXERR(1)=XGA(1,1)
VXERR(2)=XGA(1,2)
VXERR(3)=XGA(1,3)
VXERR(4)=XGA(2,2)
VXERR(5)=XGA(2,3)
VXERR(6)=XGA(3,3)
go to 999
529 CONTINUE
IFIT=-99
CALL INERR(529,1)
C 0529 2 10VXXYZ : ERR MATRIX HAS NEG DIAG ELEMENTS
999 CONTINUE
RETURN
END
[KLOE]
[Offline Doc]
[TRK Files]
Generated with Light on Thu Apr 8 13:00:16 MET DST 1999
.
Mail comments and suggestions.
