C =================================================================
C DCONVR - A dummy module for time->distance conversion of DC hits
C =================================================================
C
C Language:-
C ==========
C KLOE Fortran
C
C Modulename:-
C ============
C DCONVR.KLOE
C
C Description:-
C =============
C This is an A_C Normal Module which contains all entries to run
C the Drift Chamber conversion code in the A_C environment.
C
C DCOINI Initialize input program at start of job.
C DCORIN Run Initialization Entry.
C DCOEVT Event Entry.
C DCORFI Run End Entry.
C DCOFIN Cleanup for job termination.
C DCOBOO Histogram/ntuple booking
C DCOTLK 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 DCOINI
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 DCORIN
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 =====================
$$INCLUDE 'K$INC:JOBSTA.INC'
C
C
C External Functions:-
C ====================
INTEGER INITRST,INITFST,INITRSIG,INITFSIG
C
C
C Local Declarations:-
C ====================
INTEGER STATUS
C
C Executable Code:-
C =================
C
C Initialize drift chamber database
C =================================
STATUS = INITRST(NRUN,EXPTYP,RUNTYP) ! Init Raw s-t relations
STATUS = INITFST(NRUN,EXPTYP,RUNTYP) ! Init Fine s-t relations
STATUS = INITRSIG(NRUN,EXPTYP,RUNTYP) ! Init Raw s-t error tables
STATUS = INITFSIG(NRUN,EXPTYP,RUNTYP) ! Init Fine s-t error tables
C
RETURN
END
C
SUBROUTINE DCOEVT
C =================
$$IMPLICIT
C
C Description:-
C =============
C This routine applies the actual conversion algorythm for each event
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:RUNTYP.INC'
$$INCLUDE 'K$INC:BPOYBS.INC'
$$INCLUDE 'YBOS$LIBRARY:ERRCOD.INC'
$$INCLUDE 'K$INC:ERLEVL.INC'
$$INCLUDE 'K$ITRK:CFLAGS.INC'
$$INCLUDE 'K$ITRK:CDFCUT.INC'
$$INCLUDE 'K$ITRK:DHRE.INC'
C
C External Functions:-
C ====================
C
INTEGER BLOCAT,BTYMKG
INTEGER RAWST
C
C Local Declarations:-
C ====================
C
INTEGER STATUS,INDC,INDDATC,NHITC,DHITNCO,DTCENCO
INTEGER IND,INDR,INDH,INDDAT,INDDATR,INDDATH,DHRENCO
INTEGER BNKSIZ,LOOP,IHIT,KPLA,KWIR
C
REAL DRIFTT,DRIFTR,ERRD
REAL VINV,ALENGBY2
DATA VINV/0.035/,ALENGBY2/155./
C
REAL RAND_R(1)
C
CHARACTER*21 BNKTYP
DATA BNKTYP/'4I4,XXXXX(2I4,2R4,I4)'/
C
C Executable Code:-
C =================
C
C To begin, let's find out if we are reading Monte Carlo or real data.
MONTECARLO = EXPTYP .EQ. EXOFSI
C
C================================================================
C The calls to REKINE and CLEANUP must be done at the first
C module that is called: for now, here in DCOEVT.
IF (MONTECARLO) THEN
CALL REKINE
CALL CLEANUP
ENDIF
CALL CLEANUP_DATA
C================================================================
C
C Locate bank DTCE
STATUS = BLOCAT(IW,'DTCE',1,INDC,INDDATC)
IF (STATUS.NE.YESUCC) THEN
C There are no hits in the DC, no clusters, no nothing. Signal this and exit.
CALL HFILL(1,0.,0.,1.)
CALL HFILL(2,0.,0.,1.)
RETURN
ENDIF
NHITC = IW(INDDATC+DTCNRO)
DTCENCO = IW(INDDATC+DTCNCO)
C
C Make first version of bank DHRE
WRITE (BNKTYP(5:9),'(I5)') NHITC
STATUS = BTYMKG(IW,'DHRE',1,BNKTYP,BNKSIZ,INDR,INDDATR)
IF (STATUS.NE.YESUCC) THEN
CALL ERLOGR('DCOEVT',ERWARN,0,STATUS,
+ 'Error creating bank DHRE!')
RETURN
ENDIF
C
C Fill the header of DHRE .....
IW(INDDATR+DHRHDS) = 4
IW(INDDATR+DHRVRN) = 1
IW(INDDATR+DHRNRO) = NHITC
IW(INDDATR+DHRNCO) = 5
DHRENCO = IW(INDDATR+DHRNCO)
C
C And now fill the point data.
INDC = INDDATC+IW(INDDATC+DTCHDS)
INDR = INDDATR+IW(INDDATR+DHRHDS)
DO LOOP=1,NHITC
C
C Convert address from DTCE which follows the GEANFI convention, in which
C sense layer 1 is INNERMOST, to the ARGUS one in which it is the OUTERMOST
KPLA = IW(INDC+DTCADR)/2**9
KWIR = IW(INDC+DTCADR) - KPLA*2**9
KPLA = 59-KPLA
IW(INDR+DHRSLR) = KPLA
IW(INDR+DHRWNR) = KWIR
C
C Correct times in DTCE, cutting 5.43 ns to each. This -on the average-
C takes into account a time for signal propagation along the wires,
C corresponding to a half of the drift chamber length and will help
C Pattern Recognition, marginally though.
IF (RW(INDC+DTCTIM) .LT. 0.) THEN
DRIFTT = ABS(AMIN1(RW(INDC+DTCTIM)+VINV*ALENGBY2,0.))
ELSE
DRIFTT = ABS(AMAX1(RW(INDC+DTCTIM)-VINV*ALENGBY2,0.))
ENDIF
C
C Invert here a time-to-distance relation averaged over all crossing angles
IF (KPLA.GT.46) THEN
STATUS = RAWST(2,DRIFTT,DRIFTR,ERRD)
ELSE
STATUS = RAWST(3,DRIFTT,DRIFTR,ERRD)
ENDIF
RW(INDR+DHRRAD) = DRIFTR
RW(INDR+DHRERR) = ERRD
IW(INDR+DHRTRN) = 0
INDC = INDC + DTCENCO
INDR = INDR + DHRENCO
ENDDO
C
C Now a bank of pointers will be created, to allow traversing the DTCE,
C DTHA, DHRE banks (if desired) in the order of 1) increasing phi and 2)
C decreasing radius. Many ARGUS original algorythms need this.
C
CALL MAKEDHPT
C
C Now a bank of clusters will be created: this may be useful
CALL MAKEDHCL
C
C This was for real data. For Monte Carlo, we may want to bypass space-time
C inversion, recovering the true drift distance and smearing it somewhat.
C This is done here through the links in DTHA. Later, after construction
C of the DPRS banks, either by a pattern algorythm or by DPRBYPASS,
C the last information (the track candidate) will be added.
IF (MONTECARLO .AND. .NOT. TS_RAWREL) THEN
STATUS = BLOCAT(IW,'DHIT',1,IND,INDDAT)
IF (STATUS.NE.YESUCC) THEN
CALL ERLOGR('DCOEVT',ERWARN,0,STATUS,
+ 'Bank DHIT not found!')
RETURN
ENDIF
DHITNCO = IW(INDDAT+DHINCO)
C
STATUS = BLOCAT(IW,'DTHA',1,INDH,INDDATH)
IF (STATUS.NE.YESUCC) THEN
CALL ERLOGR('DCOEVT',ERWARN,0,STATUS,
+ 'Bank DTHA not found!')
RETURN
ENDIF
INDH = INDDATH + IW(INDDATH+DTHHDS)
C
INDR = INDDATR+IW(INDDATR+DHRHDS)
CALL NORRIN(NRUN,NEV)
DO LOOP=1,NHITC
C
C Recover pointer into DHIT from bank DTHA with index INDH
IHIT = IW(INDH+LOOP-1)
IND = INDDAT + IW(INDDAT+DHIHDS) + (IHIT-1)*DHITNCO
C
C Do a simple smearing of the true distance, starting from d.d.'s in DHIT
CALL RNORML(RAND_R,1)
RW(INDR+DHRRAD) = RW(IND+DHIDIS) + RAND_R(1)*DRFDER
RW(INDR+DHRERR) = DRFDER
INDR = INDR + DHRENCO
ENDDO
ENDIF
C
C Do some control histograms
CALL DCOHIS
C
RETURN
END
C
SUBROUTINE DCORFI
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 DCOFIN
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 DCOBOO
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 =====================
$$INCLUDE 'K$ITRK:CCONST.INC'
C
C External Functions:-
C ====================
C
C Local Declarations:-
C ====================
C
C Executable Code:-
C =================
CALL HBOOK1(1,'Number of DC hits',100,0.,500.,0.)
CALL HBOOK1(2,'Number of DC clusters',100,0.,250.,0.)
CALL HBOOK1(3,'Width of DC clusters',30,0.,30.,0.)
CALL HBOOK2(4,'Phi of DC clusters/layer',50,0.,PI2,60,0.,60.,0.)
CALL HBPRO(0,0.)
C
RETURN
END
C
SUBROUTINE DCOTLK
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
C
RETURN
END
C
SUBROUTINE CLEANUP
C =================
$$IMPLICIT
C
C Description:-
C =============
C This routine is a place where all sort of ugly stuff is segregated
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:BPOYBS.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 'YBOS$LIBRARY:BNKTYP.INC'
$$INCLUDE 'YBOS$LIBRARY:ERRCOD.INC'
$$INCLUDE 'K$INC:ERLEVL.INC'
$$INCLUDE 'K$INC:RUNTYP.INC'
$$INCLUDE 'K$ITRK:CFLAGS.INC'
C
C External Functions:-
C ====================
C
INTEGER GCOUNT
INTEGER BLOCAT,BMAKEG,BDROP
C
C Local Declarations:-
C ====================
C
INTEGER STATUS,IND,INDDAT,INDH,INDDATH
INTEGER I1,I2,IND1,IND2,BLKSIZ,NHITS,NODUP,DTHSIZ
INTEGER ADDR1,ADDR2,ITRA1,ITRA2
INTEGER NAUX
C
REAL TIME1,TIME2
REAL DHITMAX, DIFPMAX
PARAMETER (DHITMAX = 5.5)
PARAMETER (DIFPMAX = 1.)
REAL PREVPT,PREVPZ,PREVP,THISPT,THISPZ,THISP
REAL DHIT2D,DIFPMEV
LOGICAL GAP_IN_SEQ,DIFFMOM
C
C Executable Code:-
C =================
C
STATUS = BLOCAT(IW,'DHIT',1,IND,INDDAT)
IF (STATUS.NE.YESUCC) RETURN
C
NHITS = IW(INDDAT+DHINRO)
BLKSIZ = IW(INDDAT+DHINCO)
IND = INDDAT+IW(INDDAT+DHIHDS)
C
C In the MC data of summer 95 a cleanup was done to eliminate hit duplicates
C in the same cell: only the first hit on the wire was kept when passing
C from DHIT to DTCE. But the bank DTHA, containing pointers from DTCE to DHIT
C was not written. So, for those data only, it has to be done now. To avoid
C scanning hits twice, the number of no-dup hits in DTHA is taken from DTCE.
C NOTE ANYHOW: Since in the summer 95 data the times were wrong, the
C selection of duplicate hits will be more or less random in any case.
C
STATUS = BLOCAT(IW,'DTHA',1,INDH,INDDATH)
IF (STATUS .NE. YESUCC) THEN
STATUS = BLOCAT(IW,'DTCE',1,INDH,INDDATH)
IF (STATUS .NE. YESUCC) THEN
RETURN
ENDIF
NODUP = IW(INDDATH+DTCNRO)
C
C Let's make DTHA and write the header
DTHSIZ = 3 + NODUP
STATUS = BMAKEG(IW,'DTHA',1,DTHSIZ,BNKTI4,INDH,INDDATH)
IF (STATUS .NE. YESUCC) THEN
CALL ERLOGR('CLEANUP',ERWARN,0,STATUS,
+ 'Error creating bank DTHA')
RETURN
ENDIF
IW(INDDATH+DTHHDS) = 3
IW(INDDATH+DTHVRN) = 1
IW(INDDATH+DTHNRO) = NODUP
INDH = INDDATH + IW(INDDATH+DTHHDS)
C
C Now let's scan hits and mark duplicates.
IND = INDDAT + IW(INDDAT+DHIHDS)
DO I1=1,NHITS-1
IND1 = IND + (I1-1)*BLKSIZ
ADDR1 = IW(IND1+DHIADR)
DO I2=I1+1,NHITS
IND2 = IND + (I2-1)*BLKSIZ
ADDR2 = IW(IND2+DHIADR)
IF (ADDR1 .EQ. ADDR2) THEN
TIME1 = ABS(RW(IND1+DHITOF)) + ABS(RW(IND1+DHITIM))
TIME2 = ABS(RW(IND2+DHITOF)) + ABS(RW(IND2+DHITIM))
IF (TIME1.LE.TIME2) THEN
RW(IND2+DHIDIS) = 999999.
ELSE
RW(IND1+DHIDIS) = 999999.
ENDIF
ENDIF
ENDDO
ENDDO
C
C Finally, let's fill in the pointers and check that DTCE and DTHA
C have the same length.
IND = INDDAT + IW(INDDAT+DHIHDS)
DO I1=1,NHITS
IND1 = IND + (I1-1)*BLKSIZ
IF (RW(IND1+DHIDIS) .LT. 999999.) THEN
IW(INDH) = I1
INDH = INDH+1
ENDIF
ENDDO
IF (INDH-INDDATH-IW(INDDATH+DTHHDS) .NE. NODUP) THEN
CALL ERLOGR('CLEANUP',ERWARN,0,STATUS,
+ 'DTCE/DTHA inconsistency')
C
C There is apparently no other clean way to abort this event. So do this!
STATUS = BDROP(IW,'DTCE')
RETURN
ENDIF
ENDIF
C
C If the user requested DPRBYPASS to run, still more cleanup has to be made
C to separate hits belonging to tracks from nuclear interactions and to
C tracks passing through a wall. This separation is made incrementing the
C pointer to KINE beyond the total number of KINE tracks: ATTENTION!
IF (.NOT. PTRN_REC) THEN
NAUX = GCOUNT(KINE)
IND1 = INDDAT+IW(INDDAT+DHIHDS)
DO I1=1,NHITS-1
ITRA1 = IW(IND1+DHITRA)
IND2 = IND1+BLKSIZ
ITRA2 = IW(IND2+DHITRA)
IF (ITRA1.EQ.ITRA2) THEN
DHIT2D = SQRT((RW(IND2+DHIXCO)-RW(IND1+DHIXCO))**2+
+ (RW(IND2+DHIYCO)-RW(IND1+DHIYCO))**2+
+ 0.0001)
PREVPT = SQRT(RW(IND1+DHIPPX)**2 + RW(IND1+DHIPPY)**2)
THISPT = SQRT(RW(IND2+DHIPPX)**2 + RW(IND2+DHIPPY)**2)
PREVPZ = RW(IND1+DHIPPZ)
THISPZ = RW(IND2+DHIPPZ)
PREVP = SQRT(PREVPT**2 + PREVPZ**2)
THISP = SQRT(THISPT**2 + THISPZ**2)
DIFPMEV= THISP-PREVP
GAP_IN_SEQ = DHIT2D.GT.DHITMAX
DIFFMOM = ABS(DIFPMEV).GT.DIFPMAX
IF (GAP_IN_SEQ .OR. DIFFMOM) THEN
NAUX = NAUX+1
DO WHILE (IW(IND2+DHITRA) .EQ. ITRA2)
IW(IND2+DHITRA) = NAUX
IND2 = IND2+BLKSIZ
ENDDO
ENDIF
ENDIF
IND1 = IND1 + BLKSIZ
ENDDO
ENDIF
C
RETURN
END
C
C
SUBROUTINE CLEANUP_DATA
C =======================
$$IMPLICIT
C
C Description:-
C =============
C This routine is a place where all sort of ugly stuff is segregated
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:BPOYBS.INC'
$$INCLUDE 'YBOS$LIBRARY:ERRCOD.INC'
$$INCLUDE 'K$INC:ERLEVL.INC'
$$INCLUDE 'K$ITRK:CFLAGS.INC'
C
C External Functions:-
C ====================
C
INTEGER BLOCAT,BDROP
C
C Local Declarations:-
C ====================
C
INTEGER STATUS,IND,INDDAT
INTEGER I1,I2,IND1,IND2,BLKSIZ,NHITS
INTEGER ADDR1,ADDR2,LOOP,NSHIFT
C
C
C Executable Code:-
C =================
C
STATUS = BLOCAT(IW,'DTCE',1,IND,INDDAT)
IF (STATUS.NE.YESUCC) RETURN
C
NHITS = IW(INDDAT+DTCNRO)
BLKSIZ = IW(INDDAT+DTCNCO)
IND = INDDAT+IW(INDDAT+DTCHDS)
C
C The ARGUS pattern recognition code can go belly-up if duplicate hits
C are found in the same cell: this may happen by bugs either in the MC
C generation or in the online software. The solution to this problem is to
C suppress the SECOND hit(s) and proceed, but it is important to scream
C our disappointment: so please nobody suppress the call to ERLOGR!.
C .AC 1/15/97
C NOTE: in the MC case, to avoid the reshuffling of banks DTHA and DTKA,
C which should remain aligned to DTCE, for now I just suppress the
C whole event, by dropping DTCE.
IND1 = IND
I1 = 1
DO WHILE (I1 .LE. NHITS-1)
IND1 = IND + (I1-1)*BLKSIZ
ADDR1 = IW(IND1+DTCADR)
I2 = I1+1
DO WHILE (I2 .LE. NHITS)
IND2 = IND + (I2-1)*BLKSIZ
ADDR2 = IW(IND2+DTCADR)
IF (ADDR1 .EQ. ADDR2) THEN
CALL ERLOGR('CLNDTA',ERWARN,0,STATUS,
+ 'Duplicate hit rejected!')
IF (MONTECARLO) THEN
CALL ERLOGR('CLNDTA',ERWARN,0,STATUS,
+ 'Event dropped!')
STATUS = BDROP(IW,'DTCE')
RETURN
ELSE
C Shift down all subsequent hits in the bank DTCE
NSHIFT = (NHITS-I2)*BLKSIZ
DO LOOP=0,NSHIFT-1
IW(IND2+LOOP) = IW(IND2+LOOP+BLKSIZ)
ENDDO
C Zero-bomb the gap at the end (to shorten the bank is hard...)
DO LOOP=0,BLKSIZ-1
IW(IND2+NSHIFT+LOOP) = 0
ENDDO
C Reduce NHITS both in this loop and in bank DTCE
NHITS = NHITS-1
IW(INDDAT+DTCNRO) = IW(INDDAT+DTCNRO)-1
C Reduce the running index to re-scan the new hit
I2 = I2-1
ENDIF
ENDIF
I2 = I2 + 1
ENDDO
I1 = I1+1
ENDDO
C
RETURN
END
C
*******************************************************************************
SUBROUTINE MAKEDHPT
$$IMPLICIT
*******************************************************************************
C
C Author: A. Calcaterra
C =======
C
C Date: 30 Apr. 96
C ====
C
$$INCLUDE 'K$INC:BCS.INC'
$$INCLUDE 'K$INC:BPOYBS.INC'
$$INCLUDE 'YBOS$LIBRARY:BNKTYP.INC'
$$INCLUDE 'YBOS$LIBRARY:ERRCOD.INC'
$$INCLUDE 'K$INC:ERLEVL.INC'
$$INCLUDE 'K$ITRK:DHPT.INC'
C
C External Functions:-
C ====================
C
INTEGER BLOCAT,BMAKEG,WBANK,WDATA,WDROP
C
C Local Declarations:-
C ====================
C
INTEGER STATUS,INDC,INDDATC,NHITC,DTCENCO
INTEGER INDP,INDDATP,INDTMP,INDDATTMP
INTEGER BNKSIZ,LOOP,KPLA,KWIR,KPLPRV,KPLCUR,DHPBPT
C
C Locate bank DTCE
STATUS = BLOCAT(IW,'DTCE',1,INDC,INDDATC)
IF (STATUS.NE.YESUCC) THEN
CALL ERLOGR('MKDHPT',ERWARN,0,STATUS,
+ 'Missing bank DTCE')
RETURN
ENDIF
NHITC = IW(INDDATC+DTCNRO)
DTCENCO = IW(INDDATC+DTCNCO)
C
C Now a bank of pointers will be created, to allow traversing the DTCE,
C DTHA, DHRE banks (if desired) in the order of 1) increasing phi and 2)
C decreasing radius. Many ARGUS original algorythms need this.
C The bank contains:
C
C 0) A 3-word header
C A) 58 pointers to the FIRST hit in every layer, to be used in part C)
C B) 58 pointers to the LAST hit in every layer, to be used in part C)
C C) the pointers themselves, to be used in DHRE.
C D) the back-pointers, to be used in part C).
C
BNKSIZ = 2 + 116 + 2*NHITC
STATUS = BMAKEG(IW,'DHPT',1,BNKSIZ,BNKTI4,INDP,INDDATP)
IF (STATUS.NE.YESUCC) THEN
CALL ERLOGR('MKDHPT',ERWARN,0,STATUS,
+ 'Error creating bank DHPT!')
RETURN
ENDIF
C
C Fill the header of DHPT .....
IW(INDDATP+DHPHDS) = 2
IW(INDDATP+DHPVRN) = 1
INDP = INDDATP+IW(INDDATP+DHPHDS)
DHPBPT = DHPAPT+NHITC
C
C Create a working bank for sorting points
INDTMP = 0
STATUS = WBANK(IW,INDTMP,NHITC)
IF (STATUS.NE.YESUCC) THEN
CALL ERLOGR('MKDHPT',ERWARN,0,STATUS,
+ 'Error creating temporary bank !')
RETURN
ENDIF
STATUS = WDATA(IW,INDTMP,INDDATTMP)
C
INDC = INDDATC+IW(INDDATC+DTCHDS)
DO LOOP=0,NHITC-1
KPLA = IW(INDC+DTCADR)/2**9
KWIR = IW(INDC+DTCADR) - KPLA*2**9
KPLA = 59-KPLA
IW(INDDATTMP+LOOP) = KPLA*2**9 + KWIR
INDC = INDC + DTCENCO
ENDDO
C
C Do the sorting, from the temporary bank directly into DHPT
CALL SORTZV(IW(INDDATTMP),IW(INDP+DHPAPT),NHITC,-1,0,0)
C
C The pointers are made. Now build the (first,last) pairs
DO LOOP=0,57
IW(INDP+DHPPT1+LOOP) = 0
IW(INDP+DHPPTL+LOOP) =-1
ENDDO
KPLPRV = 0
DO LOOP = 0,NHITC-1
KPLCUR = IW(INDDATTMP+IW(INDP+DHPAPT+LOOP)-1)/2**9
IF (KPLCUR.EQ.KPLPRV)THEN
IW(INDP+DHPPTL+KPLCUR-1) = LOOP+1
ELSEIF (KPLCUR.LE.58) THEN
IW(INDP+DHPPT1+KPLCUR-1) = LOOP+1
IW(INDP+DHPPTL+KPLCUR-1) = LOOP+1
KPLPRV = KPLCUR
ENDIF
ENDDO
C
C Fill the back-pointers, needed in DFNEWW
DO LOOP = 0,NHITC-1
IW(INDP+DHPBPT+IW(INDP+DHPAPT+LOOP)-1) = LOOP+1
ENDDO
C
C Drop the intermediate bank
STATUS = WDROP(IW,INDTMP,1)
C
RETURN
END
*******************************************************************************
SUBROUTINE MAKEDHCL
$$IMPLICIT
*******************************************************************************
C
C Author: A. Calcaterra
C =======
C
C Date: 20 Nov. 96
C ====
C
$$INCLUDE 'K$INC:BCS.INC'
$$INCLUDE 'K$INC:BPOYBS.INC'
$$INCLUDE 'YBOS$LIBRARY:BNKTYP.INC'
$$INCLUDE 'YBOS$LIBRARY:ERRCOD.INC'
$$INCLUDE 'K$INC:ERLEVL.INC'
$$INCLUDE 'K$ITRK:CCONST.INC'
$$INCLUDE 'K$ITRK:CTIDRI.INC'
$$INCLUDE 'K$ITRK:DHPT.INC'
$$INCLUDE 'K$ITRK:DHCL.INC'
C
C External Functions:-
C ====================
C
INTEGER BLOCAT,BTYMKG
C
C Local Declarations:-
C ====================
C
LOGICAL ONCE,DISAST
INTEGER STATUS,INDC,INDDATC,NHITC,DTCENCO
INTEGER INDP,INDDATP,INDL,INDDATL,DHCENCO
INTEGER BNKSIZ,LOOP,LAYER,LFRST,LLAST
INTEGER INDAR,INDTC,KWIPRV,KWICUR,INCLUS,NCLTOT
INTEGER PTLINK,PTLNK1,PTLNKL
INTEGER IND1ST,KWI1ST,INDLST,KWILST,INCLS1,INCLSL
INTEGER SHIFT,START1,START2,START3
REAL*4 PHICLS,PHILST,PHI1ST
C
CHARACTER*32 BNKTYP
DATA BNKTYP/'120I4,XXXXX(R4,2I4)'/
C
C Locate bank DTCE
STATUS = BLOCAT(IW,'DTCE',1,INDC,INDDATC)
IF (STATUS.NE.YESUCC) THEN
CALL ERLOGR('MKDHCL',ERWARN,0,STATUS,
+ 'Missing bank DTCE')
RETURN
ENDIF
NHITC = IW(INDDATC+DTCNRO)
DTCENCO = IW(INDDATC+DTCNCO)
C
C Locate bank DHPT
STATUS = BLOCAT(IW,'DHPT',1,INDP,INDDATP)
IF (STATUS.NE.YESUCC) THEN
CALL ERLOGR('MKDHCL',ERWARN,0,STATUS,
+ 'Error creating bank DHPT!')
RETURN
ENDIF
C
C Make bank DHCL, allowing space for NHITC clusters (cannot be more!)
C The bank contains:
C
C 0) A 4-word header
C A) 58 pointers to the FIRST cluster in every layer, to be used in part C)
C B) 58 pointers to the LAST cluster in every layer, to be used in part C)
C C) 3 infos for every cluster: average phi, cluster size and the pointer
C to the first hit
WRITE (BNKTYP(7:11),'(I5)') NHITC
STATUS = BTYMKG(IW,'DHCL',1,BNKTYP,BNKSIZ,INDL,INDDATL)
IF (STATUS.NE.YESUCC) THEN
CALL ERLOGR('MKDHCL',ERWARN,0,STATUS,
+ 'Error creating bank DHCL!')
RETURN
ENDIF
C
C Fill the header of DHCL .....
IW(INDDATL+DHCHDS) = 4
IW(INDDATL+DHCVRN) = 1
IW(INDDATL+DHCNRO) = 0
IW(INDDATL+DHCNCO) = 3
DHCENCO = IW(INDDATL+DHCNCO)
C
C Scan DTCE in the ARGUS order, given in DHPT
INDC = INDDATC+IW(INDDATC+DTCHDS)
INDP = INDDATP+IW(INDDATP+DHPHDS)
INDL = INDDATL+IW(INDDATL+DHCHDS)
NCLTOT = 0
DO LAYER=1,58
C
C First, set the pointers to the first and last cluster in this plane
IW(INDL+DHCPT1+LAYER-1) = 0
IW(INDL+DHCPTL+LAYER-1) =-1
LFRST = IW(INDP+DHPPT1+LAYER-1)
LLAST = IW(INDP+DHPPTL+LAYER-1)
KWIPRV = -999
ONCE = .TRUE.
DO LOOP = LFRST,LLAST
INDAR = IW(INDP+DHPAPT+LOOP-1)
INDTC = INDC+(INDAR-1)*DTCENCO
KWICUR = IW(INDTC+DTCADR) - (59-LAYER)*2**9
C
C At the first iteration, open the cluster in any case
IF (LOOP .EQ. LFRST) THEN
INCLUS = 1
PHICLS = (KWICUR-1)*TIDDP(LAYER)
PTLINK = INDAR
ELSE
C
C Look if the old cluster is still running (n.wire increased by one)
IF (KWICUR .EQ. KWIPRV+1) THEN
INCLUS = INCLUS+1
PHICLS = PHICLS+0.5*TIDDP(LAYER)
ELSE
C
C If there is a gap in the sequence, close the cluster and open a new one.
NCLTOT = NCLTOT+1
IW(INDL+DHCPTL+LAYER-1) = NCLTOT
RW(INDL+DHCDTA+(NCLTOT-1)*DHCENCO+DHCAVF) = PHICLS
IW(INDL+DHCDTA+(NCLTOT-1)*DHCENCO+DHCNCL) = INCLUS
IW(INDL+DHCDTA+(NCLTOT-1)*DHCENCO+DHCLNK) = PTLINK
C
C Store the pointer to the first cluster only once for every layer
IF (ONCE) THEN
IW(INDL+DHCPT1+LAYER-1) = NCLTOT
ONCE = .FALSE.
ENDIF
C
C Open a new cluster
INCLUS = 1
PHICLS = (KWICUR-1)*TIDDP(LAYER)
PTLINK = INDAR
ENDIF
ENDIF
KWIPRV = KWICUR
ENDDO
C
C If the above loop executed at all, the last cluster is open: so, close it
IF (LLAST .GE. LFRST) THEN
NCLTOT = NCLTOT+1
IF (ONCE) IW(INDL+DHCPT1+LAYER-1) = NCLTOT
IW(INDL+DHCPTL+LAYER-1) = NCLTOT
RW(INDL+DHCDTA+(NCLTOT-1)*DHCENCO+DHCAVF) = PHICLS
IW(INDL+DHCDTA+(NCLTOT-1)*DHCENCO+DHCNCL) = INCLUS
IW(INDL+DHCDTA+(NCLTOT-1)*DHCENCO+DHCLNK) = PTLINK
ENDIF
C
C Now check if two clusters join at phi=0! This is QUITE annoying.
IF (LLAST .GT. LFRST) THEN
IND1ST = IW(INDP+DHPAPT+LFRST-1)
IND1ST = INDC+(IND1ST-1)*DTCENCO
KWI1ST = IW(IND1ST+DTCADR) - (59-LAYER)*2**9
C
C This may ONLY happen if the 1st wire is n.1, and the last wire...the last!
IF (KWI1ST .EQ. 1) THEN
INDLST = IW(INDP+DHPAPT+LLAST-1)
INDLST = INDC+(INDLST-1)*DTCENCO
KWILST = IW(INDLST+DTCADR) - (59-LAYER)*2**9
PHILST = (KWILST-1)*TIDDP(LAYER)
C
C Let us add one more cell, see if we arrive to 6.28
DISAST = ABS(PHILST+TIDDP(LAYER)-PI2) .LT. 1.E-5
IF (DISAST) THEN
C
C And here falls the donkey...let's find out where the average phi is.
IND1ST = IW(INDL+DHCPT1+LAYER-1)
PHI1ST = RW(INDL+DHCDTA+(IND1ST-1)*DHCENCO+DHCAVF)
INCLS1 = IW(INDL+DHCDTA+(IND1ST-1)*DHCENCO+DHCNCL)
PTLNK1 = IW(INDL+DHCDTA+(IND1ST-1)*DHCENCO+DHCLNK)
INDLST = IW(INDL+DHCPTL+LAYER-1)
PHILST = RW(INDL+DHCDTA+(INDLST-1)*DHCENCO+DHCAVF)
INCLSL = IW(INDL+DHCDTA+(INDLST-1)*DHCENCO+DHCNCL)
PTLNKL = IW(INDL+DHCDTA+(INDLST-1)*DHCENCO+DHCLNK)
IF (INCLS1 .GT. INCLSL) THEN
C
C The 1st cluster wins, so just kill the last one, and fix the 1st one.
NCLTOT = NCLTOT-1
IW(INDL+DHCPTL+LAYER-1) = NCLTOT
RW(INDL+DHCDTA+(IND1ST-1)*DHCENCO+DHCAVF) =
+ (INCLS1-INCLSL-1)*TIDDP(LAYER)/2.
IW(INDL+DHCDTA+(IND1ST-1)*DHCENCO+DHCNCL) = INCLS1+INCLSL
IW(INDL+DHCDTA+(IND1ST-1)*DHCENCO+DHCLNK) = PTLNKL
ELSE
C
C This is a... a... a MESS! Kill the FIRST cluster, shift everyone down!
SHIFT = INDLST-IND1ST
START1 = INDL+DHCDTA+(IND1ST-1)*DHCENCO+DHCAVF
START2 = INDL+DHCDTA+(IND1ST-1)*DHCENCO+DHCNCL
START3 = INDL+DHCDTA+(IND1ST-1)*DHCENCO+DHCLNK
DO LOOP=1,SHIFT
RW(START1) = RW(START1+DHCENCO)
IW(START2) = IW(START2+DHCENCO)
IW(START3) = IW(START3+DHCENCO)
START1 = START1+DHCENCO
START2 = START2+DHCENCO
START3 = START3+DHCENCO
ENDDO
C
C Youpi... now fix the last cluster, possibly in the right place.
NCLTOT = IW(INDL+DHCPTL+LAYER-1)-1
IW(INDL+DHCPTL+LAYER-1) = NCLTOT
RW(INDL+DHCDTA+(NCLTOT-1)*DHCENCO+DHCAVF) =
+ PI2 - (INCLSL-INCLS1+1)*TIDDP(LAYER)/2.
IW(INDL+DHCDTA+(NCLTOT-1)*DHCENCO+DHCNCL) = INCLS1+INCLSL
IW(INDL+DHCDTA+(NCLTOT-1)*DHCENCO+DHCLNK) = PTLNKL
ENDIF
ENDIF
ENDIF
ENDIF
C
ENDDO
C
C Save the total n. of clusters, get outa here.
IW(INDDATL+DHCNRO) = NCLTOT
C
RETURN
END
*******************************************************************************
INTEGER FUNCTION RAWST(KEY14,DRIFTT,DRIFTR,ERRD)
*******************************************************************************
C
C Description:
C ============
C Function which translates the measured drift time
C in a drift distance using the raw cell response
C parametrizations, and assigns the raw error to DRIFTR
C
C Input Parameter
C ==============
C INTEGER KEY14 ! key to select the parametrizations:
C ! KEY14 = 2 cells 2X2 cm2
C ! KEY14 = 3 cells 3X3 cm2
C REAL*4 DRIFTT ! measured drift time in [ns]
C
C Output parameter
C ================
C REAL*4 DRIFTR ! raw drift distance in [cm]
C REAL*4 ERRD ! raw error on DRIFTR in [cm]
C
C Author: P. de Simone
C =======
C
C Date: 15-1-96
C ====
C
$$IMPLICIT
C
INTEGER KEY14
REAL*4 DRIFTT, DRIFTR, ERRD
C
REAL*4 U2_0, U2_LINEAR, U2_QUAD
REAL*4 W3_0, W3_LINEAR, W3_QUAD
REAL*4 RAWS_2, RAWS_3
C
COMMON/RAWPAR/U2_0, U2_LINEAR, U2_QUAD,
& W3_0, W3_LINEAR, W3_QUAD
COMMON/RAWSIG/ RAWS_2(15), RAWS_3(15)
C
INTEGER I,STATUS
REAL*4 RADICE
C
STATUS = 0
C
C 2X2 raw cell parametrizations
C
IF (KEY14.EQ.2) THEN
C
RADICE = U2_LINEAR*U2_LINEAR - 4.*U2_QUAD*(U2_0 - DRIFTT)
IF ( RADICE.LE.1.E-8 ) THEN
DRIFTR = U2_0
ELSE
DRIFTR = (- U2_LINEAR + SQRT(RADICE))/(2.*U2_QUAD)
ENDIF
IF (DRIFTR.LE.0.) DRIFTR = 0.0020
C
DO I = 1,13,2
IF( (DRIFTR.GE.RAWS_2(I).AND.DRIFTR.LT.RAWS_2(I+2)).OR.
& (DRIFTR.GE.RAWS_2(15).AND.I.EQ.13) ) THEN
ERRD = RAWS_2(I+1)/10000.
ENDIF
ENDDO
C
ENDIF
C
C 3X3 raw cell parametrizations
C
IF (KEY14.EQ.3) THEN
C
RADICE = W3_LINEAR*W3_LINEAR - 4.*W3_QUAD*(W3_0 - DRIFTT)
IF ( RADICE.LE.1.E-8 ) THEN
DRIFTR = W3_0
ELSE
DRIFTR = (- W3_LINEAR + SQRT(RADICE))/(2.*W3_QUAD)
ENDIF
IF (DRIFTR.LE.0.) DRIFTR = 0.0020
C
DO I = 1,13,2
IF( (DRIFTR.GE.RAWS_3(I).AND.DRIFTR.LT.RAWS_3(I+2)).OR.
& (DRIFTR.GE.RAWS_3(15).AND.I.EQ.13) ) THEN
ERRD = RAWS_3(I+1)/10000.
ENDIF
ENDDO
C
ENDIF
C
RAWST = STATUS
C
RETURN
END
C
*******************************************************************************
REAL FUNCTION FINEST(KEY14,DRIFTT,BETA,PHI,DRIFTR,ERRD)
*******************************************************************************
C
C Description:
C ============
C Routine which translates the measured drift time
C in a drift distance using the fine cell response
C parametrizations, and assigns the raw error to DRIFTR
C
C Input Parameter
C ==============
C INTEGER KEY14 ! key to select the parametrizations:
C ! KEY14 = 2 cells 2X2 cm2
C ! KEY14 = 3 cells 3X3 cm2
C REAL*4 DRIFTT ! measured drift time in [ns]
C REAL*4 BETA ! angle in degrees which identifies the
C ! shape of the hitted cell
C REAL*4 PHI ! angle in degrees which gives the
C ! orientation of the point of closest approach
C ! in the local cell reference system
C
C Output parameter
C ================
C REAL*4 DRIFTR ! raw drift distance in [cm]
C REAL*4 ERRD ! raw error on DRIFTR in [cm]
C ********************************************************************
C Returned value of ERRD : if DRIFTR < R_LIMIT --> ERRD from physical
C sigma parametrization
C if DRIFTR > R_LIMIT --> ERRD from raw sigma
C table
C ********************************************************************
C Returned value of FINEST : FINEST = 0. --> DRIFTR from fine
C parametrizations and
C ERRD from physical sigma
C parametrization
C FINEST = 1. --> DRIFTR from fine
C parametrizations and
C ERRD from raw sigma table
C FINEST = 2. --> DRIFTR from raw
C parametrization and
C ERRD from raw sigma table
C
C Author: P. de Simone
C =======
C
C Date: 15-1-96
C ====
C
$$IMPLICIT
C
C Function declaration
C =====================
REAL FUNCTINV
REAL SIGMA
REAL RAWST
C
C Local declaration
C ==================
INTEGER KEY14
INTEGER IBE, IPHI
REAL*4 DRIFTT, DRIFTR, ERRD
REAL*4 BETA, PHI
REAL*4 R_LIMIT
REAL*4 STATUS
C
C Global declaration
C ====================
REAL*4 RAWS_2, RAWS_3
REAL*4 WA1, WA2, WA3, WA4, WA5, RRLA
REAL*4 UA1, UA2, UA3, UA4, UA5, RLA
C
COMMON/RAWSIG/ RAWS_2(15), RAWS_3(15)
COMMON/PARAMETRI3/WA1(6,36),WA2(6,36),WA3(6,36),
+ WA4(6,36),WA5(6,36),RRLA(6,36)
COMMON/PARAMETRI2/UA1(6,36),UA2(6,36),UA3(6,36),
+ UA4(6,36),UA5(6,36),RLA(6,36)
C
IF (( BETA.GT.115. ).AND.( BETA.LE.130. )) THEN
IBE = 6
ELSEIF (( BETA.GE.65. ).AND.( BETA.LE.115. )) THEN
IBE = INT((BETA-65.)/10.) + 1
ENDIF
C
IPHI = INT(PHI/10.) + 1
C
DRIFTR = FUNCTINV(DRIFTT,KEY14,IPHI,IBE)
C
IF( DRIFTR.EQ.9999. ) THEN
STATUS = RAWST(KEY14,DRIFTT,DRIFTR,ERRD)
FINEST = 2.
RETURN
ENDIF
C
ERRD = SIGMA(DRIFTR,KEY14)
C
IF ( KEY14.EQ.2 ) THEN
R_LIMIT = RLA(IBE,IPHI)
ELSE
R_LIMIT = RRLA(IBE,IPHI)
ENDIF
C
IF( DRIFTR.LE.R_LIMIT ) THEN
FINEST = 0.
ELSE
FINEST = 1.
ENDIF
C
RETURN
END
C
C----------------------------------------------------------
REAL FUNCTION FUNCTINV(DRIFTT,KEY14,IPHI,IBE)
C----------------------------------------------------------
C The original form of the polynomials, "contracted" here to save CPU time,
C was like this:
C
C FITDR = UA1(IBE,IPHI)*1. +
C + UA2(IBE,IPHI)*( 2.*A - 1.) +
C + UA3(IBE,IPHI)*( 8.*A*A - 8.*A + 1.) +
C + UA4(IBE,IPHI)*( 32.*A*A*A - 48.*A*A + 18.*A -1.) +
C + UA5(IBE,IPHI)*( 128.*A*A*A*A - 256.*A*A*A +
C + 160.*A*A - 32.*A + 1.)
C
$$IMPLICIT
REAL*4 DRIFTT
INTEGER KEY14, IPHI, IBE
C
REAL*4 RLO,RHI,RMID,STEP,TLO,THI,TMID,RR
REAL*4 KDIFF, LAMBDA, SIG_TD
COMMON/FINESIG/ KDIFF, LAMBDA, SIG_TD
C
REAL*4 A,A2,A3,A4
REAL*4 UA1, UA2, UA3, UA4, UA5, RLA
REAL*4 WA1, WA2, WA3, WA4, WA5, RRLA
COMMON/PARAMETRI3/WA1(6,36),WA2(6,36),WA3(6,36),
+ WA4(6,36),WA5(6,36),RRLA(6,36)
COMMON/PARAMETRI2/UA1(6,36),UA2(6,36),UA3(6,36),
+ UA4(6,36),UA5(6,36),RLA(6,36)
REAL*4 CWA,CUA
COMMON/STCOEFFS/CWA(5,6,36),CUA(5,6,36)
C
IF ( KEY14.EQ.2 ) THEN
RLO = 0.
TLO = CUA(1,IBE,IPHI)
RHI = 1.4
A = RHI/RLA(IBE,IPHI)
A2 = A*A
A3 = A2*A
A4 = A3*A
THI = CUA(1,IBE,IPHI)+CUA(2,IBE,IPHI)*A+CUA(3,IBE,IPHI)*A2
+ +CUA(4,IBE,IPHI)*A3+CUA(5,IBE,IPHI)*A4
STEP = RHI/2.
IF (DRIFTT.LT.TLO) THEN
RR = RLO
ELSEIF (DRIFTT.LT.THI) THEN
DO WHILE (STEP.GT.0.0010)
RMID = RLO + STEP
A = RMID/RLA(IBE,IPHI)
A2 = A*A
A3 = A2*A
A4 = A3*A
TMID = CUA(1,IBE,IPHI)+CUA(2,IBE,IPHI)*A+CUA(3,IBE,IPHI)*A2
+ +CUA(4,IBE,IPHI)*A3+CUA(5,IBE,IPHI)*A4
IF (DRIFTT.GT.TMID) RLO = RMID
STEP = STEP/2.
ENDDO
RR = RLO + STEP/2.
ELSE
RR = -9999.
ENDIF
ELSEIF ( KEY14.EQ.3 ) THEN
RLO = 0.
TLO = CWA(1,IBE,IPHI)
RHI = 2.1
A = RHI/RRLA(IBE,IPHI)
A2 = A*A
A3 = A2*A
A4 = A3*A
THI = CWA(1,IBE,IPHI)+CWA(2,IBE,IPHI)*A+CWA(3,IBE,IPHI)*A2
+ +CWA(4,IBE,IPHI)*A3+CWA(5,IBE,IPHI)*A4
STEP = RHI/2.
IF (DRIFTT.LT.TLO) THEN
RR = RLO
ELSEIF (DRIFTT.LT.THI) THEN
DO WHILE (STEP.GT.0.0010)
RMID = RLO + STEP
A = RMID/RRLA(IBE,IPHI)
A2 = A*A
A3 = A2*A
A4 = A3*A
TMID = CWA(1,IBE,IPHI)+CWA(2,IBE,IPHI)*A+CWA(3,IBE,IPHI)*A2
+ +CWA(4,IBE,IPHI)*A3+CWA(5,IBE,IPHI)*A4
IF (DRIFTT.GT.TMID) RLO = RMID
STEP = STEP/2.
ENDDO
RR = RLO + STEP/2.
ELSE
RR = -9999.
ENDIF
ENDIF
C
IF( RR.EQ.-9999. ) THEN
FUNCTINV = 9999.
ELSEIF( RR.GT.LAMBDA ) THEN
FUNCTINV = SQRT(RR*RR - LAMBDA*LAMBDA)
ELSE
FUNCTINV = RR
ENDIF
C
RETURN
END
C
C-------------------------------------------------------------
REAL FUNCTION FITDR(R,KEY14,IPHI,IBE)
C-------------------------------------------------------------
C
$$IMPLICIT
C
INTEGER KEY14,IPHI,IBE
REAL*4 A,R
REAL*4 UA1, UA2, UA3, UA4, UA5, RLA
REAL*4 WA1, WA2, WA3, WA4, WA5, RRLA
COMMON/PARAMETRI3/WA1(6,36),WA2(6,36),WA3(6,36),
+ WA4(6,36),WA5(6,36),RRLA(6,36)
COMMON/PARAMETRI2/UA1(6,36),UA2(6,36),UA3(6,36),
+ UA4(6,36),UA5(6,36),RLA(6,36)
C
C choose the space time relation 3X3 case
C
IF(KEY14.EQ.3) THEN
A = R/RRLA(IBE,IPHI)
FITDR = WA1(IBE,IPHI)*1. +
+ WA2(IBE,IPHI)*( 2.*A - 1.) +
+ WA3(IBE,IPHI)*( 8.*A*A - 8.*A + 1.) +
+ WA4(IBE,IPHI)*( 32.*A*A*A - 48.*A*A + 18.*A -1.) +
+ WA5(IBE,IPHI)*( 128.*A*A*A*A - 256.*A*A*A +
+ 160.*A*A - 32.*A + 1.)
ELSE
C
C 2X2 case
C
A = R/RLA(IBE,IPHI)
FITDR = UA1(IBE,IPHI)*1. +
+ UA2(IBE,IPHI)*( 2.*A - 1.) +
+ UA3(IBE,IPHI)*( 8.*A*A - 8.*A + 1.) +
+ UA4(IBE,IPHI)*( 32.*A*A*A - 48.*A*A + 18.*A -1.) +
+ UA5(IBE,IPHI)*( 128.*A*A*A*A - 256.*A*A*A +
+ 160.*A*A - 32.*A + 1.)
ENDIF
C
RETURN
END
C
C-------------------------------------------------------------
REAL FUNCTION FITDRDT(R,KEY14,IPHI,IBE)
C-------------------------------------------------------------
C
$$IMPLICIT
C
INTEGER KEY14,IPHI,IBE
REAL*4 A,R
REAL*4 UA1, UA2, UA3, UA4, UA5, RLA
REAL*4 WA1, WA2, WA3, WA4, WA5, RRLA
COMMON/PARAMETRI3/WA1(6,36),WA2(6,36),WA3(6,36),
+ WA4(6,36),WA5(6,36),RRLA(6,36)
COMMON/PARAMETRI2/UA1(6,36),UA2(6,36),UA3(6,36),
+ UA4(6,36),UA5(6,36),RLA(6,36)
C
C choose the space time relation 3X3 case
C
IF(KEY14.EQ.3) THEN
A = R/RRLA(IBE,IPHI)
FITDRDT= WA2(IBE,IPHI)*( 2.) +
+ WA3(IBE,IPHI)*( 16.*A - 8.) +
+ WA4(IBE,IPHI)*( 96.*A*A - 96.*A + 18.) +
+ WA5(IBE,IPHI)*( 512.*A*A*A - 768.*A*A +
+ 320.*A - 32.)
FITDRDT= FITDRDT/RRLA(IBE,IPHI)
ELSE
C
C 2X2 case
C
A = R/RLA(IBE,IPHI)
FITDRDT= UA2(IBE,IPHI)*( 2.) +
+ UA3(IBE,IPHI)*( 16.*A - 8.) +
+ UA4(IBE,IPHI)*( 96.*A*A - 96.*A + 18.) +
+ UA5(IBE,IPHI)*( 512.*A*A*A - 768.*A*A +
+ 320.*A - 32.)
FITDRDT= FITDRDT/RRLA(IBE,IPHI)
ENDIF
C
RETURN
END
C
C-----------------------------------------------------
REAL FUNCTION SIGMA(X,KEY14)
C------------------------------------------------------
C
$$IMPLICIT
C
C Function declaration
C =====================
C
INTEGER KEY14,BIN
REAL*4 X
REAL*4 A, B
REAL*4 KDIFF, LAMBDA, SIG_TD
REAL*4 U2_0, U2_LINEAR, U2_QUAD
REAL*4 W3_0, W3_LINEAR, W3_QUAD
C
COMMON/FINESIG/ KDIFF, LAMBDA, SIG_TD
COMMON/RAWPAR/U2_0, U2_LINEAR, U2_QUAD,
& W3_0, W3_LINEAR, W3_QUAD
REAL*4 SIGPIT,RSTEP
COMMON/SIGPIT/SIGPIT(1500),RSTEP
C
IF( KEY14.EQ.2 ) THEN
A = U2_LINEAR
B = U2_QUAD
ELSE
A = W3_LINEAR
B = W3_QUAD
ENDIF
C
BIN = INT(0.5+(X/RSTEP))
IF (BIN.LT.1) BIN = 1
IF (BIN.GT.1500) BIN = 1500
SIGMA = 0
& +KDIFF*X
& +SIGPIT(BIN)
& +(SIG_TD/(A+2.*B*X))**2
C
SIGMA = SQRT(SIGMA)
C
RETURN
END
C
C=======================================================================
C
SUBROUTINE DCOHIS
$$IMPLICIT
C----------------------------------------------------------------------
C-
C- Purpose and Methods : Do some control histograms.
C-
C----------------------------------------------------------------------
$$INCLUDE 'K$INC:BCS.INC'
$$INCLUDE 'K$INC:BPOYBS.INC'
$$INCLUDE 'YBOS$LIBRARY:ERRCOD.INC'
C
$$INCLUDE 'K$ITRK:DHCL.INC'
C
INTEGER BLOCAT
INTEGER STATUS,INDC,INDDATC,INDL,INDDATL
INTEGER NCLTOT,DHCENCO,LAYER,LOOP,LFRST,LLAST
INTEGER NINCLS
REAL*4 PHIAVE
C
C Start locating bank DTCE
STATUS = BLOCAT(IW,'DTCE',1,INDC,INDDATC)
IF (STATUS .NE. YESUCC) THEN
RETURN
ENDIF
C
C Histogram the total n.of hits in the DC
CALL HFILL(1,FLOAT(IW(INDDATC+DTCNRO)),0.,1.)
C
C Now go find bank DHCL
STATUS = BLOCAT(IW,'DHCL',1,INDL,INDDATL)
IF (STATUS .NE. YESUCC) THEN
RETURN
ENDIF
NCLTOT = IW(INDDATL+DHCNRO)
DHCENCO = IW(INDDATL+DHCNCO)
C
C Histogram the total n.of clusters in the DC
CALL HFILL(2,FLOAT(NCLTOT),0.,1.)
C
INDL = INDDATL+IW(INDDATL+DHCHDS)
DO LAYER=1,58
LFRST = IW(INDL+DHCPT1+(LAYER-1))
LLAST = IW(INDL+DHCPTL+(LAYER-1))
DO LOOP=LFRST,LLAST
NINCLS = IW(INDL+DHCDTA+DHCENCO*(LOOP-1)+DHCNCL)
CALL HFILL(3,FLOAT(NINCLS),0.,1.)
PHIAVE = RW(INDL+DHCDTA+DHCENCO*(LOOP-1)+DHCAVF)
CALL HFILL(4,PHIAVE,FLOAT(LAYER),1.)
ENDDO
ENDDO
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.
