*-- Author : Girish D. Patel 07/12/93
SUBROUTINE FQMONP
*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(9)
* 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))
*KEEP,FTFUNCT.
* Statement functions for RADIAL Chamber data access.
* Using Channel Number J
* Module, Wedge-pair and Z-plane numbers...
IRMOD(J) = J/288
IRWDP(J) = (J-IRMOD(J)*288)/12
IRZPL(J) = J-IRMOD(J)*288-IRWDP(J)*12
* Statement function for obtaining WEDGE numbers(0-47) of
* wires at plus and minus ends of Cell numbers
IRWPL(J) = (IRWDP(J)/2)*4 + (MOD(IRWDP(J),2))
IRWMI(J) = MOD(IRWPL(J) + 34,48)
* Statement function for obtaining IOS wire number (1-36)
IRIOSW(J) = IRMOD(J)*12 + IRZPL(J) + 1
* Statement functions for PLANAR Chamber data access.
* Using Channel Number J
* Module, orientation, W-cell and Z-plane numbers...
IPMOD(J) = J/384
IPORI(J) = (J-IPMOD(J)*384)/128
IPWCL(J) = (J-IPMOD(J)*384-IPORI(J)*128)/4
IPZPL(J) = (J-IPMOD(J)*384-IPORI(J)*128-IPWCL(J)*4)
* IPSMD in range 0:8 Planar module number.
IPSMD(J) = IPMOD(J)*3 + IPORI(J)
*
* IOS wire number (runs from 0 to 36)
IPIOSW(J) = IPSMD(J)*4 + IPZPL(J) + 1
* SB plane numbers (1-72) from cell number
IPSBW(J) = 24*IPMOD(J) + 4*IPORI(J) + IPZPL(J) + 1
IRSBW(J) = 24*IRMOD(J) + IRZPL(J) + 13
* Module, orientation, wire and (typical) cell number from plane
* number in the range 1-72 (planars, radials and combined)
IPMSB(J) = (J - 1)/24
IPOSB(J) = (J - 24*IPMSB(J) - 1)/4
IPZSB(J) = J - 24*IPMSB(J) - 4*IPOSB(J) - 1
IPCLSB(J) = 384*IPMSB(J) + 128*IPOSB(J) + IPZSB(J)
IRMSB(J) = (J - 1)/24
IRZSB(J) = J - 24*IRMSB(J) - 13
IRCLSB(J) = 288*IRMSB(J) + IRZSB(J)
IRADSB(J) = (J - 24*((J-1)/24) - 1)/12
ICELSB(J) = IRADSB(J)*IRCLSB(J) + (1 - IRADSB(J))*IPCLSB(J)
*KEND.
* function for time of flight correction.
TOF(J) = ( ZP(J/128+1) + MOD(J,4)*SEP - ZMID)/VC
*
DATA ZP / 132.44,136.70,140.96,174.64,178.90,183.16,216.84,
& 221.10,225.36/
DATA SEP /0.60/
DATA ZMID /175.0/
DATA VC /29.9792/
DATA FIRST/.TRUE./
DATA NRUNL /-1/
IF(FIRST) THEN
* 'event' banks...
IQFRPE = NAMIND('FRPE')
IQFRPD = NAMIND('FRPD')
IQDER5 = NAMIND('DER5')
* from database...
IQF1PA = NAMIND('F1PA')
FIRST = .FALSE.
ENDIF
IF(NRUN.NE.NRUNL) THEN
NRUNL = NRUN
*
* Hit database to update
* wire-by-wire (F1PA) constants.
*
CALL UGTBNK('F1PA',IND)
ENDIF
* Initialise for this event. Zero arrays
LNEWP = .FALSE.
NW2 = 1152
NW3 = NW2*MAXHIT
CALL VZERO( TT(0,1,1),NW3 )
CALL VZERO( QQ(0,1,1),NW3 )
CALL VZERO( NHIT(0,1),NW2 )
FPT = 0.0
IND = IW(IQFRPE)
IND2 = IW(IQFRPD)
IND3 = IW(IQDER5)
IF( IND3.GT.0 ) THEN
ISTATP(13) = ISTATP(13)+1 ! timing problem?
CALL SHSW(IHS(26),0,20.,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
ISTATP(1)=ISTATP(1)+1
CALL SHSW(IHS(26),0, 8.,1.)
ENDIF
IF( IND2.NE.0 ) THEN
ISTATP(2)=ISTATP(2)+1
CALL SHSW(IHS(26),0, 9.,1.)
ENDIF
IF( (IND1*IND2).NE.0 ) THEN
ISTATP(3)=ISTATP(3)+1
CALL SHSW(IHS(26),0,10.,1.)
ENDIF
IF( IND1.EQ.0 .AND. IND2.EQ.0 ) THEN
ISTATP(4)=ISTATP(4)+1
CALL SHSW(IHS(26),0,11.,1.)
ENDIF
IF (IND.NE.0) THEN
C FRPE BANK PRESENT - GO FOR IT !!!
C ATTEMPT TO READ WIRE NO., T AND Q FROM BANK
C
NFPEVT = NFPEVT+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,NFPEVT,NW,IND,NBANK
132 FORMAT(' WARNING : NROW = ',I6,' IN EVENT ',I6,' BUT NW = ',
* I6,/,' FRPE POINTER = ',I6,' BANK NUMBER = ',I6)
GOTO 100
ENDIF
NHITSP = NHITSP + NROW
INDX = INDX+2
C EVERYTHING SHOUD BE OK - READ OUT CONTENTS
IF( NROW.GT.0 )THEN
IND1PA = IW(IQF1PA)
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
IQ = IW2(INDX+3) ! INTEGRATED CHARGE FOR WHOLE PULSE
* Extract wire dependent T0 for Channel IWIRE...
T0 = RBTAB(IND1PA, 1,IWIRE+1)
* Correct drift time for wire-by-wire T0
TCOR = FLOAT(IDT) - T0
TOFCOR= TOF(IWIRE)
FDT = 9.6154*TCOR/FLOAT(ISCA) - TOFCOR
FQ = FLOAT(IQ)
IF(FDT.LT.1600.0) FPT = FPT + FDT
CALL FILLQP(IWIRE,FDT,FQ,0) ! fill T and Q arrays
INDX = INDX+6
137 CONTINUE
FPT = FPT/FLOAT(NROW)
CALL SHS (IHS(27),0,FPT)
ENDIF
CALL FCHKQP
ENDIF
100 RETURN
END
*