C =================================================================
C DCPRAR - implementation of the ARGUS Pattern Recognition for KLOE
C =================================================================
C
C Language:-
C ==========
C KLOE Fortran
C
C Modulename:-
C ============
C DCPRAR.KLOE
C
C Description:-
C =============
C This is an A_C Normal Module containing the implementation for KLOE
C of the ARGUS Pattern Recognition strategy. This adaptation was made
C by A. Andryakov.
C
C DCPINI Initialize input program at start of job.
C DCPRIN Run Initialization Entry.
C DCPEVT Event Entry.
C DCPRFI Run End Entry.
C DCPFIN Cleanup for job termination.
C DCPBOO Histogram/ntuple booking
C DCPTLK 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 DCPINI
C =================
$$IMPLICIT
C
C Description:-
C =============
C This routine is called at program initialisation time.
C It sets an average value of the magnetic field
C and the PTRN_REC control flag, and then
C fills up the /PTRTLK/ common with talk_to menu information.
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 'S_I$LIBRARY:NOARGINC.INC'
$$INCLUDE 'K$ITRK:CCONST.INC'
$$INCLUDE 'K$ITRK:CFLAGS.INC'
$$INCLUDE 'K$ITRK:CDTCUT.INC'
C
C External Functions:-
C ====================
INTEGER UIDFFI
C
C Local Declarations:-
C ====================
INTEGER STATUS
INTEGER GROUP,MENUID1,MENUID2,MENUID3
COMMON /PTRTLK/ GROUP,MENUID1,MENUID2,MENUID3
C
REAL BFIELD
C
C Executable Code:-
C =================
C
PI = ACOS(-1.)
PI2 = 2.*PI
PIBY2 = PI/2.
PIBY4 = PI/4.
C---------------------------------------------------------
C- Value of magnetic field inside D.C.
C-
BFIELD = 6.
TIFLAV = BFIELD * CONVERS
C
C The Default operation mode is to run Pattern Recognition,
C not the bypass, AND to use explicit t-s relations.
C
PTRN_REC = .TRUE.
TS_RAWREL = .TRUE.
TS_FINEREL = .TRUE.
C
C Control words for pattern recognition (ARGUS based)
C ===================================================
C A description of each word can be found in K$ITRK:CDTCUT.CIN
C
C Load initial values of these cuts from defaults in BLOCK DATA
DTXPN0 = DFCPN0
DTXPN1 = DFCPN1
DTXPN2 = DFCPN2
DTXPN3 = DFCPN3
DTXUR1 = DFCUR1
DTXUR2 = DFCUR2
LDTXTR = LDFCTR
LDTXT3 = LDFCT3
LDTXT2 = LDFCT2
C
C Read DCPTLK Definition File
C ===========================
STATUS = UIDFFI('K$TRK:DCPTLK.UID',GROUP,MENUID1,
& N$A,N$A,MENUID3,N$A)
IF (MENUID3.GT.MENUID1) THEN
MENUID2=MENUID1+1
ENDIF
C
RETURN
END
C
SUBROUTINE DCPRIN
C =================
$$IMPLICIT
C
C Description:-
C =============
C This routine initialize the DC geometry. The reason why this is here
C instead of in DCPINI is that the DB calls in DCGEOM_ARGUS and _MC
C need run-dependent data not yet available at DCPINI time.
C
C Call Parameters:-
C None
C
C Function Value:-
C ================
C None
C
C Global Declarations:-
C =====================
$$INCLUDE 'K$INC:JOBSTA.INC'
$$INCLUDE 'K$INC:RUNTYP.INC'
C
C External Functions:-
C ====================
INTEGER DCGEOM_ARGUS,DCGEOM_MC
C
C Local Declarations:-
C ====================
INTEGER STATUS,SOURCE,KEY14,RTKEY
CHARACTER IDXID*2 /'GE'/
C
C Executable Code:-
C =================
C
C Initialize drift chamber geometry
C =================================
RTKEY = EXOFSI
RTKEY = ISHFT(RTKEY,24)
RTKEY = IOR(RTKEY,RUKPHY)
C
SOURCE= 1
KEY14 = 0
STATUS = DCGEOM_ARGUS(SOURCE,KEY14,RTKEY)
STATUS = DCGEOM_MC(IDXID,SOURCE,KEY14,NRUN,RTKEY)
C
RETURN
END
C
SUBROUTINE DCPEVT
C =================
$$IMPLICIT
C
C Description:-
C =============
C This routine calls PRMAIN, the driver of the ARGUS PR program.
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 'K$INC:JOBSTA.INC'
$$INCLUDE 'K$INC:ERLEVL.INC'
$$INCLUDE 'YBOS$LIBRARY:BNKTYP.INC'
$$INCLUDE 'YBOS$LIBRARY:ERRCOD.INC'
$$INCLUDE 'K$ITRK:CFLAGS.INC'
$$INCLUDE 'K$ITRK:CDTCUT.INC'
$$INCLUDE 'K$ITRK:CDTHIT.INC'
$$INCLUDE 'K$ITRK:CTIDRI.INC'
$$INCLUDE 'K$ITRK:DHRE.INC'
$$INCLUDE 'K$ITRK:DCHD.INC'
C
C External Functions:-
C ====================
INTEGER BLOCAT,BDROP,BMAKEG,BLIST
C
C Local Declarations:-
C ====================
INTEGER STATUS
INTEGER INDH,INDDATH,INDR,INDDATR,DHRENCO
INTEGER J,NDCHITS
C
C Executable Code:-
C =================
C
C Create YBOS header for charged reconstruction
C =============================================
C
STATUS = BDROP(IW,'DCHD')
STATUS = BMAKEG(IW,'DCHD',1,7,BNKTI4,INDH,INDDATH)
IF (STATUS .NE. YESUCC) THEN
CALL ERLOGR('DCPEVT',ERWARN,0,STATUS,
& 'DCHD bank not created!?')
RETURN
ELSE
IW(INDDATH+DCHHDS) = 2 ! Header size
IW(INDDATH+DCHVRN) = 1 ! Version number
INDH = INDDATH+IW(INDDATH+DCHHDS)
STATUS = BLIST(IW,'A+','DCHD')
IF (STATUS .NE. YESUCC) THEN
CALL ERLOGR('ATFEVT',ERWARN,0,STATUS,
& 'DCHD bank not added to A list')
ENDIF
ENDIF
C
STATUS = BDROP(IW,'DPRS')
IF (MONTECARLO .AND. .NOT.PTRN_REC) THEN
C
C Skip Pattern Recognition (if explicitly requested),
C but obviously only for Monte Carlo data.
C ===================================================
CALL DPRBYPASS
ELSE
C
C Call pattern recognition
C ========================
STATUS = BLOCAT(IW,'DHRE',1,INDR,INDDATR)
IF (STATUS .NE. YESUCC) THEN
RETURN
ENDIF
INDR = INDDATR+IW(INDDATR+DHRHDS)
DHRENCO = IW(INDDATR+DHRNCO)
NDCHITS = IW(INDDATR+DHRNRO)
DO J=1,NDCHITS
LDT(J) = IW(INDR+DHRSLR)
N_WIR(J) = IW(INDR+DHRWNR)
DTD(J) = RW(INDR+DHRRAD)
DTP(J) = TIDDP(LDT(J))*(N_WIR(J)-1)
DTE(J) = (dderr_scale_f*RW(INDR+DHRERR))**2
C The program could divide by 0. in DTDIST unless the following
C precaution is taken:
IF (DTP(J).EQ.0. .AND. DTD(J).EQ.0.) DTD(J)=0.0020
C
INDR = INDR + DHRENCO
ENDDO
CALL CLEAN_CWORK
CALL PRMAIN(NDCHITS)
C
ENDIF
C
CALL DCPHIS
C
STATUS = BLIST(IW,'A+','DPRS')
IF (STATUS .NE. YESUCC) THEN
CALL ERLOGR('DCPEVT',ERWARN,0,STATUS,
& 'DPRS banks not added to A list')
ENDIF
C
RETURN
END
C
SUBROUTINE DCPRFI
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 DCPFIN
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 DCPBOO
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
CALL HBOOK1(200,'Pattern Rec. INERR codes',100,0.,100.,0.)
CALL HBOOK1(2,'Unassociated hits after PR.',100,0.,100.,0.)
CALL HBOOK1(3,'Fraction of unassociated hits.',50,0.,1.,0.)
CALL HBOOK1(4,'Number of 3D track candidates',20,0.,20.,0.)
CALL HBOOK1(5,'Number of 3D candidates from IP',20,0.,20.,0.)
CALL HBOOK1(6,'N.hits of 3D candidates from IP' ,50,0.,150.,0.)
CALL HBOOK1(7,'N.hits of 3D candidates not from IP',50,0.,150.,0.)
CALL HBOOK2(8,'Extrap. R0/Z0, inner tracks',
. 50,-50.,50.,50,0.,50.,0.)
CALL HBOOK2(9,'Extrap. R0/Z0, outer tracks',
. 50,-50.,50.,50,0.,50.,0.)
CALL HBPRO(0,0.)
C
RETURN
END
C
SUBROUTINE DCPTLK
C =================
$$IMPLICIT
C
C Description:-
C =============
C Treat pattern recognition operational menu
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$ITRK:CDTCUT.INC'
$$INCLUDE 'K$ITRK:CFLAGS.INC'
$$INCLUDE 'UIPACK$LIBRARY:UIERROR.INC'
$$INCLUDE 'S_I$LIBRARY:NOARGINC.INC'
C
INTEGER GROUP,MENUID1,MENUID2,MENUID3
COMMON /PTRTLK/ GROUP,MENUID1,MENUID2,MENUID3
C External Functions:-
C ====================
INTEGER UIUSGP,UIACME,UIGTIN,UIGTRE,UIGTYE
C
C Local Declarations:-
C ====================
INTEGER STATUS
CHARACTER*40 VERB
C
C Executable Code:-
C =================
C
C Loop over "mode" menu items
C
1000 CONTINUE
STATUS = UIUSGP(GROUP,N$A)
STATUS = UIACME(MENUID1,VERB,N$A)
IF (STATUS.EQ.UIABRT) RETURN
C
C Process the PTRF choice
C =========================
IF (VERB.EQ.'PTRF') THEN
STATUS = UIGTYE(
& 'Do you want to perform pattern recognition?(yes/no)',
& PTRN_REC)
C
C Process the DTXPN0 choice
C =======================
ELSE IF (VERB.EQ.'DTXPN0') THEN
STATUS = UIGTRE('DTXPN0 :',
& DTXPN0,N$A,N$A)
C
C Process the DTXPN1 choice
C =======================
ELSE IF (VERB.EQ.'DTXPN1') THEN
STATUS = UIGTRE('DTXPN1 :',
& DTXPN1,N$A,N$A)
C
C Process the DTXPN2 choice
C =======================
ELSE IF (VERB.EQ.'DTXPN2') THEN
STATUS = UIGTRE('DTXPN2 :',
& DTXPN2,N$A,N$A)
C
C Process the DTXPN3 choice
C =======================
ELSE IF (VERB.EQ.'DTXPN3') THEN
STATUS = UIGTRE('DTXPN3 :',
& DTXPN3,N$A,N$A)
C
C Process the DTXUR1 choice
C =======================
ELSE IF (VERB.EQ.'DTXUR1') THEN
STATUS = UIGTRE('DTXUR1 :',
& DTXUR1,N$A,N$A)
C
C Process the DTXUR2 choice
C =======================
ELSE IF (VERB.EQ.'DTXUR2') THEN
STATUS = UIGTRE('DTXUR2 :',
& DTXUR2,N$A,N$A)
C
C Process the LDTXTR choice
C =======================
ELSE IF (VERB.EQ.'LDTXTR') THEN
STATUS = UIGTIN('LDTXTR :',
& LDTXTR,N$A,N$A)
C
C Process the LDTXT2 choice
C =======================
ELSE IF (VERB.EQ.'LDTXT2') THEN
STATUS = UIGTIN('LDTXT2 :',
& LDTXT2,N$A,N$A)
C
C Process the LDTXT3 choice
C =======================
ELSE IF (VERB.EQ.'LDTXT3') THEN
STATUS = UIGTIN('LDTXT3 :',
& LDTXT3,N$A,N$A)
C
C Process the RWTS choice
C =========================
ELSEIF (VERB.EQ.'RWTS') THEN
STATUS = UIGTYE(
& 'RAW T-s relations used ? ',
& TS_RAWREL)
IF (.NOT.TS_RAWREL) TS_FINEREL = .FALSE.
C
C Process the P.R. internals access choise
C ========================================
ELSE IF (VERB.EQ.'INTERN') THEN
call PR_internals_menu
C
C Process the PRLOAD choice
C =======================
ELSE IF (VERB.EQ.'PRLOAD') THEN
DTXPN0 = DFCPN0
DTXPN1 = DFCPN1
DTXPN2 = DFCPN2
DTXPN3 = DFCPN3
DTXUR1 = DFCUR1
DTXUR2 = DFCUR2
LDTXTR = LDFCTR
LDTXT3 = LDFCT3
LDTXT2 = LDFCT2
TS_RAWREL = .TRUE.
TS_FINEREL = .TRUE.
C
C Process the RETURN choice
C =========================
ELSE IF (VERB.EQ.'RETURN') THEN
RETURN
ENDIF
C
GOTO 1000
C
END
SUBROUTINE PR_internals_menu
C =================
$$IMPLICIT
C
C Description:-
C =============
C Treat pattern recognition operational menu
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$ITRK:CDTCUT.INC'
$$INCLUDE 'K$ITRK:CFLAGS.INC'
$$INCLUDE 'K$INC:LOGUNI.INC'
$$INCLUDE 'UIPACK$LIBRARY:UIERROR.INC'
$$INCLUDE 'S_I$LIBRARY:NOARGINC.INC'
C
INTEGER GROUP,MENUID1,MENUID2,MENUID3
COMMON /PTRTLK/ GROUP,MENUID1,MENUID2,MENUID3
C External Functions:-
C ====================
INTEGER UIUSGP,UIACME,UIGTRE
C
C Local Declarations:-
C ====================
INTEGER STATUS
CHARACTER*40 VERB
C
C Executable Code:-
C =================
C
C Loop over "mode" menu items
C
write (LUTTYO,'(///70(''*'')/
& '' One can effectively switched off check of the G1 '',
& ''and G2 cuts ''/
& ''in the DTPTRNS code by putting to zero the values of both ''/
& ''G1_cut and G1_cut in this menu''
& //70(''*'')///)')
1000 CONTINUE
STATUS = UIUSGP(GROUP,N$A)
STATUS = UIACME(MENUID2,VERB,N$A)
IF (STATUS.EQ.UIABRT) RETURN
C
C Process the DDSF choice
C =======================
IF (VERB.EQ.'DDSF') THEN
status = uigtre('Drift distance error scale factor :',
& dderr_scale_f,N$A,N$A)
C
C Process the G1_cut choice
C =========================
C
ELSE IF (VERB.EQ.'G1_CUT') THEN
status = uigtre('G1_cut in units of cell size :',
& G1_frac,N$A,N$A)
C
C Process the G2_cut choice
C =========================
C
ELSE IF (VERB.EQ.'G2_CUT') THEN
status = uigtre('G2_cut in units of cell size :',
& G2_frac,N$A,N$A)
C
C Process the CHI2_E choice
C =========================
C
ELSE IF (VERB.EQ.'CHI2_E') THEN
status = uigtre(
& 'chi**2 cut on rejection of a segment extension :',
& chi2_pr_cut,N$A,N$A)
C
C Process the RETURN choice
C =========================
ELSE IF (VERB.EQ.'RETURN') THEN
RETURN
ENDIF
C
GOTO 1000
C
END
C=======================================================================
C
SUBROUTINE DCPHIS
$$IMPLICIT
C----------------------------------------------------------------------
C-
C- Purpose and Methods : Do some control histograms.
C-
C----------------------------------------------------------------------
$$INCLUDE 'K$INC:BCS.INC'
$$INCLUDE 'YBOS$LIBRARY:ERRCOD.INC'
C
$$INCLUDE 'K$ITRK:DHRE.INC'
$$INCLUDE 'K$ITRK:DPRS.INC'
$$INCLUDE 'K$ITRK:DCHD.INC'
C
LOGICAL REVERSE
INTEGER BLOCAT,BNEXT,BDATA
INTEGER STATUS,IND,INDAT,STATUS_DPRS,IND_DPRS,INDAT_DPRS
INTEGER INDR,INDDATR,DHRENCO,NDCHITS,FRSTPT,FRSTLY
INTEGER PTRCAN,LOOP
REAL XST(3),CURV,CTGT,PHI,ZTOBEAM,RTOBEAM
REAL HITINI,ALONE,S
C
C The following two parameters decide when a candidate looks "centered",
C i.e. apparently coming from the interaction point.
REAL RMAX,ZMAX
PARAMETER (RMAX=5., ZMAX=20.)
C
C Start locating bank DHRE
STATUS = BLOCAT(IW,'DHRE',1,INDR,INDDATR)
IF (STATUS .NE. YESUCC) THEN
RETURN
ENDIF
INDR = INDDATR+IW(INDDATR+DHRHDS)
DHRENCO = IW(INDDATR+DHRNCO)
NDCHITS = IW(INDDATR+DHRNRO)
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
C Loop over p.r. track candidates to try to identify "centered" ones
C The first hit must be in one of the 2 innermost layers: 57 or 58.
C The point of CA must be within 5 cm of the beamline and closer than 20 cm
C from the IP, along Z.
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
IW(IND+DCHCAN)=IW(IND+DCHCAN)+1
REVERSE = .TRUE.
XST(1) = RW(JDPRS+DPRXCO)
XST(2) = RW(JDPRS+DPRYCO)
XST(3) = RW(JDPRS+DPRZCO)
CURV = RW(JDPRS+DPRCUR)
CTGT = RW(JDPRS+DPRCTT)
PHI = RW(JDPRS+DPRPHI)
FRSTPT = IABS(IW(JDPRS+DPRCEN+1))
FRSTLY = IW(INDR+DHRENCO*(FRSTPT-1)+DHRSLR)
CALL DFTOIP(XST,CURV,CTGT,PHI,REVERSE,ZTOBEAM,RTOBEAM,S)
IF (FRSTLY.EQ.57 .OR. FRSTLY.EQ.58) THEN
CALL HFILL(8,ZTOBEAM,RTOBEAM,1.)
IF (RTOBEAM.LE.RMAX .AND. ABS(ZTOBEAM).LE.ZMAX) THEN
RW(JDPRS+DPRCEN) = ABS(S)
IW(IND+DCHCCN) = IW(IND+DCHCCN)+1
ENDIF
HITINI = IW(JDPRS+DPRPOS) + IW(JDPRS+DPRNEG)
IF (IW(IND+DCHCCN).EQ.1) THEN
CALL HFILL(6,HITINI,0.,1.)
ELSE
CALL HFILL(7,HITINI,0.,1.)
ENDIF
ELSE
CALL HFILL(9,ZTOBEAM,RTOBEAM,1.)
ENDIF
C
ENDIF
STATUS_DPRS=BNEXT(IW,IND_DPRS,IND_DPRS)
STATUS_DPRS=BDATA(IW,IND_DPRS,INDAT_DPRS)
ENDDO
CALL HFILL(4,FLOAT(IW(IND+DCHCAN)),0.,1.)
CALL HFILL(5,FLOAT(IW(IND+DCHCCN)),0.,1.)
C
ALONE = 0.
PTRCAN = INDR+DHRTRN
DO LOOP=1,NDCHITS
IF (IW(PTRCAN).LE.0) ALONE = ALONE+1.
PTRCAN = PTRCAN+DHRENCO
ENDDO
CALL HFILL(2,ALONE,0.,1.)
CALL HFILL(3,ALONE/FLOAT(NDCHITS),0.,1.)
C
RETURN
END
C
[KLOE]
[Offline Doc]
[TRK Files]
Generated with Light on Thu Apr 8 13:00:16 MET DST 1999
.
Mail comments and suggestions.
