*-- 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.
* Locators for stuff in F0R8 bank (overall constants)
* Locators for stuff in FCR3 bank (t-to-d and error parameters)
* (This bank replaces the old FCR1 bank)
* Locators for stuff in FCR2 bank (resolution parameters)
* Locators for stuff in F1RA bank (wire-by-wire constants)
* Locators for stuff in F1RB bank (wire-by-wire constants)
* tan 1/2 wedge angle
* microns -> cms
* Scale factor for drift time...
*KEEP,BCS.
*KEEP,CNSTBF.
*KEEP,BOSMDL.
C ------BOSMDL
C ------
*KEEP,H1EVDT.
*
* 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.
*KEEP,FDIFLG.
*KEEP,FWINDS.
* Work bank indices...
*KEND.
* Local arrays, variables.
* Statement function true if Channel might have time-stamp pulse
*KEEP,STFUNCT.
* index of element before row number IROW
* index of L'th element of row number IROW
* L'th integer element of the IROW'th row of bank with index IND
* L'th real element of the IROW'th row of bank with index IND
*KEEP,FTFUNCT.
* Statement functions for RADIAL Chamber data access.
* Using Channel Number J
* Module, Wedge-pair and Z-plane numbers...
* Statement function for obtaining WEDGE numbers(0-47) of
* wires at plus and minus ends of Cell numbers
* Statement function for obtaining IOS wire number (1-36)
* Statement functions for PLANAR Chamber data access.
* Using Channel Number J
* Module, orientation, W-cell and Z-plane numbers...
* IPSMD in range 0:8 Planar module number.
*
* IOS wire number (runs from 0 to 36)
* SB plane numbers (1-72) from cell number
* Module, orientation, wire and (typical) cell number from plane
* number in the range 1-72 (planars, radials and combined)
*KEND.
* Initialisation of bank pointers on first call...
*
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)')
*
*
*
* 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...
* Parameters for time-to-distance relation...
* The (nominal) geometric stagger...
* Number of velocity parameter sets...
* Velocities, knot points, asymmetry corrections etc.
* drift velocity at JK'th knot...
* Asymmetry factor at JK'th knot...
* quadratic correction to S at JK'th knot...
* Wire dependent scale factors for drift velocities...
* Apply wire dependent scale factors.
* Apply near far asymmetries.
* (Beta > 0 => Vfar > Vnear (opposite to planars?))
* 'symmetrised'
* 'far wires'
* 'near wires'
* Min allowed drift time and Tol on max allowed drift
* Numbers for drift-error parameterisation...
* Numbers for radius-error parameterisation...
**----------------------------------------------------------------------
* 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)
CALL BDROP(IW,'FRHC')
INDDUM = MLINK(IW,'FRLC',NBN)
CALL BDROP(IW,'FRLC')
INDDUM = MLINK(IW,'FAUX',NBN)
CALL BDROP(IW,'FAUX')
* Create FRHC bank...
INDRHC = NBANK('FRHC',NBN,2+2*NRFRHC)
CALL VZERO(IW(INDRHC+1), 2+2*NRFRHC)
**
* 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)
*
* Access FRRE bank...
* FRRE bank not found. No data. Make 'zero-length' bank...
INDF = NBANK('FRLC',NBN,2)
* Copy B16 format bank to work bank
CALL BKTOW(IW,'FRRE',NBN,IW,INFRRE,*999)
* |- error making w/bank
* Determine number of hits in FRRE bank
* There were no digis. Should have been no bank! Make 'zero-
* length' FRLC bank...
INDF = NBANK('FRLC',NBN,2)
INDA = NBANK('FAUX',NBN,2)
CALL WDROP(IW,INFRRE)
* Extract Digitisations in radial chambers:-
* Create banks
IFRLC = NBANK('FRLC',NBN,2+NCFRLC*NFRRE)
IFAUX = NBANK('FAUX',NBN,2+NCFAUX*NFRRE)
* Check legal cell...
* Fill FRHC bank...
* Extract wire dependent constants for Channel ICLNUM...
* Basic hit data...
*
*======= Determine radial coordinate by charge divison ===============
*
* Determine alpha. Needed for correction to Drift time
* as well as for radial coordinate. Flag bad charges.
CALL ERRLOG(103, 'W:FRLOCO: Zero charge digi found')
* Choose valid solution, add inner radius and apply
* chg-div distortion correction (linear part only for now)
**
* 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...
* Flag 'premature' hits...
* Scaled drift time (-> approx drift distance in cms)
*
* Apply Time-to-distance relation
*
* Allow for possibly different t-to-d treatment in Monte Carlo
* No t-to-d for M/C at moment...
* Radius-dependent location of first knot...
*
* Velocities and knots for symmetric stuff...
* S1 = S1R
DRIFTS = FRDT2D(TS, V0, V1, S1)
* Velocities and knots for far wires...
* S1 = S1R + STAG
DRIFTF = FRDT2D(TS, V0, V1, S1)
* Velocities and knots for near wires...
* S1 = S1R - STAG
DRIFTN = FRDT2D(TS, V0, V1, S1)
* Assign near/far values to plus/minus drift...
*
* 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.
*
*
* > Radial coordinate error as function of total charge integral
* ELSE
*
* ENDIF
* React to flags. Note that 'old' M/C has different flag
* Structure. This is indicated by a zero value for IFUNNY.
* we have data or 'new' M/C
* FLAG 2 > IFUNNY indicates possible problems with Qt...
* unpack rest of flags...
* > If there was a close preceding hit or long leading edge,
* degrade the DRIFT resolution...
* > 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
* Old format flag in Monte Carlo, extract number of hits...
* ERRRAD = 2.0*ERRRAD
*
* Flag the Really awful hits...(no charge or too early)
* ERRRAD = 2.0*ERRRAD
* ERRRAD = 2.0*ERRRAD
* Set flag to indicate potentential time-stamp pulse:
* Celnum must be one that could have T-p injected:-
* ...and have large '-ve' radius...
* ERRRAD = 2.0*ERRRAD
* Fill row in output bank
C IFRLC = IADROW('FRLC',NBN,NCFRLC,BAR)
CALL UCOPY(BAR,IW(INDCR(IFRLC,1,KDIG)),NCFRLC)
* Quantities for auxilliary bank FAUX
C IFAUX = IADROW('FAUX',NBN,NCFAUX,BAR)
CALL UCOPY(BAR,IW(INDCR(IFAUX,1,KDIG)),NCFAUX)
* Histograms for monitoring... (factor 10 downscale)
CALL SHS(108,0,DRIFTS)
CALL SHS(610,0,TT)
CALL SHS(114,0,FSIG)
CALL SHS(115,0,RADIUS)
CALL SHS(257,0,QSUM)
C IFRLC = IADFIN('FRLC',NBN)
C IFAUX = IADFIN('FAUX',NBN)
CALL WDROP(IW,INFRRE)
CALL ERRLOG(114,'S:FRLOCO: Illegal Channel number!!')
CALL ERRLOG(114,'S:FRLOCO: Cant create bank')
* 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)
C IFAUX = IADFIN('FAUX',NBN)
CALL BDROP(IW,'FAUX')
INDA = NBANK('FAUX',NBN,2)
CALL WDROP(IW,INFRRE)
CALL ERRLOG(104,'S:FRLOCO: Error in FRRE work bank creation')
CALL WDROP(IW,INFRRE)
*