*-- Author : Girish D. Patel 07/12/93
SUBROUTINE FQMONR
**: FQMONR.......SM. Modifications for farm.
**: FQMONR.......SM. Addition of alpha and T0 corrections.
*KEEP,FMOHIS.
INTEGER IHS(28)
COMMON/FMOHIS/ IHS
*KEEP,FMOLUN.
COMMON/FMOLUN/ LUNH, LUNS, LMES
*KEEP,FMORUN.
LOGICAL PLANAR,RADIAL
COMMON /FMORUN/ NRUN,NRUN0,NRUN1,MAXEV,PLANAR,RADIAL
*KEEP,FMOSUM.
COMMON/FMOSUM/ NDATE0,NTIME0,ISTATP(20),ISTATR(20),IFRHV,IFPHV,
& NEVENT,NFIEL0,NPRES0,NECUR0,NPCUR0,IRTE0,IRTP0,
& IEVIN,NFPEVT,NHITSP,NFREVT,NHITSR,NMIN92,
& TOTL,H1L,RTIME,REFF,ILRET
* TOTL total run luminosity (mb^-1)
* H1L H1 gated run luminosity (mb^-1)
* RTIME total run time (sec)
* REFF run efficiency = (1 - dead_time/run_time)
* ILRET return flag: 0 - ok, 1 - no inf. found in H1DB
*KEEP,FMOSCA.
COMMON /FMOSCA/ ISCA
*KEEP,FMOWRK.
PARAMETER (MAXHIT=20)
LOGICAL LNEWR
LOGICAL LNEWP
COMMON/H1WORK/
* planar hit data...
+ TT(0:287,4,MAXHIT), NHIT(0:287,4),
+ QQ(0:287,4,MAXHIT), QQW(4) , LNEWP,
* radial hit data...
+ TTR(0:431,4,MAXHIT), NHITR(0:431,4),
+ QQR(0:431,4,MAXHIT), QQWR(4) , LNEWR,
+ RR(0:431,4,MAXHIT)
*KEEP,BCS.
INTEGER NHROW,NHCOL,NHLEN
PARAMETER (NHROW = 2, NHCOL = 1, NHLEN=2)
INTEGER NBOSIW
PARAMETER (NBOSIW=1000000)
INTEGER IW(NBOSIW)
REAL RW(NBOSIW)
COMMON /BCS/ IW
EQUIVALENCE (RW(1),IW(1))
SAVE /BCS/
*KEEP,CNSTBF.
INTEGER LW(NBOSIW)
REAL SW(NBOSIW)
EQUIVALENCE (RW(1),IW(1),LW(1),SW(1))
*KEND.
DIMENSION ZP(3)
* integer*2 bos array
PARAMETER (NBOSW2=2*NBOSIW)
INTEGER*2 IW2(NBOSW2)
EQUIVALENCE (IW(1),IW2(1))
LOGICAL FIRST
*KEEP,STFUNCT.
* index of element before row number IROW
INDR(IND,IROW)=IND+2+IW(IND+1)*(IROW-1)
* index of L'th element of row number IROW
INDCR(IND,L,IROW)=INDR(IND,IROW) + L
* L'th integer element of the IROW'th row of bank with index IND
IBTAB(IND,L,IROW)=IW(INDCR(IND,L,IROW))
* L'th real element of the IROW'th row of bank with index IND
RBTAB(IND,L,IROW)=RW(INDCR(IND,L,IROW))
*KEND.
* function for time of flight correction.
TOF(J) = ( ZP(J/288+1) + MOD(J,12)*SEP - ZMID)/VC
DATA ZP / 159.20,201.40,243.60/
DATA SEP /1.00/
DATA ZMID /200.0/
DATA VC /29.9792/
DATA NRUNL /-1/
DATA FIRST/.TRUE./
IF(FIRST) THEN
* 'event' banks
IQFRRE = NAMIND('FRRE')
IQFRRD = NAMIND('FRRD')
IQDER5 = NAMIND('DER5')
* from database
IQF0R8 = NAMIND('F0R8')
IQF1RA = NAMIND('F1RA')
IQF1RB = NAMIND('F1RB')
FIRST = .FALSE.
ENDIF
IF(NRUN.NE.NRUNL) THEN
NRUNL = NRUN
*
* Hit database to update overall (F0R8) and
* wire-by-wire (F1RA/B) constants.
*
CALL UGTBNK('F0R8',IND)
CALL UGTBNK('F1RA',IND)
CALL UGTBNK('F1RB',IND)
IND0R8 = IW(IQF0R8)
XI = RBTAB(IND0R8,12,1)
ENDIF
* Initialise for this event. Zero arrays.
LNEWR = .FALSE.
NW2 = 2128
NW3 = NW2*MAXHIT
NW4 = 1728*MAXHIT
CALL VZERO( TTR(0,1,1),NW3 )
CALL VZERO( QQR(0,1,1),NW3 )
CALL VZERO( NHITR(0,1),NW2 )
CALL VZERO( RR(0,1,1),NW4 )
FRT = 0.0
IND = IW(IQFRRE)
IND2 = IW(IQFRRD)
IND3 = IW(IQDER5)
IF( IND3.GT.0 ) THEN
ISTATR(13) = ISTATR(13)+1 ! timing problem?
CALL SHSW(IHS(26),0,40.,1.)
ENDIF
IND1 = IND
IF( IND .GT.0 )THEN
IF( IW(IND).LE.1 ) IND1=0
ENDIF
IF( IND2.GT.0 )THEN
IF( IW(IND2).LE.1 ) IND2=0
ENDIF
* statistics for run summary ...
IF( IND1.NE.0 ) THEN
ISTATR(1)=ISTATR(1)+1
CALL SHSW(IHS(26),0,28.,1.)
ENDIF
IF( IND2.NE.0 ) THEN
ISTATR(2)=ISTATR(2)+1
CALL SHSW(IHS(26),0,29.,1.)
ENDIF
IF( (IND1*IND2).NE.0 ) THEN
ISTATR(3)=ISTATR(3)+1
CALL SHSW(IHS(26),0,30.,1.)
ENDIF
IF( IND1.EQ.0 .AND. IND2.EQ.0 ) THEN
ISTATR(4)=ISTATR(4)+1
CALL SHSW(IHS(26),0,31.,1.)
ENDIF
IF (IND.NE.0 ) THEN
C FRRE BANK PRESENT - GO FOR IT !!!
C ATTEMPT TO READ WIRE NO., T AND Q FROM BANK
C
NFREVT = NFREVT+1
INDX = IND*2
NW = IW(IND)
NHW = NW*2
NBANK = IW(IND-2)
NROW = IW2(INDX+2)
C INDX IS THE ADDRESS OF THE END OF THE PREVIOUS RECORD
C IN 2-BYTE WORDS
C CHECK CONTENTS ARE BELIEVABLE (?)
IF (NW.NE.NROW*3+1) THEN
WRITE(LMES,132) NROW,NFREVT,NW,IND,NBANK
132 FORMAT(' WARNING : NROW = ',I6,' IN EVENT ',I6,' BUT NW = ',
* I6,/,' FRRE POINTER = ',I6,' BANK NUMBER = ',I6)
GOTO 100
ENDIF
NHITSR = NHITSR + NROW
INDX = INDX+2
C EVERYTHING SHOULD BE OK - READ OUT CONTENTS
IF( NROW.GT.0 )THEN
IND1RA = IW(IQF1RA)
IND1RB = IW(IQF1RB)
DO 137 I = 1,NROW
C LOOP OVER HITS IN QT OUTPUT BANK
IWIRE = IW2(INDX+1)
IDT = IW2(INDX+2) ! DRIFT TIME IN FADC BINS * ISCA
IQP = IW2(INDX+3) ! INTEGRATED CHARGE FOR + END OF WIRE
IQM = IW2(INDX+4) ! INTEGRATED CHARGE FOR - END OF WIRE
IFLG2 = IW2(INDX+6) ! IFLAG2 FADC pulse information
* Extract wire dependent constants for Channel IWIRE...
T0 = RBTAB(IND1RA, 1,IWIRE+1)
DELD = RBTAB(IND1RA, 2,IWIRE+1)
DELT = RBTAB(IND1RA, 3,IWIRE+1)
RELG = RBTAB(IND1RA, 4,IWIRE+1)
ELEFOL= RBTAB(IND1RA, 6,IWIRE+1)
RPLUS = RBTAB(IND1RB, 1,IWIRE+1)
RMINUS= RBTAB(IND1RB, 2,IWIRE+1)
RESPLU= RBTAB(IND1RB, 3,IWIRE+1)
RESMIN= RBTAB(IND1RB, 4,IWIRE+1)
RMINPL= RBTAB(IND1RB, 5,IWIRE+1)
RMINMI= RBTAB(IND1RB, 6,IWIRE+1)
IQ = IQP + IQM ! INTEGRATED CHARGE FOR TOTAL PULSE
FQ = FLOAT(IQ)
QPLUS = FLOAT(IQP)
QMINUS= FLOAT(IQM)
* Determine alpha. Needed for correction to Drift time
* as well as for radial coordinate.
DENOM = QPLUS + RELG*QMINUS
IF (DENOM .GT. 0.0) THEN
ALP =(QPLUS - RELG*QMINUS) / DENOM
IBADQ = 0
ELSE
CALL ERRLOG(100, 'W:FQMONR: Zero charge digi found')
ALP = 0.0
IBADQ = 1
ENDIF
*
* Determine radial coordinate by charge divison
*
SIGMA = (RPLUS + RMINUS)*ELEFOL
DELTA = RPLUS- RMINUS
RPL = + (SIGMA*ALP+DELTA)/(2.*RESPLU)
RPM = - (SIGMA*ALP+DELTA)/(2.*RESMIN)
* Choose valid solution, add inner radius and apply
* chg-div distortion correction (linear part only for now)
IF(RPL .GE. 0.0) THEN
RADIUS = RPL*(1.0 + XI) + RMINPL
RAD = RPL + RMINPL
ISGNW = 1
ELSE
RADIUS = RPM*(1.0 + XI) + RMINMI
RAD = RPM + RMINMI
ISGNW = -1
ENDIF
**
* Correct drift time for wire-by-wire T0 and radius
TALP = 0.5*ALP*(DELD - ALP*DELT)
TCOR = FLOAT(IDT) - (T0 + TALP)
TOFCOR= TOF(IWIRE)
FDT = 9.6154*TCOR/FLOAT(ISCA) - TOFCOR
IF(FDT.LT.1600.0) FRT = FRT + FDT
CALL FILLQR(IWIRE,FDT,FQ,RADIUS,ISGNW,IFLG2)
INDX = INDX+6
137 CONTINUE
FRT = FRT/FLOAT(NROW)
CALL SHS (IHS(28),0,FRT)
ENDIF
CALL FCHKQR
ENDIF
*
* END OF LOOP OVER EVENTS - COLLECT STATISTICS
*
100 RETURN
END
*
*