*-- Author : Stephen J. Maxfield 01/03/91
SUBROUTINE FRLOCO
**: FRLOCO.......SM. Introduce asymmetry and wire-plane velocity
**: FRLOCO.......SM. factors. New parameters ex FCR3 bank.
**----------------------------------------------------------------------
**: FRLOCO.......SB. Correct for trigger in wrong bunch crossings.
**----------------------------------------------------------------------
**: FRLOCO 40000 SM. Make new temporary bank FAUX.
**----------------------------------------------------------------------
**: FRLOCO 30907 RP. Farm changes.
**----------------------------------------------------------------------
**: FRLOCO 30907 SM. Improved drift and radius error determination.
**: FRLOCO 30907 SM. Explicitly drop FRLC FRHC banks.
**----------------------------------------------------------------------
**: FRLOCO 30207 GB. comment lines moved inside the routine
**: FRLOCO 30205 SM. Modifications for Filter farm.
**----------------------------------------------------------------------
* Calculate LOCAL COORDINATES of digitisations in the Radial
* Drift Chambers from contents of FRRE bank and database.
* The drift distance and radius of the impact
* point on the wire are computed and corrected as described
* in the in-line comments below.
* The following effects are NOT corrected for here:
* * Geometrical displacements and distortions
* * Lorentz angle
* * Track angle effects
* However, the Lorentz angle and the quantity DR (needed for
* applying corrections to the drift for the track angle) are
* obtained from the F0R8 bank and placed in COMMON ..... for
* subsequent use.
* A temporary bank is created, FRLC containing the results.
* This bank is parallel to the FRRE bank. It is a named bank but
* is not put on the E-list:
*
*! BANKname BANKtype ! Comments
* TABLE FRLC ! Local coordinates and data for hits
* ! in Radial Drift Chambers.
* ! TEMPORARY. Parallel to FRRE bank.
*! ATTributes:
*! -----------
*!COL ATT-name FMT Min Max ! Comments
*!
* 1 ICLNUM I ! Drift cell number
* 2 DRIFTS F ! Abs drift distance (cms)
* 3 ERRDRF F ! Error in drift distance (cms)
* 4 RADIUS F ! Radius of impact point (cms)
* 5 ERRRAD F ! Error in Radius (cms)
* 6 ISGNW I ! Bit 0: 0=+wedge 1=-wedge
* ! Bit 1: 0=OK QT 1=dubious radius
* ! Bit 2: 0=OK 1=dubious drift
* ! Bit 3: 0=OK 1=timing pulse?
* ! Bit 7: 0=OK 1=on no account
* ! use this hit!
* ! Note that MOD(ISGNW,2) always
* ! gives 0 for +wedge, 1 for -wedge
* ! ISGNW > 1 indicates poss problems
* 7 QPLUS F ! Charge integral + end of wire
* 8 QMINUS F ! Charge integral - end of wire
*!
* END TABLE
* NOTES:
* 1) The drift error is parameterised as a function of drift
* distance.
* 2) If there was a close preceding hit or long leading edge,
* the drift resolution is degraded and Bit 2 in ISGNW set.
* 3) If the integration interval is short or close preceding
* hit, or saturation the radial coordinate error is degraded
* and Bit 1 in ISGNW is set.
* 4) Possible timing pulses are flagged by setting Bit 3 in ISGNW.
* 5) Bit 7 is set if the pulse had insane drift times or zero
* measured charge. Such pulses should never be used.
*
* Reject hit if ISGNW > 127
*
*
*
*! BANKname BANKtype ! Comments
* TABLE FRHC ! Map showing number of hits in each
* ! Cell. Row number = Cell number + 1
* ! TEMPORARY.
*! ATTributes:
*! -----------
*!COL ATT-name FMT Min Max ! Comments
*!
* 1 NHITS I ! Number of hits in Drift cell
* 2 IFRRE I ! Pointer to 1st hit in FRRE/FRLC
*!
*======================================================================
* bank number forvarious banks.
PARAMETER(NBN=0)
PARAMETER(NCFRLC=10)
PARAMETER(NCFRHC=2)
PARAMETER(NRFRHC=864)
PARAMETER(NCFAUX=1)
* Locators for stuff in F0R8 bank (overall constants)
PARAMETER(ITZER=1)
PARAMETER(IVDRF=4)
PARAMETER(ID0=5)
PARAMETER(ID1=6)
PARAMETER(ID2=7)
PARAMETER(IC0=8)
PARAMETER(IC1=9)
PARAMETER(IDR=10)
PARAMETER(IALOR=11)
PARAMETER(IXI=12)
* Locators for stuff in FCR3 bank (t-to-d and error parameters)
* (This bank replaces the old FCR1 bank)
PARAMETER(IPKNOT=1)
PARAMETER(IPKPAR=2)
* Locators for stuff in FCR2 bank (resolution parameters)
PARAMETER(IFCED0=2)
PARAMETER(IFCED1=3)
PARAMETER(IFCED2=4)
PARAMETER(IFCED3=5)
PARAMETER(IFCER0=6)
PARAMETER(IFCER1=7)
PARAMETER(IFCER2=8)
PARAMETER(IFCER3=9)
PARAMETER(IFUN=10)
* Locators for stuff in F1RA bank (wire-by-wire constants)
PARAMETER(IT0=1)
PARAMETER(IDELD=2)
PARAMETER(IDELT=3)
PARAMETER(IRELG=4)
PARAMETER(IGPRO=5)
PARAMETER(ILEFOL=6)
* Locators for stuff in F1RB bank (wire-by-wire constants)
PARAMETER(IRPLUS=1)
PARAMETER(IRMINU=2)
PARAMETER(IRESPL=3)
PARAMETER(IRESMI=4)
PARAMETER(IRMNPL=5)
PARAMETER(IRMNMI=6)
* tan 1/2 wedge angle
PARAMETER(TANWED=0.065543463)
* microns -> cms
PARAMETER(EMTOC=10000.)
* Scale factor for drift time...
PARAMETER(TSFAC=0.00079)
*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))
*KEEP,BOSMDL.
C ------BOSMDL
LOGICAL BEGJOB,ENDRUN,BEGRUN,REVENT,ENDJOB,OTHDAT
COMMON/BOSMDL/BEGJOB,ENDRUN,BEGRUN,REVENT,ENDJOB,OTHDAT,
+ LCCRUN,NCCRUN,NEVENT,
+ IHA,IBS,IDB,IDATEL,LUP,ISN,JSN
SAVE /BOSMDL/
C ------
*KEEP,H1EVDT.
COMMON /H1EVDT/ KEVENT,IDATA,MONTE,LCONF
INTEGER KEVENT,IDATA,LCONF
LOGICAL MONTE
*
* IDATA type of information (HEAD bank word 6) :
*
* 0 - real data H1
* 1 - MC data H1SIM
* 2 - real data CERN tests
* 3 - MC data ARCET
*
* MONTE = .TRUE. if IDATA=1
* KEVENT = event processed counter for H1REC
*
*KEEP,FRLORA.
REAL ATLORR, ATLORP, DTANGR, DTANGP
COMMON /FRLORA/ ATLORR, ATLORP, DTANGR, DTANGP
*KEEP,FDIFLG.
COMMON/LDIAG/IDIAG,IDIAG2,MAXPRT,IDOHIS,PMCUT
*KEEP,FWINDS.
* Work bank indices...
COMMON/FWINDS/ INFRRE, INFRPE, ILWPG1, ILWRG1
*KEND.
* Local arrays, variables.
DIMENSION BAR(NCFRLC), IAR(NCFRLC)
EQUIVALENCE(BAR(1), IAR(1))
PARAMETER (NNKNOT=2)
DIMENSION VDR(NNKNOT), SKN(NNKNOT), BETA(NNKNOT)
DIMENSION SKNC0(NNKNOT), SKNC1(NNKNOT), SKNC2(NNKNOT)
DIMENSION V0S(36)
DIMENSION V1S(36)
DIMENSION V0F(36)
DIMENSION V1F(36)
DIMENSION V0N(36)
DIMENSION V1N(36)
LOGICAL FIRST
LOGICAL LTIMPL
* Statement function true if Channel might have time-stamp pulse
LTIMPL(ICELL) = MOD(ICELL,96).LT.7 .AND.
+ MOD(MOD(ICELL,96),2).EQ.0
*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.
DATA FIRST/.TRUE./
DATA NEGRUN /-1/
* Initialisation of bank pointers on first call...
IF(FIRST) THEN
FIRST = .FALSE.
*
IQFRRE = NAMIND('FRRE')
IQFTDC = NAMIND('FTDC')
IQF0R8 = NAMIND('F0R8')
IQFGAR = NAMIND('FGAR')
IQF1RA = NAMIND('F1RA')
IQF1RB = NAMIND('F1RB')
IQFCR3 = NAMIND('FCR3')
IQFCR2 = NAMIND('FCR2')
CALL BKFMT('FRLC','2I,(I,4F,I,4F)')
CALL BKFMT('FRHC','2I,(2I)')
CALL BKFMT('FAUX','2I,(I)')
ENDIF
*
*
IF(BEGRUN .OR. NCCRUN .NE.NEGRUN) THEN
NEGRUN = NCCRUN
*
* New run. Hit database for run-dependent banks.
*
CALL UGTBNK('F0R8',IND)
CALL UGTBNK('FGAR',IND)
CALL UGTBNK('FCR3',IND)
CALL UGTBNK('FCR2',IND)
CALL UGTBNK('F1RA',IND)
CALL UGTBNK('F1RB',IND)
* Extract needed overall constants...
IND0R8 = IW(IQF0R8)
TZER = RBTAB(IND0R8,ITZER,1)
VDRFT = RBTAB(IND0R8,IVDRF,1)
D0 = RBTAB(IND0R8,ID0,1)
D1 = RBTAB(IND0R8,ID1,1)
D2 = RBTAB(IND0R8,ID2,1)
C0 = RBTAB(IND0R8,IC0,1)
C1 = RBTAB(IND0R8,IC1,1)
ATLORR = TAN(RBTAB(IND0R8,IALOR,1))
DTANGR = RBTAB(IND0R8,IDR,1)
XI = RBTAB(IND0R8,IXI,1)
* Parameters for time-to-distance relation...
INDGAR = IW(IQFGAR)
* The (nominal) geometric stagger...
SSTAG = RW(INDGAR+ 6)
STAG = ABS(SSTAG)
* Number of velocity parameter sets...
INDCR3 = IW(IQFCR3)
KNOT = IBTAB(INDCR3, IPKNOT, 1)
KPAR = IBTAB(INDCR3, IPKPAR, 1)
* Velocities, knot points, asymmetry corrections etc.
Do JK = 1, KNOT
IPT = 2 + (JK-1)*KPAR
* drift velocity at JK'th knot...
VDR(JK) = RBTAB(INDCR3, IPT + 1, 1)
SKN(JK) = RBTAB(INDCR3, IPT + 2, 1)
* Asymmetry factor at JK'th knot...
BETA(JK) = RBTAB(INDCR3, IPT + 3 , 1)
* quadratic correction to S at JK'th knot...
SKNC0(JK) = RBTAB(INDCR3, IPT + 4, 1)
SKNC1(JK) = RBTAB(INDCR3, IPT + 5, 1)
SKNC2(JK) = RBTAB(INDCR3, IPT + 6, 1)
Enddo
* Wire dependent scale factors for drift velocities...
* Apply wire dependent scale factors.
* Apply near far asymmetries.
* (Beta > 0 => Vfar > Vnear (opposite to planars?))
IPT = IPT + KPAR
Do JWIRE = 1, 36
* 'symmetrised'
V0S(JWIRE) = VDR(1)*RBTAB(INDCR3, IPT + JWIRE, 1)
V1S(JWIRE) = VDR(2)*RBTAB(INDCR3, IPT + JWIRE, 1)
* 'far wires'
V0F(JWIRE) = V0S(JWIRE)*(1.0 + BETA(1))
V1F(JWIRE) = V1S(JWIRE)*(1.0 + BETA(2))
* 'near wires'
V0N(JWIRE) = V0S(JWIRE)*(1.0 - BETA(1))
V1N(JWIRE) = V1S(JWIRE)*(1.0 - BETA(2))
Enddo
IPT = IPT + 36
* Min allowed drift time and Tol on max allowed drift
TBMIN = RBTAB(INDCR3, IPT + 2, 1)
DELMAX = RBTAB(INDCR3, IPT + 3, 1)
* Numbers for drift-error parameterisation...
INDCR2 = IW(IQFCR2)
ERRD0 = RBTAB(INDCR2, IFCED0, 1)
ERRD1 = RBTAB(INDCR2, IFCED1, 1)
ERRD2 = RBTAB(INDCR2, IFCED2, 1)
ERRD3 = RBTAB(INDCR2, IFCED3, 1)
* Numbers for radius-error parameterisation...
ERRR0 = RBTAB(INDCR2, IFCER0, 1)
ERRR1 = RBTAB(INDCR2, IFCER1, 1)
ERRRM = RBTAB(INDCR2, IFCER2, 1)
FQFAC = RBTAB(INDCR2, IFCER3, 1)
IFUNNY = IBTAB(INDCR2, IFUN, 1)
ENDIF
**----------------------------------------------------------------------
* Normal Event processing...
* Check if old FRHC and FRLC banks exist. If so drop them...
* (to allow proper re-processing of event in DISPLAY).
INDDUM = MLINK(IW,'FRHC',NBN)
IF(INDDUM.NE.0) THEN
CALL BDROP(IW,'FRHC')
ENDIF
INDDUM = MLINK(IW,'FRLC',NBN)
IF(INDDUM.NE.0) THEN
CALL BDROP(IW,'FRLC')
ENDIF
INDDUM = MLINK(IW,'FAUX',NBN)
IF(INDDUM.NE.0) THEN
CALL BDROP(IW,'FAUX')
ENDIF
* Create FRHC bank...
INDRHC = NBANK('FRHC',NBN,2+2*NRFRHC)
CALL VZERO(IW(INDRHC+1), 2+2*NRFRHC)
IW(INDRHC+1) = NCFRHC
IW(INDRHC+2) = NRFRHC
TFTDC = 0.0
**
* Get Event Time zero. To be done!
* CALL CEVT0(TFTDC, LTTYP)
*+SELF,IF=FTTUNE.
* CJC TDC time...
* CALL SHS(615,0,TFTDC)
*+SELF.
**
* Apply correction for wrong bunch crossing
CALL T0GET (ITRGT0)
TZERO = TZER + TFTDC + 500.0*FLOAT(ITRGT0)
*
* Access FRRE bank...
IND = IW(IQFRRE)
IF(IND .EQ.0) THEN
* FRRE bank not found. No data. Make 'zero-length' bank...
INDF = NBANK('FRLC',NBN,2)
IW(INDF+1) = NCFRLC
IW(INDF+2) = 0
RETURN
ENDIF
* Copy B16 format bank to work bank
INFRRE=0
CALL BKTOW(IW,'FRRE',NBN,IW,INFRRE,*999)
* |- error making w/bank
* Determine number of hits in FRRE bank
NFRRE = IW(INFRRE+2)
IF(NFRRE.LE.0) THEN
* There were no digis. Should have been no bank! Make 'zero-
* length' FRLC bank...
INDF = NBANK('FRLC',NBN,2)
IW(INDF+1) = NCFRLC
IW(INDF+2) = 0
INDA = NBANK('FAUX',NBN,2)
IW(INDA+1) = NCFAUX
IW(INDA+2) = 0
CALL WDROP(IW,INFRRE)
RETURN
ENDIF
IND1RA = IW(IQF1RA)
IND1RB = IW(IQF1RB)
* Extract Digitisations in radial chambers:-
ICLOLD = -1
* Create banks
IFRLC = NBANK('FRLC',NBN,2+NCFRLC*NFRRE)
IF (IFRLC.LE.0) GOTO 997
IW(IFRLC+1) = NCFRLC
IW(IFRLC+2) = NFRRE
IFAUX = NBANK('FAUX',NBN,2+NCFAUX*NFRRE)
IF (IFAUX.LE.0) GOTO 997
IW(IFAUX+1) = NCFAUX
IW(IFAUX+2) = NFRRE
DO 1 KDIG = 1, NFRRE
* Check legal cell...
ICLNUM= IBTAB(INFRRE,1,KDIG)
IF(ICLNUM .LT. 0 .OR. ICLNUM .GT. 863) THEN
GO TO 998
ENDIF
* Fill FRHC bank...
IF(ICLNUM .NE. ICLOLD) THEN
IW(INDRHC+ICLNUM*2 + 3) = 1
IW(INDRHC+ICLNUM*2 + 4) = KDIG
ICLOLD = ICLNUM
ELSE
IW(INDRHC+ICLNUM*2 + 3) = IW(INDRHC+ICLNUM*2 + 3) + 1
ENDIF
* Extract wire dependent constants for Channel ICLNUM...
T0 = RBTAB(IND1RA,IT0 ,ICLNUM+1)
DELD = RBTAB(IND1RA,IDELD ,ICLNUM+1)
DELT = RBTAB(IND1RA,IDELT ,ICLNUM+1)
RELG = RBTAB(IND1RA,IRELG ,ICLNUM+1)
ELEFOL= RBTAB(IND1RA,ILEFOL,ICLNUM+1)
RPLUS = RBTAB(IND1RB,IRPLUS,ICLNUM+1)
RMINUS= RBTAB(IND1RB,IRMINU,ICLNUM+1)
RESPLU= RBTAB(IND1RB,IRESPL,ICLNUM+1)
RESMIN= RBTAB(IND1RB,IRESMI,ICLNUM+1)
RMINPL= RBTAB(IND1RB,IRMNPL,ICLNUM+1)
RMINMI= RBTAB(IND1RB,IRMNMI,ICLNUM+1)
* Basic hit data...
DTIME = FLOAT(IBTAB(INFRRE,2,KDIG))
QPLUS = FLOAT(IBTAB(INFRRE,3,KDIG))
QMINUS= FLOAT(IBTAB(INFRRE,4,KDIG))
IFLAG1= IBTAB(INFRRE,5,KDIG)
IFLAG2= IBTAB(INFRRE,6,KDIG)
*
*======= Determine radial coordinate by charge divison ===============
*
* Determine alpha. Needed for correction to Drift time
* as well as for radial coordinate. Flag bad charges.
DENOM = QPLUS + RELG*QMINUS
IF (DENOM .GT. 0.0) THEN
ALP =(QPLUS - RELG*QMINUS) / DENOM
IBADQ = 0
ELSE
CALL ERRLOG(103, 'W:FRLOCO: Zero charge digi found')
ALP = 0.0
IBADQ = 1
ENDIF
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 = 0
ELSE
RADIUS = RPM*(1.0 + XI) + RMINMI
RAD = RPM + RMINMI
ISGNW = 1
ENDIF
**
* Make systematic correction to radius...
* IINT = IAND(IFLAG1,31)
* RADIUS = FRDSYS(RAD,IINT)
**
*
*======= Compute drift distance =======================================
*
* Correct drift time by wire-dependent T0 and for radius...
TT = DTIME - (TZERO + T0 + 0.5*ALP*(DELD - ALP*DELT))
* Flag 'premature' hits...
IF(TT.LT.TBMIN) THEN
IBADT = 1
ELSE
IBADT = 0
ENDIF
* Scaled drift time (-> approx drift distance in cms)
TS = TT*VDRFT
TSCAL = TT*TSFAC
*
* Apply Time-to-distance relation
*
* Allow for possibly different t-to-d treatment in Monte Carlo
IF(MONTE) THEN
* No t-to-d for M/C at moment...
DRIFTS= TS
DRIFTP= TS
DRIFTM= TS
ELSE
* Radius-dependent location of first knot...
S1R= SKN(2) + SKNC0(2)
+ + SKNC1(2)*RADIUS + SKNC2(2)*RADIUS*RADIUS
*
IWIR = IRIOSW(ICLNUM)
S1 = S1R
* Velocities and knots for symmetric stuff...
V0 = V0S(IWIR)
V1 = V1S(IWIR)
* S1 = S1R
DRIFTS = FRDT2D(TS, V0, V1, S1)
* Velocities and knots for far wires...
V0 = V0F(IWIR)
V1 = V1F(IWIR)
* S1 = S1R + STAG
DRIFTF = FRDT2D(TS, V0, V1, S1)
* Velocities and knots for near wires...
V0 = V0N(IWIR)
V1 = V1N(IWIR)
* S1 = S1R - STAG
DRIFTN = FRDT2D(TS, V0, V1, S1)
* Assign near/far values to plus/minus drift...
SS = SSTAG*( (-1)**(IWIR-1) )
IF(SS .GT. 0.) THEN
DRIFTP = DRIFTN
DRIFTM = DRIFTF
ELSE
DRIFTP = DRIFTF
DRIFTM = DRIFTN
ENDIF
ENDIF
*
* Make estimations of measurement errors.
* Establish 'core' errors then react to pulse shape
* information in flags to degrade these further.
*
* a) 'Core' errors...
*
* > Drift errors. sig**2=e0**2 +d.e1**2 + e2**2.exp(-e3*d)
* Max allowed drift at radius of hit + a tolerance.
*
DRFMAX = RADIUS*TANWED + DELMAX
IF(DRIFTS .LT. DRFMAX) THEN
ERRDRF = ERRD0**2 + DRIFTS*ERRD1*ERRD1
+ + ERRD2*ERRD2*EXP(-ERRD3*DRIFTS)
ERRDRF = SQRT(ERRDRF) / EMTOC
ELSE
ERRDRF = DRIFTS-DRFMAX
ISGNW = IOR(ISGNW, 128)
ENDIF
*
* > Radial coordinate error as function of total charge integral
QTOTSC = (QPLUS + QMINUS) / FQFAC
IF (QTOTSC.GT.0.) THEN
ERRRAD = MIN(ERRR0 + (ERRR1 / QTOTSC), ERRRM)
ELSE
ERRRAD = ERRRM
ENDIF
* ELSE
*
* ENDIF
* React to flags. Note that 'old' M/C has different flag
* Structure. This is indicated by a zero value for IFUNNY.
IF(IFUNNY.NE.0) THEN
* we have data or 'new' M/C
* FLAG 2 > IFUNNY indicates possible problems with Qt...
IF(IFLAG2 .GT. IFUNNY) THEN
* unpack rest of flags...
IINT = IAND(IFLAG1,31)
INDX = ISHFT(IFLAG1,-5)
INDX = IAND(INDX,7)
MAXR = IAND(IFLAG2,15)
JUNK = ISHFT(IFLAG2,-4)
ISPL = IAND(JUNK,15)
JUNK = ISHFT(JUNK,-4)
LHIT = IAND(JUNK,15)
* > If there was a close preceding hit or long leading edge,
* degrade the DRIFT resolution...
IF(ISPL.LT.15 .OR. LHIT .GT. 3) THEN
ERRDRF = 2.0*ERRDRF
ISGNW = IOR(ISGNW, 4)
ENDIF
* > If the integration interval is short or close preceding
* hit, or saturation degrade the RADIUS coordinate error...
* IF(IINT.LT.12 .OR. ISPL.LT.15 .OR. MAXR.GT.0) THEN
* ERRRAD = 2.0*ERRRAD
* ISGNW = IOR(ISGNW, 2)
* ENDIF
ENDIF
ELSE
* Old format flag in Monte Carlo, extract number of hits...
IHITS =0
IHITS = ISHFT(IFLAG2,-12)
IHITS = IAND(IHITS,15)
IF(IHITS .GT. 1) THEN
ERRDRF = 2.0*ERRDRF
* ERRRAD = 2.0*ERRRAD
ISGNW = IOR(ISGNW, 6)
ENDIF
ENDIF
*
* Flag the Really awful hits...(no charge or too early)
IF(IBADQ .EQ. 1) THEN
ERRDRF = 2.0*ERRDRF
* ERRRAD = 2.0*ERRRAD
ISGNW = IOR(ISGNW,128)
ENDIF
IF(IBADT .EQ. 1) THEN
ERRDRF = 2.0*ERRDRF
* ERRRAD = 2.0*ERRRAD
ISGNW = IOR(ISGNW,128)
ENDIF
* Set flag to indicate potentential time-stamp pulse:
* Celnum must be one that could have T-p injected:-
IF(LTIMPL(ICLNUM)) THEN
* ...and have large '-ve' radius...
IF(MOD(ISGNW,2) .EQ. 1 .AND. RADIUS .GT. 75.0) THEN
ERRDRF = 2.0*ERRDRF
* ERRRAD = 2.0*ERRRAD
ISGNW = IOR(ISGNW, 8)
ENDIF
ENDIF
* Fill row in output bank
IAR(1) = ICLNUM
BAR(2) = DRIFTS
BAR(3) = ERRDRF
BAR(4) = RADIUS
BAR(5) = ERRRAD
IAR(6) = ISGNW
BAR(7) = QPLUS
BAR(8) = QMINUS
BAR(9) = DRIFTP
BAR(10) = DRIFTM
C IFRLC = IADROW('FRLC',NBN,NCFRLC,BAR)
CALL UCOPY(BAR,IW(INDCR(IFRLC,1,KDIG)),NCFRLC)
* Quantities for auxilliary bank FAUX
BAR(1)= TSCAL
C IFAUX = IADROW('FAUX',NBN,NCFAUX,BAR)
CALL UCOPY(BAR,IW(INDCR(IFAUX,1,KDIG)),NCFAUX)
* Histograms for monitoring... (factor 10 downscale)
IF (MOD(NEVENT,10).EQ.0) THEN
CALL SHS(108,0,DRIFTS)
CALL SHS(610,0,TT)
ENDIF
IF(IDOHIS .GE. 2) THEN
FSIG = FLOAT(ISGNW)
CALL SHS(114,0,FSIG)
CALL SHS(115,0,RADIUS)
CALL SHS(257,0,QSUM)
ENDIF
1 CONTINUE
C IFRLC = IADFIN('FRLC',NBN)
C IFAUX = IADFIN('FAUX',NBN)
CALL WDROP(IW,INFRRE)
RETURN
998 CONTINUE
CALL ERRLOG(114,'S:FRLOCO: Illegal Channel number!!')
GOTO 996
997 CONTINUE
CALL ERRLOG(114,'S:FRLOCO: Cant create bank')
996 CONTINUE
* FRLC may be partially made. Finish it drop it and recreate
* empty version...
C IFRLC = IADFIN('FRLC',NBN)
CALL BDROP(IW,'FRLC')
INDF = NBANK('FRLC',NBN,2)
IW(INDF+1) = NCFRLC
IW(INDF+2) = 0
C IFAUX = IADFIN('FAUX',NBN)
CALL BDROP(IW,'FAUX')
INDA = NBANK('FAUX',NBN,2)
IW(INDA+1) = NCFAUX
IW(INDA+2) = 0
CALL WDROP(IW,INFRRE)
RETURN
999 CONTINUE
CALL ERRLOG(104,'S:FRLOCO: Error in FRRE work bank creation')
CALL WDROP(IW,INFRRE)
RETURN
END
*