BLOCK DATA BLKDAT
$$INCLUDE 'K$ITRK:BLKDAT.INC'
END
SUBROUTINE DPRBYPASS
$$IMPLICIT
C----------------------------------------------------------------------
C-
C- Purpose and Methods : Interface to bypass any Pattern Recognition
C- algorythm: obvs. to be called only for MC data
C-
C- Inputs : KLOE bank DHIT
C-
C- Output : KLOE banks DPRS
C-
C- Created 5 -jun-1992 Alexander Andryakov
C- Revised 12-feb-1993 A.A.
C- Revised 14-dec-1994 A.A. $ M.Antonelli
C-
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
$$INCLUDE 'K$INC:BCS.INC'
$$INCLUDE 'K$INC:BPOYBS.INC'
$$INCLUDE 'YBOS$LIBRARY:ERRCOD.INC'
$$INCLUDE 'K$INC:ERLEVL.INC'
C Following excerpt is from 'GEAPACK$LIBRARY:GEAPAK.INC'
INTEGER Part,Mate,TMed,Volu,RotM,
& Sets,Draw,RunG,Head,Vert,
& Kine,XYZ, Hits,Digi
PARAMETER (Part=1, Mate=2, TMed=3, Volu=4, RotM=5,
& Sets=6, Draw=7, RunG=8, Head=9, Vert=10,
& Kine=11,XYZ=12, Hits=13,Digi=14)
$$INCLUDE 'K$ITRK:CFLAGS.INC'
$$INCLUDE 'K$ITRK:CTIDRI.INC'
$$INCLUDE 'K$ITRK:CCONST.INC'
$$INCLUDE 'K$ITRK:DPRS.INC'
$$INCLUDE 'K$ITRK:DHRE.INC'
$$INCLUDE 'K$ITRK:DCHD.INC'
C
C External Functions:-
C ====================
C
INTEGER GCOUNT,BLOCAT,BTYMKG
C
C Local Declarations:-
C ====================
C
INTEGER STATUS,IND,INDDAT,IND2,DHITNCO
INTEGER INDH,INDDATH,INDP,INDDATP
INTEGER INDR,INDDATR,DHRENCO,INDC,INDATC
INTEGER THISTRK,PRVTRK,NTHISTRK
INTEGER NORIG,NHITS,LOOP,LOOP2,PARTICLE
INTEGER IHIT,NPLS,NMNS,SCAN,KPLA
INTEGER BNKSIZ
C
REAL PTRA,AZIP,CHARGE
REAL PREVX,PREVY,THISX,THISY
REAL XST(3),CURV,CTGT,PHI,ZTOBEAM,RTOBEAM,S
LOGICAL REVERSE
C
CHARACTER*80 BNKTYP
DATA BNKTYP/'2I4,9R4,2I4,R4,2I4,2R4,I4,XXX(I4,R4)'/
C
C Executable Code:-
C =================
C
PRVTRK = -99
C
C Start finding out the GEANFI DHIT mother bank, the pointer bank DTHA
C and the hit bank DHRE.
STATUS = BLOCAT(IW,'DTHA',1,INDH,INDDATH)
IF (STATUS .NE. YESUCC) THEN
RETURN
ENDIF
INDH = INDDATH + IW(INDDATH+DTHHDS)
NHITS = IW(INDDATH+DTHNRO)
IF (NHITS.EQ.0) RETURN
C
STATUS = BLOCAT(IW,'DHIT',1,IND,INDDAT)
IF (STATUS .NE. YESUCC) THEN
CALL ERLOGR('DPRBYPASS',ERWARN,0,0,
+ 'Bank DHIT not found!')
RETURN
ENDIF
DHITNCO = IW(INDDAT+DHINCO)
C
STATUS = BLOCAT(IW,'DHRE',1,INDR,INDDATR)
IF (STATUS .NE. YESUCC) THEN
CALL ERLOGR('DPRBYPASS',ERWARN,0,0,
+ 'Bank DHRE not found!')
RETURN
ENDIF
DHRENCO = IW(INDDATR+DHRNCO)
C
C The original number of GEANFI tracks is obtained here. Possibly
C there are AUX tracks, don't know how many. AUX tracks are by
C default discarded below.
NORIG = GCOUNT(KINE)
C
C Now locate the drift chamber header bank
STATUS = BLOCAT(IW,'DCHD',1,INDC,INDATC)
IF (STATUS.EQ.YESUCC) THEN
INDC = INDATC + IW(INDATC+DCHHDS)
IW(INDC+DCHCAN) = 0
IW(INDC+DCHCCN) = 0
ELSE
CALL ERLOGR('DPRBYPASS',ERWARN,0,0,
+ 'DC Header Bank not found!')
RETURN
ENDIF
C
DO 100 LOOP=1,NHITS
IHIT = IW(INDH+LOOP-1)
IND = INDDAT+IW(INDDAT+DHIHDS)+(IHIT-1)*DHITNCO
C
C Check for the start of a new track:
THISTRK = IW(IND+DHITRA)
IF (THISTRK .NE. PRVTRK) THEN
IF (THISTRK .LE. NORIG) THEN
C
C This track is not an AUX one. First, count how many hits are there,
C and how many DHIT hits one has to scan to find them.
NPLS = 0
NMNS = 0
LOOP2 = LOOP
IND2 = IND
11 CONTINUE
KPLA = 59-IW(IND2+DHIADR)/2**9
IF (TIDST(KPLA) .LT. 0.) NMNS = NMNS + 1
IF (TIDST(KPLA) .GT. 0.) NPLS = NPLS + 1
LOOP2 = LOOP2 + 1
IF (LOOP2.LE.NHITS) THEN
IHIT = IW(INDH+LOOP2-1)
IND2 = INDDAT+IW(INDDAT+DHIHDS)+(IHIT-1)*DHITNCO
IF (IW(IND2+DHITRA).EQ.THISTRK) GOTO 11
ENDIF
NTHISTRK = NPLS + NMNS
C
C Now make the corresponding DPRS bank, and fill the header
WRITE (BNKTYP(27:29),'(I3)') NTHISTRK
STATUS = BTYMKG(IW,'DPRS',THISTRK,
+ BNKTYP,BNKSIZ,INDP,INDDATP)
IF (STATUS.NE.YESUCC) THEN
CALL ERLOGR('DPRBYPASS',ERWARN,0,0,
+ 'Error creating bank DPRS')
GOTO 100
ENDIF
IW(INDC+DCHCAN) = IW(INDC+DCHCAN) + 1
IW(INDDATP+DPRHDS) = 2
IW(INDDATP+DPRVRN) = 1
INDP = INDDATP + IW(INDDATP+DPRHDS)
RW(INDP+DPRXCO) = RW(IND+DHIXCO)
RW(INDP+DPRYCO) = RW(IND+DHIYCO)
RW(INDP+DPRZCO) = RW(IND+DHIZCO)
C
PARTICLE = IW(IND+DHIPTY)
IF (PARTICLE.EQ.2.OR.PARTICLE.EQ.5.OR.PARTICLE.EQ.8.OR.
+ PARTICLE.EQ.11.OR.PARTICLE.EQ.14) CHARGE = 1.
IF (PARTICLE.EQ.3.OR.PARTICLE.EQ.6.OR.PARTICLE.EQ.9.OR.
+ PARTICLE.EQ.12.OR.PARTICLE.EQ.15) CHARGE = -1.
PTRA = SQRT(RW(IND+DHIPPX)**2+RW(IND+DHIPPY)**2)
C
C Due to truncation in GEANT some very small transverse momenta
C can be transfered as exactly zero. Move up to 1 keV:
IF (PTRA .EQ. 0.) THEN
PTRA = 0.000001
AZIP = 0.
ELSE
AZIP = ATAN2(RW(IND+DHIPPY),RW(IND+DHIPPX))
ENDIF
C
C Remember: the ARGUS fit works with momenta in GeV/c
RW(INDP+DPRCUR) = 1000.*CHARGE/PTRA
IF (AZIP.LT.0) AZIP = AZIP+PI2
RW(INDP+DPRPHI) = AZIP
RW(INDP+DPRCTT) = RW(IND+DHIPPZ)/PTRA
C
IW(INDP+DPRPOS) = NPLS
IW(INDP+DPRNEG) = NMNS
RW(INDP+DPRQUA) = 0.
IW(INDP+DPRPOK) = 3
IW(INDP+DPRLRG) = 0
RW(INDP+DPRPHF) = 0.
RW(INDP+DPRPHL) = 0.
IW(INDP+DPRCEN) = 0
REVERSE = .TRUE.
XST(1) = RW(INDP+DPRXCO)
XST(2) = RW(INDP+DPRYCO)
XST(3) = RW(INDP+DPRZCO)
CURV = RW(INDP+DPRCUR)
CTGT = RW(INDP+DPRCTT)
PHI = RW(INDP+DPRPHI)
CALL DFTOIP(XST,CURV,CTGT,PHI,REVERSE,ZTOBEAM,RTOBEAM,S)
IF (RTOBEAM.LE.5. .AND. ABS(ZTOBEAM).LE.20.) THEN
RW(INDP+DPRCEN) = ABS(S)
IW(INDC+DCHCCN) = IW(INDC+DCHCCN)+1
ENDIF
C
C Bank header done. Now do the data points.
LOOP2 = LOOP
INDP = INDP + DPRCEN
PREVX = -9999.
PREVY = -9999.
DO SCAN=1,NTHISTRK
IHIT = IW(INDH+LOOP2-1)
IND2 = INDDAT+IW(INDDAT+DHIHDS)+(IHIT-1)*DHITNCO
IW(INDP+DPRIWI) = LOOP2
THISX = RW(IND2+DHIXCO)
THISY = RW(IND2+DHIYCO)
IF (PREVX .NE. -9999.) THEN
RW(INDP+DPRWTR-DPRLWI) =
+ SQRT((THISX-PREVX)**2+(THISY-PREVY)**2)
ENDIF
PREVX = THISX
PREVY = THISY
C
C Adjourn bank DHRE adding the last word of each data block (the track link)
C Moreover, if inversion of a raw s-t relation was requested, recover the
C drift distance sign, which was lost in that step.
INDR = INDDATR+IW(INDDATR+DHRHDS)+(LOOP2-1)*DHRENCO
IW(INDR+DHRTRN) = THISTRK
IF (TS_RAWREL)
+ RW(INDR+DHRRAD) = SIGN(RW(INDR+DHRRAD),RW(IND2+DHIDIS))
C
LOOP2 = LOOP2 + 1
INDP = INDP + DPRLWI
ENDDO
RW(INDP-DPRLWI+DPRWTR) = 0.
C
C Add information about the last point of a track candidate
RW(INDDATP+IW(INDDATP+DPRHDS)+DPRXLS) = RW(IND2+DHIXCO)
RW(INDDATP+IW(INDDATP+DPRHDS)+DPRYLS) = RW(IND2+DHIYCO)
RW(INDDATP+IW(INDDATP+DPRHDS)+DPRZLS) = RW(IND2+DHIZCO)
ENDIF
PRVTRK = THISTRK
ENDIF
100 CONTINUE
C
RETURN
END
C*DK DPRARG
SUBROUTINE DPRARG
$$IMPLICIT
C----------------------------------------------------------------------
C-
C- Purpose and Methods : Interface to transfer to KLOE official banks
C- the output from the ARGUS Pattern Recognition.
C-
C- Inputs : Arrays IB,JB,KB in common /CTRACK/
C-
C- Outputs : KLOE banks DPRS:
C- DPRXCO R*4 X coordinate of PCA
C- DPRYCO R*4 Y coordinate of PCA
C- DPRZCO R*4 Z coordinate of PCA
C- DPRCUR R*4 curvature
C- DPRPHI R*4 azimuth angle at PCA
C- DPRCTT R*4 cot(theta)
C-
C- Created
C-
C----------------------------------------------------------------------
C
$$INCLUDE 'K$INC:BCS.INC'
$$INCLUDE 'YBOS$LIBRARY:ERRCOD.INC'
$$INCLUDE 'K$INC:ERLEVL.INC'
$$INCLUDE 'K$ITRK:CCONST.INC'
$$INCLUDE 'K$ITRK:CDTHIT.INC'
$$INCLUDE 'K$ITRK:CTIDRI.INC'
$$INCLUDE 'K$ITRK:CTRACK.INC'
$$INCLUDE 'K$ITRK:DPRS.INC'
$$INCLUDE 'K$ITRK:DHRE.INC'
$$INCLUDE 'K$ITRK:DCHD.INC'
$$INCLUDE 'K$ITRK:DCMERGINT.INC'
C
INTEGER BLOCAT,BTYMKG,BGARB
C
INTEGER INDR,INDDATR,DHRENRO,DHRENCO
C
INTEGER NPOS_CHECK,NNEG_CHECK
INTEGER ITR,JTR,NHITS
INTEGER STATUS,IODGSZ,IND,INDAT,INDC,INDATC
INTEGER JPT,KBU,IWIRE
C
INTEGER layer_max,layer_min,layer_curr,layer_dir,layer_pr,num_DPRS
LOGICAL ch_dir,first,first_view2
REAL phi_first,phi_last,phi_path,phi_priv
C
CHARACTER*36 BNKTYP
DATA BNKTYP/'2I4,9R4,2I4,R4,2I4,2R4,I4,XXX(I4,R4)'/
C
REAL A,B,PROX
PROX(B,A)=B + 6.2831853 * ANINT(0.15915494*(A-B))
C
status = BGARB(iw)
if (status.ne.YESUCC) then
call ERLOGR('DPRARG',ERSEVR,0,status,
& 'Garbage collection(1) cannot be performed!?')
return
endif
STATUS = BLOCAT(IW,'DHRE',1,INDR,INDDATR)
IF (STATUS .NE. YESUCC) THEN
CALL ERLOGR('DPRARG',ERWARN,0,0,
+ 'Bank DHRE not found!')
RETURN
ENDIF
INDR = INDDATR + IW(INDDATR+DHRHDS)
DHRENRO = IW(INDDATR+DHRNRO)
DHRENCO = IW(INDDATR+DHRNCO)
C
C Now locate the drift chamber header bank
STATUS = BLOCAT(IW,'DCHD',1,INDC,INDATC)
IF (STATUS.EQ.YESUCC) THEN
INDC = INDATC + IW(INDATC+DCHHDS)
IW(INDC+DCHCAN) = 0
IW(INDC+DCHCCN) = 0
ELSE
CALL ERLOGR('DPRARG',ERWARN,0,0,
+ 'DC Header Bank not found!')
RETURN
ENDIF
C
first_view2 = .TRUE.
first_itr2=0
num_DPRS=0
call vzero(inddat_dprs_array,N_TRK_MAX)
ITR=LWIDT1
DO 100 WHILE (ITR.GT.0)
IF (IB(5,ITR).LT.0) GO TO 100
C
NHITS = IB(4,ITR)+IB(6,ITR)
IF (NHITS.GT.999) THEN
NHITS = 999
CALL INERR(402,1)
ENDIF
WRITE (BNKTYP(27:29),'(I3)') NHITS
C
STATUS = BTYMKG(IW,'DPRS',num_DPRS+1,BNKTYP,IODGSZ,IND,INDAT)
IF (STATUS.NE.YESUCC) THEN
CALL INERR(403,1)
GO TO 100
ENDIF
C
IW(INDAT+DPRHDS) = 2
IW(INDAT+DPRVRN) = 1
C
num_DPRS = num_DPRS + 1
if(num_DPRS .le. N_TRK_MAX) then
inddat_dprs_array(num_DPRS) = INDAT + IW(INDAT + DPRHDS)
last_itr2 = num_DPRS
elseif(num_DPRS .eq. N_TRK_MAX+1) then
CALL ERLOGR('DPRARG',ERWARN,0,0,
+ 'Number of DPR banks greater then N_TRK_MAX')
endif
C
JDPRS = INDAT + IW(INDAT)
C
JTR=IB(2,ITR)
RW(JDPRS+DPRXCO)=BJ(4,JTR)
RW(JDPRS+DPRYCO)=BJ(5,JTR)
RW(JDPRS+DPRXLS)=0.
RW(JDPRS+DPRYLS)=0.
RW(JDPRS+DPRZLS)=0.
RW(JDPRS+DPRCUR)=BI(7,ITR)* 2. / TIFLAV
RW(JDPRS+DPRPHI)=BJ(7,JTR)
IW(JDPRS+DPRPOS)=IB(4,ITR)
IW(JDPRS+DPRNEG)=IB(6,ITR)
C
RW(JDPRS+DPRQUA)=BI(8,ITR)
IW(JDPRS+DPRPOK)=IB(5,ITR)
if(first_view2 .and. IB(5,ITR).eq.2) then
first_view2 = .FALSE.
first_itr2=num_DPRS
endif
IW(JDPRS+DPRCEN)=0
JDPRS1 = JDPRS + DPRCEN
C
JPT = JDPRS1
KBU=IB(3,ITR)
layer_max=-1
layer_min=1000
phi_path=0.
ch_dir=.FALSE.
first=.TRUE.
layer_dir=0
DO WHILE (KBU.NE.0)
C
IW(JPT+DPRIWI) = LIST_HIT(KB(2,KBU))
RW(JPT+DPRWTR) = BK(4,KBU)
RW(INDR+(IW(JPT+DPRIWI)-1)*DHRENCO+DHRRAD) = BK(3,KBU)
c
c Preparation for merging - defining layer and phi boundary of t.c.
c
layer_curr = iw(indr+(iw(jpt+DPRIWI)-1)*DHRENCO+DHRSLR)
phi_last = (iw(indr+(iw(jpt+DPRIWI)-1)*DHRENCO+DHRWNR)-1) *
& TIDDP(layer_curr)
if(.not.first) then
phi_path=phi_path+abs(phi_last-PROX(phi_priv,phi_last))
phi_priv=phi_last
if(layer_dir.ne.0 .and. .not.ch_dir)
& ch_dir = ch_dir .or.
& layer_dir*(layer_curr - layer_pr) .lt. 0
layer_dir = layer_curr - layer_pr
else
first=.FALSE.
phi_first = (iw(indr+(iw(jpt+DPRIWI)-1)*DHRENCO+DHRWNR)-1) *
& TIDDP(layer_curr)
phi_priv=phi_first
endif
layer_pr=layer_curr
if(layer_curr .lt. layer_min) layer_min = layer_curr
if(layer_curr .gt. layer_max) layer_max = layer_curr
c
C
C Adjourn bank DHRE adding the last word of each data block: the track link.
C For points assigned by the pattern to a 1-view track candidate, the link
C has a negative sign to notify DFNEWW that those points are actually free,
C and at the same time to tell the display to paint these hits yellow!
C For all unassigned points the link is zero.
IF (IB(5,ITR).EQ.3) THEN
IW(INDR+(IW(JPT+DPRIWI)-1)*DHRENCO+DHRTRN) = num_DPRS
ELSE
IW(INDR+(IW(JPT+DPRIWI)-1)*DHRENCO+DHRTRN) =-num_DPRS
ENDIF
C
JPT = JPT + DPRLWI
KBU=KB(1,KBU)
ENDDO
c
if(ch_dir) then
iw(jdprs+DPRLRG)=-(itr*10000 + layer_max*100 + layer_min)
else
iw(jdprs+DPRLRG)= itr*10000 + layer_max*100 + layer_min
endif
rw(jdprs+DPRPHF)=phi_first
if(phi_path.gt.PI2) then
rw(jdprs+DPRPHL)=-101.
else
rw(jdprs+DPRPHL)=phi_last
endif
c
c Check the inconsistence of KB and IB after p.r. -- Andryakov --
c (Actually this is not an error in any way: it depends on accidental
c overlapping of several track candidates.
c
NPOS_CHECK=0
NNEG_CHECK=0
KBU=IB(3,ITR)
DO WHILE (KBU.NE.0)
IWIRE=KB(2,KBU)
IF (TIDST(LDT(IWIRE)) .LT. 0.) NNEG_CHECK=NNEG_CHECK+1
IF (TIDST(LDT(IWIRE)) .GT. 0.) NPOS_CHECK=NPOS_CHECK+1
KBU=KB(1,KBU)
ENDDO
IW(JDPRS+DPRNEG)=NNEG_CHECK
IW(JDPRS+DPRPOS)=NPOS_CHECK
c
100 ITR=IB(1,ITR)
C
RETURN
END
[KLOE]
[Offline Doc]
[TRK Files]
Generated with Light on Thu Apr 8 13:00:16 MET DST 1999
.
Mail comments and suggestions.
