*-- Author : Stephen J. Maxfield 06/03/91
SUBROUTINE FPLOCO
**: FPLOCO.......SM. Allow for near/far asymmetry. Extend FPLC bank,
**: FPLOCO.......SM. get stagger from FGAP.
**: FPLOCO.......SB. Correct for trigger in wrong bunch crossings.
**----------------------------------------------------------------------
**: FPLOCO 30907 RP. Farm changes.
**----------------------------------------------------------------------
**: FPLOCO 30907 SM. Add event T0 from CEVT0.
**: FPLOCO 30907 SM. Bug fix. Drop banks at begin for display.
**----------------------------------------------------------------------
**: FPLOCO 30207 GB. comment lines moved inside the routine
**: FPLOCO 30205 SM. Modifications fror Filter Farm. Add histogram.
**----------------------------------------------------------------------
*==================================================================
* Calculate LOCAL COORDINATES of digitisations in the Planar
* Drift Chambers from contents of FRPE bank and database.
* The drift distance is computed and corrected as described
* in the in-line comments below.
* The following effects are NOT corrected for here:
* * Geometrical displacements and distortions
* * Track angle effects
* However, the parameter DR, needed for the track angle correction,
* is obtained from the F0P8 bank and stored in COMMON FRLORA along
* with the tangent of the Lorentz angle for completeness.
* A temporary bank is created, FPLC containing the results.
* This bank is parallel to the FRPE bank. It is a named bank but
* is not put on the E-list:
*
*! BANKname BANKtype ! Comments
* TABLE FPLC ! Local coordinates and data for hits
* ! in Planar Drift Chambers.
* ! TEMPORARY. Parallel to FRPE bank.
*! ATTributes:
*! -----------
*!COL ATT-name FMT Min Max ! Comments
*!
* 1 ICLNUM I ! Drift cell number
* 2 DRIFT F ! Abs drift distance (cms)
* 3 ERRDRF F ! Error in drift distance (cms)
* 4 ISGNW I ! Bit 0 not used.
* ! Bit 1 not used.
* ! Bit 2 0=>O.K. 1=> dubius drift
* ! Bits3-6 not used.
* ! Bit 7 0=>O.K. 1=> bad timing
* ! don't use.
* 5 CHARGE ! Charge integral
*
*
* 6 DRIFTP ! Drift distance for +side tracks
* 7 DRIFTM ! Drift distance for -side tracks
*
*!
* END TABLE
* NOTES:
*
* The drift error is a parametrised function of distance.
* The error has been inflated where bit 2 is set.
*
* The drift distances are NOT signed.
*
* DRIFT is the drift distance to be used in conjunction with
* the EFFECTIVE stagger when it is not known which side of the
* wire plane the track went. There are then 2 possible space
* points given by:
* EFFECTIVE stagger + DRIFT
* and EFFECTIVE stagger - DRIFT
*
* DRIFTP and DRIFTM should be used when the drift sign is known:
* Geometric Stagger + DRIFTP
* or Geometric Stagger - DRIFTM
*
* >>>> Exception: If drift time comes out negative after
* subtraction of T0, then DRIFTs will be negative.
* They should however be used as described above.
*
*! BANKname BANKtype ! Comments
* TABLE FPHC ! 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 IFRPE I ! Pointer to 1st hit in FRPE/FPLC
*!
* END TABLE
*======================================================================
* bank number forvarious banks.
* Locators for stuff in F0P8 bank (overall constants)
* Locators for stuff in F1PA bank (wire-by-wire constants)
* Locators for stuff in FCP1 bank (time-to-distance run dependent)
* Locators for stuff in FCP2 bank (resolution function)
* Parameter for scaling microns->cms.
*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.
* Common for time-to-distance relation
* Local arrays, variables.
* Local arrays, variables.
*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.
IQFRPE = NAMIND('FRPE')
IQFTDC = NAMIND('FTDC')
IQF0P8 = NAMIND('F0P8')
IQF1PA = NAMIND('F1PA')
IQFCP1 = NAMIND('FCP1')
IQFCP2 = NAMIND('FCP2')
IQFGAP = NAMIND('FGAP')
CALL BKFMT('FPLC','2I,(I,2F,I,3F)')
CALL BKFMT('FPHC','2I,(2I)')
CALL BKFMT('FTT0','2I,(F,I)')
*
*
*
* Hit database to update overall (F0P8) and
* wire-by-wire (F1P8) constants.
*
CALL UGTBNK('F0P8',IND)
CALL UGTBNK('F1PA',IND)
CALL UGTBNK('FCP1',IND)
CALL UGTBNK('FCP2',IND)
CALL UGTBNK('FGAP',IND)
* Extract needed overall constants...
* Extract drift velocity parameters...
* Geometric Stagger...
* Geometric Stagger...
* Write(6,*) 'Stagger:', KMOD, PSTAGG(KMOD)
*Run validity number for check...
*> outer-far, inner-far, outer-symm, inner-symm, outer-near, inner-near
*> outer-far, inner-far, outer-symm, inner-symm, outer-near, inner-near
* for this run...
* fiducial cuts...
* Extract resolution parameters...
* Correction parameter for track angle effect
*---------------------------------------------------------
* Normal Event processing...
* Check if old FPHC and FPLC banks exist. If so drop them...
INDDUM = MLINK(IW,'FPHC',NBN)
CALL BDROP(IW,'FPHC')
INDDUM = MLINK(IW,'FPLC',NBN)
CALL BDROP(IW,'FPLC')
INDDUM = MLINK(IW,'FTT0',NBN)
CALL BDROP(IW,'FTT0')
* Create FPHC bank...
INDPHC = NBANK('FPHC',NBN,2+2*NRFPHC)
CALL VZERO(IW(INDPHC+1), 2+2*NRFPHC)
* Get Event Time zero.
* CALL CEVT0(TFTDC, LTTYP)
* Apply correction for wrong bunch crossing
CALL T0GET (ITRGT0)
*
* Access FRPE bank...
* FRPE bank not found. No data. Make 'zero=length FPLC...
INDF = NBANK('FPLC',NBN,2)
INDF = NBANK('FTT0',NBN,2)
CALL BLIST(IW,'E+','FTT0')
* Copy B16 format bank to work bank
CALL BKTOW(IW,'FRPE',NBN,IW,INFRPE,*999)
* error making w/bank
* Determine number of hits in FRPE bank
* There were no digis. Should have been no bank!
* Make 'zero=length FPLC...
INDF = NBANK('FPLC',NBN,2)
CALL WDROP(IW,INFRPE)
INDF = NBANK('FTT0',NBN,2)
CALL BLIST(IW,'E+','FTT0')
* Extract Digitisations in planar chambers:-
* Create banks
IFPLC = NBANK('FPLC',NBN,2+NCFPLC*NFRPE)
* Fix for swapped channels in '95 data
* Fill FPHC bank...
* Drift time in ticks...
* Extract wire dependent constants for Channel ICLNUM...
*
* Compute drift distance...
*
* Subtract Tzeros.
*
* Fine correction for T0 difference on inner/outer wires - real data onl
*
* Apply time-to-distance function...
DRIFT = FPLT2D(TT, 0.0, ICLNUM)
DRIFTN= FPLT2D(TT, 1.0, ICLNUM)
DRIFTF= FPLT2D(TT, -1.0, ICLNUM)
* T-to-d for M/C...convert ticks to ns...
* ...and microns to cms (v in microns/ns)
* ...and no asymmetry
* Is the wire near or far for +ve, -ve drift?
* Get stagger of wire. Alternating sign but stagger of 1st
* wire not same in all orientations...
* This means hits with +drift are near, -drift far...
* Other way round...
* Histograms for monitoring... (factor 10 downscale)
CALL SHS(109,0,DRIFT)
CALL SHS(612,0,TT)
IF (NFRPE.GE.2000) CALL SHS(616,0,TT)
* Determine errors. sig**2=e0**2 +d.e1**2 + e3**2.exp(-e4*d)
* Drift is in cms. Error is converted back to cms.
* only react to flags if 'new model' Qt's...
* unpack rest of flags...
* DOS sum of this hit...
* Dist to prev hit...
* ISPL = IAND( IFLAG1, 31)
* Relinearised pedestal level...
* DOS sum of previous hit.
* IDPR = IAND( IFLAG1, 31)
* Dist from beginning of cluster...
* Num adjacent bins above DOS threshold (leading edge)...
* Number of previous hits in the cluster...
* React to flags here.
* Old format flag in Monte Carlo, extract number of hits...
* Fill row in output bank
C IFPLC = IADROW('FPLC',NBN,NCFPLC,BAR)
CALL UCOPY(BAR,IW(INDCR(IFPLC,1,KDIG)),NCFPLC)
INFTT0 = NBANK('FTT0',0,4)
CALL ERRLOG(113,'S:FPLOCO: Cant create FTT0 bank')
CALL BLIST(IW,'E+','FTT0')
CALL SHS(650,0,TAVG)
CALL SHS(651,0,TAVG)
CALL SHS(652,0,TAVG)
CALL SHS(653,0,TAVG)
CALL SHS(654,0,TAVG-CJCT0)
CALL SHS(655,0,TAVG-CJCT0)
CALL SHS(656,0,TAVG-CJCT0)
CALL SHD(658,0,TAVG,CJCT0)
CALL SHS(657,0,TAVG-CJCT0)
CALL SHD(659,0,TAVG,CJCT0)
C IFPLC = IADFIN('FPLC',NBN)
CALL WDROP(IW,INFRPE)
* Channels were swapped at least in '94 and '95, and probably through '9
* Fix for swapped channels in '95 data
IF (JLAST.GT.0) CALL FPFIX(JFIRST,JLAST)
CALL ERRLOG(114,'S:FPLOCO: Illegal Channel number!!')
CALL ERRLOG(115,'S:FPLOCO: Cant create bank')
* FPLC bank may be partially made. Finish it, drop it and
* make empty version...
C IFPLC = IADFIN('FPLC',NBN)
CALL BDROP(IW, 'FPLC')
INDF = NBANK('FPLC',NBN,2)
CALL WDROP(IW,INFRPE)
CALL BDROP(IW, 'FTT0')
INDF = NBANK('FTT0',NBN,2)
CALL BLIST(IW,'E+','FTT0')
CALL ERRLOG(105,'S:FPLOCO: Error in FRPE work bank creation')
CALL WDROP(IW,INFRPE)
*