*-- 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) *