C =================================================================
C DCMCAN - A module for general checkout of Monte Carlo data.
C =================================================================
C
C Language:-
C ==========
C KLOE Fortran
C
C Modulename:-
C ============
C DCMCAN.KLOE
C
C Description:-
C =============
C This is an A_C Normal Module which contains all entries to run
C cursory analyses of Monte Carlo production data.
C
C DCMINI Initialize input program at start of job.
C DCMRIN Run Initialization Entry.
C DCMEVT Event Entry.
C DCMRFI Run End Entry.
C DCMFIN Cleanup for job termination.
C DCMBOO Histogram/ntuple booking
C DCMTLK Talk module
C
C Author:-
C ========
C F. Donno & F. Pelucchi
C KLOE Computing Group
C LNF Frascati
C
C Revision History:-
C ==================
C 10 Nov 1995 Original Creation
C
SUBROUTINE DCMINI
C =================
$$IMPLICIT
C
C Description:-
C =============
C This routine is called at program initialisation time.
C
C Call Parameters:-
C ================
C None
C
C Return Parameters:-
C ===================
C None
C
C Function Value:-
C ================
C None
C
C Global Declarations:-
C =====================
C
C External Functions:-
C ====================
C
C Local Declarations:-
C ====================
C
C Executable Code:-
C =================
C
RETURN
END
C
SUBROUTINE DCMRIN
C =================
$$IMPLICIT
C
C Description:-
C =============
C This routine is called at run initialisation time.
C No actions at present
C
C Call Parameters:-
C ================
C None
C
C Return Parameters:-
C ===================
C None
C
C Function Value:-
C ================
C None
C
C Global Declarations:-
C =====================
C
C External Functions:-
C ====================
C
C None
C
C Local Declarations:-
C ====================
C
C Executable Code:-
C =================
C
RETURN
END
C
SUBROUTINE DCMEVT
C =================
$$IMPLICIT
C
C Description:-
C =============
C This routine analyzes MC data ( MC data ONLY ! )
C
C Call Parameters:-
C ================
C None
C
C Return Parameters:-
C ===================
C None
C
C Function Value:-
C ================
C None
C
C Global Declarations:-
C =====================
$$INCLUDE 'K$INC:BCS.INC'
$$INCLUDE 'YBOS$LIBRARY:ERRCOD.INC'
C
$$INCLUDE 'K$ITRK:CFLAGS.INC'
$$INCLUDE 'K$ITRK:CDFCUT.INC'
$$INCLUDE 'K$ITRK:DPRS.INC'
$$INCLUDE 'K$ITRK:DTFS.INC'
$$INCLUDE 'K$ITRK:DVFS.INC'
$$INCLUDE 'K$ITRK:DCHD.INC'
C
C External Functions:-
C ====================
INTEGER BLOCAT,BNEXT,BDATA,BNUMB
C
C Local Declarations:-
C ====================
INTEGER STATUS,STATUS_DTFS,STATUS_DPRS,STATUS_DVFS
C
LOGICAL STABLE_PION,SUBMS
INTEGER IND_DPRS,INDAT_DPRS,IND_DTFS,INDAT_DTFS
INTEGER IND_DVFS,INDAT_DVFS
INTEGER IND,INDAT
INTEGER ITYPE,IDECAY,ITYK0,ITR
INTEGER MCNTRAC,MCK0L,MCK0S,NCANKL,NCANKS,HITPOS,HITNEG
INTEGER IVX,NTRVTX
C
REAL FITLOSS,HITINI,HITFIN,HITREJ,CHINOR,PCHI2,FRACMIX
C
C Executable Code:-
C =================
C
C
C Now locate the drift chamber header bank
STATUS = BLOCAT(IW,'DCHD',1,IND,INDAT)
IF (STATUS.EQ.YESUCC) THEN
IND = INDAT + IW(INDAT+DCHHDS)
ELSE
RETURN
ENDIF
C
CALL DFMCNTRAC(MCNTRAC,MCK0L,MCK0S)
CALL HFILL(203,FLOAT(MCNTRAC-IW(IND+DCHCAN)),0.,1.)
C
FITLOSS = 0.
NCANKL = 0
NCANKS = 0
C
C Loop over p.r. track candidates
C
STATUS_DPRS = BLOCAT(IW,'DPRS',-1,IND_DPRS,INDAT_DPRS)
DO WHILE (IND_DPRS.GT.0)
JDPRS = INDAT_DPRS + IW(INDAT_DPRS)
IF (IW(JDPRS+DPRPOK) .EQ. 3) THEN
JDPRS1 = JDPRS + DPRCEN
STATUS=BNUMB(IW,IND_DPRS,ITR)
HITINI = IW(JDPRS+DPRPOS) + IW(JDPRS+DPRNEG)
CALL HFILL (403,HITINI,0.,1.)
C
CALL DFMCTRUE(ITR,ITYPE,IDECAY,ITYK0,FRACMIX,SUBMS)
STABLE_PION = ITYPE.GT.7 .AND. IDECAY.LT.0
IF (STABLE_PION) THEN
IF (ITYK0.EQ.10) NCANKL = NCANKL+1
IF (ITYK0.EQ.16) NCANKS = NCANKS+1
STATUS_DTFS = BLOCAT(IW,'DTFS',ITR,IND_DTFS,INDAT_DTFS)
IND_DTFS = INDAT_DTFS + IW(INDAT_DTFS+DTFHDS)
IF (STATUS_DTFS.EQ.YESUCC) THEN
HITPOS = IW(IND_DTFS+DTFNHF)/10000
HITNEG = IW(IND_DTFS+DTFNHF)-10000*HITPOS
HITFIN = HITPOS+HITNEG
CALL HFILL (415,HITFIN,0.,1.)
HITREJ = HITINI-HITFIN
CALL HFILL (401,HITREJ,0.,1.)
IF (HITFIN.GT.6.) THEN
CHINOR=RW(IND_DTFS+DTFCHI)/(HITFIN-5)
CALL HFILL(409,CHINOR,0.,1.)
PCHI2 = RW(IND_DTFS+DTFPCH)
CALL HFILL(410,PCHI2,0.,1.)
ENDIF
CALL HFILL(211,FRACMIX,0.,1.)
ELSE
FITLOSS=FITLOSS+1.
CALL HFILL (402,HITINI,0.,1.)
ENDIF
ENDIF
ENDIF
STATUS_DPRS=BNEXT(IW,IND_DPRS,IND_DPRS)
STATUS_DPRS=BDATA(IW,IND_DPRS,INDAT_DPRS)
ENDDO
CALL HFILL(201,FLOAT(MCK0L-NCANKL),0.,1.)
CALL HFILL(202,FLOAT(MCK0S-NCANKS),0.,1.)
CALL HFILL(405,FITLOSS,0.,1.)
C
C Fill Vertex Histograms
STATUS_DVFS = BLOCAT(IW,'DVFS',-1,IND_DVFS,INDAT_DVFS)
DO WHILE (IND_DVFS.GT.0)
STATUS=BNUMB(IW,IND_DVFS,IVX)
NTRVTX = IW(INDAT_DVFS+IW(INDAT_DVFS+DVFHDS)+DVFNTR)
IF (NTRVTX.EQ.2) CALL VXHFILL(IVX)
STATUS_DVFS=BNEXT(IW,IND_DVFS,IND_DVFS)
STATUS_DVFS=BDATA(IW,IND_DVFS,INDAT_DVFS)
ENDDO
C
RETURN
END
C
SUBROUTINE DCMRFI
C =================
$$IMPLICIT
C
C Description:-
C =============
C This routine is called at run termination.
C It does any necessary cleanup.
C
C Call Parameters:-
C ================
C None
C
C Return Parameters:-
C ===================
C None
C
C Function Value:-
C ================
C None
C
C Global Declarations:-
C =====================
C
C External Functions:-
C ====================
C
C Local Declarations:-
C ====================
C
C Executable Code:-
C =================
C
RETURN
END
C
SUBROUTINE DCMFIN
C =================
$$IMPLICIT
C
C Description:-
C =============
C This routine is called at program termination.
C It does any necessary cleanup.
C
C Call Parameters:-
C ================
C None
C
C Return Parameters:-
C ===================
C None
C
C Function Value:-
C ================
C None
C
C Global Declarations:-
C =====================
C
C
C External Functions:-
C ====================
C
C Local Declarations:-
C ====================
C
C Executable Code:-
C =================
C
RETURN
END
C
SUBROUTINE DCMBOO
C =================
$$IMPLICIT
C
C Description:-
C =============
C This routine is called at run initialisation.
C
C Call Parameters:-
C ================
C None
C
C Return Parameters:-
C ===================
C None
C
C Function Value:-
C ================
C None
C
C Global Declarations:-
C =====================
C
C External Functions:-
C ====================
C
C Local Declarations:-
C ====================
C
C Executable Code:-
C =================
C
C Series 200: Histograms relative to Pattern Recognition control
C
CALL HBOOK1(201,' MC - N.candidates from K0l (stable pions)$',
+ 10,-5.,5.,0.)
CALL HBOOK1(202,' MC - N.candidates from K0s (stable pions)$',
+ 10,-5.,5.,0.)
CALL HBOOK1(203,' MC Tracks - N.candidates (stable pions) $',
+ 10,-5.,5.,0.)
CALL HBOOK1(204,'dx 1st hit(Pattern-MC) K0S$',100,-10.,10.,0.)
CALL HBOOK1(205,'dy 1st hit(Pattern-MC) K0S$',100,-10.,10.,0.)
CALL HBOOK1(206,'dz 1st hit(Pattern-MC) K0S$',100,-10.,10.,0.)
CALL HBOOK1(207,'dx 1st hit(Pattern-MC) K0L$',100,-20.,20.,0.)
CALL HBOOK1(208,'dy 1st hit(Pattern-MC) K0L$',100,-20.,20.,0.)
CALL HBOOK1(209,'dz 1st hit(Pattern-MC) K0L$',100,-20.,20.,0.)
CALL HBOOK1(210,' Mixing fraction from P.Rec. (all candidates)$',
+ 50,0.,0.5,0.)
CALL HBOOK1(211,' Mixing fraction from P.Rec. (fitted pions)$',
+ 50,0.,0.5,0.)
CALL HBOOK1(212,' P.R. fromIP ID for Ks tracks$',10,0.,10.,0.)
CALL HBOOK1(213,' P.R. fromIP ID for Kl tracks$',10,0.,10.,0.)
CALL HBOOK1(214,' P.R. fromIP ID for other tracks$',10,0.,10.,0.)
C
C Series 400: Histograms relative to Track Fit control
C
CALL HBOOK1(415,' accepted hits (fitted stable pions) $',
+ 100,0.,100.,0.)
CALL HBOOK1(401,' rejected hits (fitted stable pions) $',
+ 100,0.,100.,0.)
CALL HBOOK1(402,' initial hits (not fitted stable pions) $',
+ 100,0.,200.,0.)
CALL HBOOK1(403,' initial hits (all track candidates) $',
+ 100,0.,200.,0.)
CALL HBOOK1(404,' Geant type (lt.0 if decays) (all candidates)$',
+ 20,-9.5,10.5,0.)
CALL HBOOK1(405,' Not fitted candidates (stable pions)/event $',
+ 10,0.,10.,0.)
CALL HBOOK1(409,' chi2/ndgf (stable pions) $',50,0.,10.,0.)
CALL HBOOK1(410,' chi2 probability(stable pions)',51,0.,1.02,0.)
CALL HBOOK1(411,' CURV (true-fit)/true (stable pions) K0L $',
+ 50,-0.025,0.025,0.)
CALL HBOOK1(412,' COTAN (true - fit) (stable pions) K0L $',
+ 50,-0.05,0.05,0.)
CALL HBOOK1(413,' CURV (true-fit)/true (stable pions) K0S $',
+ 50,-0.025,0.025,0.)
CALL HBOOK1(414,' COTAN (true - fit) (stable pions) K0S $',
+ 50,-0.05,0.05,0.)
C
C Series 500: Histograms relative to Vertex Fit control
C
CALL HBOOK2(501,' MK0S vs EK0S $',100,0.45,0.55,100,0.45,0.55,0.)
CALL HBOOK2(502,' MK0L vs EK0L $',100,0.45,0.55,100,0.45,0.55,0.)
CALL HBOOK1(504,' K0L Rxyz vertex $',100,0.,200.,0.)
CALL HBOOK1(503,' K0S Rxyz vertex $',100,0.,20.,0.)
CALL HBOOK1(505,' Dxyz(Vfit,Vtrue) K0S $',50,0.,10.,0.)
CALL HBOOK1(506,' Dx (Vfit,Vtrue) K0S $',50,-5.,5.,0.)
CALL HBOOK1(507,' Dy (Vfit,Vtrue) K0S $',50,-5.,5.,0.)
CALL HBOOK1(508,' Dz (Vfit,Vtrue) K0S $',50,-5.,5.,0.)
CALL HBOOK1(509,' Dxyz(Vfit,Vtrue) K0L $',50,0.,5.,0.)
CALL HBOOK1(510,' Dx (Vfit,Vtrue) K0L $',60,-1.5,1.5,0.)
CALL HBOOK1(511,' Dy (Vfit,Vtrue) K0L $',60,-1.5,1.5,0.)
CALL HBOOK1(512,' Dz (Vfit,Vtrue) K0L $',60,-1.5,1.5,0.)
CALL HBOOK1(517,' DR (Vfit,Vtrue) K0L $',60,-1.5,1.5,0.)
CALL HBOOK1(513,' MK0S $',100,0.48,0.52,0.)
CALL HBOOK1(515,' EK0S $',100,0.50,0.54,0.)
CALL HBOOK1(514,' MK0L $',100,0.48,0.52,0.)
CALL HBOOK1(516,' EK0L $',100,0.50,0.54,0.)
C
RETURN
END
C
SUBROUTINE DCMTLK
C =================
$$IMPLICIT
C
C Description:-
C =============
C
C Call Parameters:-
C ================
C None
C
C Return Parameters:-
C ===================
C None
C
C Function Value:-
C ================
C None
C
C Global Declarations:-
C =====================
C
C External Functions:-
C ====================
C
C Local Declarations:-
C ====================
C
C Executable Code:-
C =================
C
RETURN
END
C*DK DFMCTRUE
C
SUBROUTINE DFMCTRUE(THISTRK,ITYPE,IDECAY,ITYK0,FRACMIX,SUBMS)
C
$$IMPLICIT
INTEGER THISTRK,ITYPE,IDECAY,ITYK0
REAL FRACMIX
LOGICAL SUBMS
$$INCLUDE 'K$INC:BCS.INC'
$$INCLUDE 'K$INC:BPOYBS.INC'
$$INCLUDE 'YBOS$LIBRARY:ERRCOD.INC'
$$INCLUDE 'K$ITRK:DPRS.INC'
$$INCLUDE 'K$ITRK:DTFS.INC'
$$INCLUDE 'K$ITRK:MCKINE.INC'
$$INCLUDE 'K$ITRK:CDFWORK.INC'
C
INTEGER STATUS,BLOCAT,IND,INDDAT
INTEGER IND2,INDH,INDDATH
INTEGER DHITNCO,FLAGS
REAL RTOIP,ZTOIP
C
INTEGER INDEX(100)
REAL TTPTR,TTCOT1,TTKUR1,DPTNOR,DCOTAN
C
INTEGER MCLIS(100)
LOGICAL IN_DRIFT
C
INTEGER NHITSP,IHITL,IHITM,ITRMC
INTEGER NTMO
INTEGER II,IIPMAX,NHISEC
REAL TYPE,XTRUE,YTRUE,ZTRUE,RDEC,ZDEC
C
NHITSP = IW(JDPRS+DPRPOS) + IW(JDPRS+DPRNEG)
CALL VZERO(MCLIS,100)
C
C Start finding out the GEANFI DHIT mother bank and the pointer banks DTHA
C and DTKA
STATUS = BLOCAT(IW,'DTHA',1,INDH,INDDATH)
IF (STATUS .NE. YESUCC) RETURN
INDH = INDDATH + IW(INDDATH+DTHHDS)
C
STATUS = BLOCAT(IW,'DHIT',1,IND,INDDAT)
IF (STATUS .NE. YESUCC) RETURN
IND = INDDAT + IW(INDDAT+DHIHDS)
DHITNCO = IW(INDDAT+DHINCO)
C
C We find here every MC track (1 in most cases, but maybe more)
C contributing hits to the current candidate to the Track Fit.
C NOTE: some hits may have been rejected by the fit, and marked with a
C negative wire number.
SUBMS = .FALSE.
DO II=1,NHITSP
IHITL = IABS(IW(JDPRS1+1+(II-1)*DPRLWI))
IHITM = IW(INDH+IHITL-1)
FLAGS = IW(IND+(IHITM-1)*DHITNCO+DHIFLA)
IF (MOD(FLAGS,10) .NE. 0) SUBMS = .TRUE.
ITRMC = IW(IND+(IHITM-1)*DHITNCO+DHITRA)
IF (ITRMC.GT.0 .AND. ITRMC.LT.100) THEN
MCLIS(ITRMC)=MCLIS(ITRMC)+1
ELSE
PRINT *,' DFMCTRUE: WRONG DHITRA IN DHIT!! =',ITRMC
ENDIF
ENDDO
C
C Let us scan them, to find the MC track contributing most hits,
C and also the SECOND most important, to assess the mixing
CALL SORTZV(MCLIS,INDEX,100,-1,1,0)
IIPMAX = INDEX(1)
NHISEC = MCLIS(INDEX(2))
FRACMIX = FLOAT(NHISEC)/NHITSP
CALL HFILL(210,FRACMIX,0.,1.)
C
ITYK0 = KPLI(4,IIPMAX) ! 10,16 -> KL,KS
ITYPE = KPLI(2,IIPMAX)
IND2 = IND
IHITM = 1
DO WHILE (IW(IND2+DHITRA) .NE. IIPMAX)
IHITM = IHITM+1
IND2 = IND2+DHITNCO
ENDDO
XTRUE = RW(IND+(IHITM-1)*DHITNCO+DHIXCO)
YTRUE = RW(IND+(IHITM-1)*DHITNCO+DHIYCO)
ZTRUE = RW(IND+(IHITM-1)*DHITNCO+DHIZCO)
IF (ITYK0.EQ.16 .AND. FRACMIX.EQ.0.) THEN
CALL HFILL(204,RW(JDPRS+DPRXCO)-XTRUE,0.,1.)
CALL HFILL(205,RW(JDPRS+DPRYCO)-YTRUE,0.,1.)
CALL HFILL(206,RW(JDPRS+DPRZCO)-ZTRUE,0.,1.)
ENDIF
IF (ITYK0.EQ.10 .AND. FRACMIX.EQ.0.) THEN
CALL HFILL(207,RW(JDPRS+DPRXCO)-XTRUE,0.,1.)
CALL HFILL(208,RW(JDPRS+DPRYCO)-YTRUE,0.,1.)
CALL HFILL(209,RW(JDPRS+DPRZCO)-ZTRUE,0.,1.)
ENDIF
IDECAY = -1
DO II=IIPMAX+1,NNP
NTMO = KPLI(3,II)
IF (NTMO .EQ. IIPMAX) THEN
RDEC = SQRT(VTI(1,II)**2+VTI(2,II)**2)
ZDEC = VTI(3,II)
IN_DRIFT = RDEC.LT.195. .AND. ABS(ZDEC).LT.170.
IF (IN_DRIFT) IDECAY = 1
ENDIF
ENDDO
C
IF (FRACMIX .LT. 0.10) THEN
IF (ITYK0.EQ.16) THEN
CALL HFILL(212,FLOAT(IW(JDPRS+DPRCEN)),0.,1.)
ELSEIF (ITYK0.EQ.10) THEN
CALL HFILL(213,FLOAT(IW(JDPRS+DPRCEN)),0.,1.)
ELSE
CALL HFILL(214,FLOAT(IW(JDPRS+DPRCEN)),0.,1.)
ENDIF
ENDIF
C
TYPE = -IDECAY*ITYPE
CALL HFILL(404,TYPE,0.,1.)
C
STATUS = BLOCAT(IW,'DTFS',THISTRK,IND,INDDAT)
IND = INDDAT+IW(INDDAT+DTFHDS)
IF (STATUS.EQ.YESUCC.AND.ITYPE.GT.7 .AND. IDECAY.LT.0) THEN
TTPTR = SQRT(PLI(1,IIPMAX)**2+PLI(2,IIPMAX)**2)
TTCOT1 = PLI(3,IIPMAX)/TTPTR
TTKUR1 = CHRG(IIPMAX)/TTPTR
IF (TTKUR1 .NE. 0.) THEN
DPTNOR = (TTKUR1-RW(IND+DTFCUR))/TTKUR1
DCOTAN = TTCOT1 - RW(IND+DTFCTT)
ZTOIP = 0.
RTOIP = 0.
IF(ITYK0.EQ.10) THEN
CALL HFILL(411,DPTNOR,0.,1.)
CALL HFILL(412,DCOTAN,0.,1.)
CALL HFILL(1011,ZTOIP,RTOIP,1.)
ENDIF
IF(ITYK0.EQ.16) THEN
CALL HFILL(413,DPTNOR,0.,1.)
CALL HFILL(414,DCOTAN,0.,1.)
CALL HFILL(1012,ZTOIP,RTOIP,1.)
ENDIF
ENDIF
ENDIF
C
RETURN
END
C*DK DFMCNTRAC
C
SUBROUTINE DFMCNTRAC(MCNTRAC,MCK0L,MCK0S)
C
$$IMPLICIT
INTEGER MCNTRAC,MCK0L,MCK0S
$$INCLUDE 'K$INC:BCS.INC'
$$INCLUDE 'YBOS$LIBRARY:ERRCOD.INC'
$$INCLUDE 'K$INC:BPOYBS.INC'
$$INCLUDE 'K$ITRK:DPRS.INC'
$$INCLUDE 'K$ITRK:MCKINE.INC'
C
INTEGER STATUS,BLOCAT,IND,INDDAT,INDH,INDDATH
INTEGER DHITNCO,IHITL
C
INTEGER II,JJ,NTMO,NHII,NHITS
LOGICAL PION,DECAYED
C
STATUS = BLOCAT(IW,'DHIT',1,IND,INDDAT)
IF (STATUS .NE. YESUCC) RETURN
DHITNCO = IW(INDDAT+DHINCO)
C
STATUS = BLOCAT(IW,'DTHA',1,INDH,INDDATH)
IF (STATUS .NE. YESUCC) RETURN
NHITS = IW(INDDATH+DTHNRO)
INDH = INDDATH + IW(INDDATH+DTHHDS)
C
MCNTRAC = 0
MCK0L = 0
MCK0S = 0
DO II=1,NNP
PION = KPLI(2,II).EQ.8 .OR. KPLI(2,II).EQ.9
IF (PION) THEN
DECAYED = .FALSE.
DO JJ=II+1,NNP
NTMO = KPLI(3,JJ)
IF (NTMO .EQ. II) DECAYED = .TRUE.
ENDDO
IF (.NOT.DECAYED) THEN
NHII = 0
DO JJ=1,NHITS
IHITL = IW(INDH+JJ-1)
IND = INDDAT+IW(INDDAT+DHIHDS)+(IHITL-1)*DHITNCO
IF (IW(IND+DHITRA).EQ.II) THEN
NHII = NHII+1
ENDIF
ENDDO
IF (NHII.GE.6) THEN
MCNTRAC = MCNTRAC+1
IF (KPLI(4,II).EQ.10) MCK0L = MCK0L+1
IF (KPLI(4,II).EQ.16) MCK0S = MCK0S+1
ENDIF
ENDIF
ENDIF
ENDDO
C
RETURN
END
C*DK VXHFILL
C
SUBROUTINE VXHFILL(IVX)
C
$$IMPLICIT
C
$$INCLUDE 'K$INC:BCS.INC'
$$INCLUDE 'K$INC:BPOYBS.INC'
$$INCLUDE 'YBOS$LIBRARY:ERRCOD.INC'
$$INCLUDE 'K$ITRK:MCKINE.INC'
$$INCLUDE 'K$ITRK:CFLAGS.INC'
$$INCLUDE 'K$ITRK:DPRS.INC'
$$INCLUDE 'K$ITRK:DTFS.INC'
$$INCLUDE 'K$ITRK:DVFS.INC'
C
INTEGER IVX
INTEGER STATUS,I,IV,INDV,INDDATV,INDC,INDDAT,IHDSIZ
INTEGER BLOCAT
INTEGER II
C
INTEGER INDEX(100),ITR,IND,INDAT,INDH,INDDATH,INDT,INDDATT
INTEGER MCLIS(100),NP(2)
INTEGER NHITSP,IHITL,IHITM,ITRMC,DHITNCO
C
REAL EK,PXK,PYK,PZK,CURV,COT,PHI,PTR,PZ,GMK,GMPI2
REAL XINT(3),RVXY,DIST,RVF,DX,DY,DZ,DR
LOGICAL K0S,K0L
REAL X1,X2,X3,X4,CHI2MU3,PROXIM,RMES
PARAMETER (GMPI2=0.019488) !! IN GEV
C
STATUS = BLOCAT(IW,'DVFS',IVX,INDV,INDDATV)
IF (STATUS .NE. YESUCC) RETURN
INDV = INDDATV + IW(INDDATV+DVFHDS)
XINT(1) = RW(INDV+DVFXCO)
XINT(2) = RW(INDV+DVFYCO)
XINT(3) = RW(INDV+DVFZCO)
C
EK=0.
PXK=0.
PYK=0.
PZK=0.
C
STATUS = BLOCAT(IW,'DTHA',1,INDH,INDDATH)
IF (STATUS .NE. YESUCC) RETURN
INDH = INDDATH + IW(INDDATH+DTHHDS)
C
STATUS = BLOCAT(IW,'DHIT',1,INDT,INDDATT)
IF (STATUS .NE. YESUCC) RETURN
INDT = INDDATT + IW(INDDATT+DHIHDS)
DHITNCO = IW(INDDATT+DHINCO)
C
DO 10 I=1,2
ITR = IW(INDV+DVFNTR+DVFTRA+19*(I-1))
STATUS = BLOCAT(IW,'DTFS',ITR,INDC,INDDAT)
IHDSIZ=IW(INDDAT+DTFHDS)
INDDAT=INDDAT+IHDSIZ
CURV=RW(INDV+DVFNTR+DVFCRV+19*(I-1))
COT =RW(INDV+DVFNTR+DVFCTV+19*(I-1))
PHI =RW(INDV+DVFNTR+DVFPHV+19*(I-1))
PTR=1./ABS(CURV)
PZ=PTR*COT
EK=EK+SQRT(GMPI2+PTR*PTR+PZ*PZ)
PXK=PXK+PTR*COS(PHI)
PYK=PYK+PTR*SIN(PHI)
PZK=PZK+PZ
C------------------------
IF (MONTECARLO) THEN
STATUS = BLOCAT(IW,'DPRS',ITR,IND,INDAT)
if (STATUS.eq.YESUCC) then
JDPRS = INDAT + IW(INDAT)
JDPRS1 = JDPRS + DPRCEN
IF(IW(JDPRS+DPRPOS).LT.4 .OR.
& IW(JDPRS+DPRNEG).LT.4) GO TO 99 ! 4+4 hits
NHITSP=IW(JDPRS+DPRPOS)+IW(JDPRS+DPRNEG)
CALL VZERO(MCLIS,100)
DO II=1,NHITSP
IHITL=IABS(IW(JDPRS1+1+(II-1)*DPRLWI))
IHITM = IW(INDH+IHITL-1)
ITRMC = IW(INDT+(IHITM-1)*DHITNCO+DHITRA)
IF (ITRMC.GT.0 .AND. ITRMC.LT.100) THEN
MCLIS(ITRMC)=MCLIS(ITRMC)+1
ELSE
PRINT *,' VXHFILL: WRONG DHITRA IN DHIT!! =',ITRMC
ENDIF
ENDDO
CALL SORTZV(MCLIS,INDEX,100,-1,1,0)
NP(I) = INDEX(1)
II = NP(I)
cx IF ( KPLI(2,II).NE.8 .AND. KPLI(2,II).NE.9 ) GO TO 99 ! pion
cx DO JJ=II+1,NNP
cx IF( KPLI(3,JJ) .EQ. II) GO TO 99 ! stable pion
cx ENDDO
GO TO 10
ENDIF
ENDIF
C-----------------------
10 CONTINUE
C
GMK = SQRT(EK*EK-PXK*PXK-PYK*PYK-PZK*PZK)
RVF = SQRT(XINT(1)*XINT(1)+XINT(2)*XINT(2)+XINT(3)*XINT(3))
K0S = .FALSE.
IF (RVF.LT.15.) K0S = .TRUE. ! provisional definition for real data
C
IF(MONTECARLO) THEN
IF (KPLI(3,NP(1)) .NE. KPLI(3,NP(2)) ) GOTO 99 ! same mother
K0S = .FALSE.
IF(KPLI(4,NP(1)) .EQ. 16) K0S =.TRUE.
K0L = .FALSE.
IF(KPLI(4,NP(1)) .EQ. 10) K0L =.TRUE.
IF ( .NOT.K0L .AND. .NOT.K0S ) GO TO 99
DO IV=1,NNV
IF(KVLI(1,IV) .EQ. KPLI(3,NP(1)) ) THEN
RVXY = SQRT( VLI(1,IV)*VLI(1,IV) + VLI(2,IV)*VLI(2,IV))
IF (K0L .AND. RVXY.LT.30.) GO TO 99 ! fid vol for K0L
DX = XINT(1) - VLI(1,IV)
DY = XINT(2) - VLI(2,IV)
DZ = XINT(3) - VLI(3,IV)
DR = SQRT(XINT(1)**2 +XINT(2)**2 +0.000001) -
. SQRT(VLI(1,IV)**2+VLI(2,IV)**2+0.000001)
DIST = SQRT(DX*DX + DY*DY + DZ*DZ)
RMES = SQRT(XINT(1)**2+XINT(2)**2+XINT(3)**2)
IF (K0S) THEN
CALL HFILL(505,DIST,0.,1.)
CALL HFILL(506,DX,0.,1.)
CALL HFILL(507,DY,0.,1.)
CALL HFILL(508,DZ,0.,1.)
ELSE
CALL HFILL(509,DIST,0.,1.)
CALL HFILL(510,DX,0.,1.)
CALL HFILL(511,DY,0.,1.)
CALL HFILL(512,DZ,0.,1.)
CALL HFILL(517,DR,0.,1.)
CALL HFILL(518,RMES,0.,1.)
ENDIF
ENDIF
ENDDO
C
IF(K0S) THEN
CALL HFILL(501,GMK,EK,1.)
CALL HFILL(513,GMK,0.,1.)
CALL HFILL(515,EK,0.,1.)
CALL HFILL(503,RVF,0.,1.)
ELSE
CALL HFILL(502,GMK,EK,1.)
CALL HFILL(514,GMK,0.,1.)
CALL HFILL(516,EK,0.,1.)
CALL HFILL(504,RVF,0.,1.)
X1 = (EK-0.510)-(GMK-0.49767)
X2 = (EK-0.510)+(GMK-0.49767)
X3 = PROXIM(ATAN2(PYK,PXK)-ATAN2(XINT(2),XINT(1)),0.)
X4 = PZK/SQRT(PXK**2+PYK**2) -
+ XINT(3)/SQRT(XINT(1)**2+XINT(2)**2)
CALL HFILL(518,X1,0.,1.)
CALL HFILL(519,X2,0.,1.)
CALL HFILL(520,X3,0.,1.)
CALL HFILL(521,X4,0.,1.)
CHI2MU3 = (X1/0.001)**2 + (X2/0.002)**2 +
+ (X3/0.006)**2 + (X4/0.03)**2
CALL HFILL(522,CHI2MU3,0.,1.)
ENDIF
C
ENDIF
C
99 RETURN
END
[KLOE]
[Offline Doc]
[TRK Files]
Generated with Light on Thu Apr 8 13:00:16 MET DST 1999
.
Mail comments and suggestions.
