*-- 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. PARAMETER(NBN=0) PARAMETER(NCFPLC=7) PARAMETER(NCFPHC=2) PARAMETER(NRFPHC=1152) * Locators for stuff in F0P8 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) * Locators for stuff in F1PA bank (wire-by-wire constants) PARAMETER(IT0=1) * Locators for stuff in FCP1 bank (time-to-distance run dependent) PARAMETER(IVEL=2) PARAMETER(IXPT=10) PARAMETER(IBETA=16) PARAMETER(ISTAG=21) PARAMETER(IDRMAX=22) PARAMETER(ITBMIN=23) * Locators for stuff in FCP2 bank (resolution function) PARAMETER(IERRD0=2) PARAMETER(IERRD1=3) PARAMETER(IERRD2=4) PARAMETER(IERRD3=5) PARAMETER(IFUN=6) * Parameter for scaling microns->cms. PARAMETER(EMTOC=10000.) *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. * Common for time-to-distance relation COMMON/T2DISP/ VEL(24), XPT(18) * Local arrays, variables. DIMENSION PSTAGG(0:8) * Local arrays, variables. DIMENSION BAR(NCFPLC), IAR(NCFPLC) EQUIVALENCE(BAR(1), IAR(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. DATA FIRST/.TRUE./ DATA NEGRUN /-1/ IF(FIRST) THEN FIRST = .FALSE. 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)') ENDIF * * IF(BEGRUN .OR. NCCRUN .NE.NEGRUN) THEN NEGRUN = NCCRUN * * 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... IND0P8 = IW(IQF0P8) TZER = RBTAB(IND0P8,ITZER,1) * Extract drift velocity parameters... INDCP1 = IW(IQFCP1) INDGAP = IW(IQFGAP) * Geometric Stagger... * Geometric Stagger... NMODP = IW(INDGAP+3) KIND = INDGAP + IW(INDGAP+1) + 1 DO 2 KMOD = 0, NMODP-1 PSTAGG(KMOD) = RW(KIND+5) KIND = KIND + IW(KIND+1) + 1 * Write(6,*) 'Stagger:', KMOD, PSTAGG(KMOD) 2 CONTINUE STAG = ABS(PSTAGG(0)) *Run validity number for check... IVALR = IBTAB(INDCP1, 1, 1) DO 10 KP = 1, 4 BETA = RBTAB(INDCP1, IBETA +KP, 1) *> outer-far, inner-far, outer-symm, inner-symm, outer-near, inner-near VEL(KP) = RBTAB(INDCP1, IVEL +KP, 1)*(1.0- BETA) VEL(KP+4) = RBTAB(INDCP1, IVEL+4+KP, 1)*(1.0- BETA) VEL(KP+8) = RBTAB(INDCP1, IVEL +KP, 1) VEL(KP+12) = RBTAB(INDCP1, IVEL+4+KP, 1) VEL(KP+16) = RBTAB(INDCP1, IVEL +KP, 1)*(1.0+ BETA) VEL(KP+20) = RBTAB(INDCP1, IVEL+4+KP, 1)*(1.0+ BETA) 10 CONTINUE DO 12 KP = 1, 6 *> outer-far, inner-far, outer-symm, inner-symm, outer-near, inner-near XPT(KP) = RBTAB(INDCP1, IXPT + KP, 1)+ STAG XPT(KP+6) = RBTAB(INDCP1, IXPT + KP, 1) XPT(KP+12)= RBTAB(INDCP1, IXPT + KP, 1)- STAG 12 CONTINUE *for this run... VDRFT = RBTAB(INDCP1, IVEL , 1) * fiducial cuts... DRMAX = RBTAB(INDCP1, IDRMAX, 1) TBMIN = RBTAB(INDCP1, ITBMIN, 1) * Extract resolution parameters... INDCP2 = IW(IQFCP2) ERRD0 = RBTAB(INDCP2, IERRD0, 1) ERRD1 = RBTAB(INDCP2, IERRD1, 1) ERRD2 = RBTAB(INDCP2, IERRD2, 1) ERRD3 = RBTAB(INDCP2, IERRD3, 1) IFUNNY = IBTAB(INDCP2, IFUN, 1) * Correction parameter for track angle effect DTANGP = RBTAB(IND0P8,IDR,1) ENDIF *--------------------------------------------------------- * Normal Event processing... * Check if old FPHC and FPLC banks exist. If so drop them... INDDUM = MLINK(IW,'FPHC',NBN) IF(INDDUM.NE.0) THEN CALL BDROP(IW,'FPHC') ENDIF INDDUM = MLINK(IW,'FPLC',NBN) IF(INDDUM.NE.0) THEN CALL BDROP(IW,'FPLC') ENDIF INDDUM = MLINK(IW,'FTT0',NBN) IF(INDDUM.NE.0) THEN CALL BDROP(IW,'FTT0') ENDIF * Create FPHC bank... INDPHC = NBANK('FPHC',NBN,2+2*NRFPHC) CALL VZERO(IW(INDPHC+1), 2+2*NRFPHC) IW(INDPHC+1) = NCFPHC IW(INDPHC+2) = NRFPHC * Get Event Time zero. TFTDC = 0.0 * CALL CEVT0(TFTDC, LTTYP) * Apply correction for wrong bunch crossing CALL T0GET (ITRGT0) TZERO = TZER + TFTDC + 500.0*FLOAT(ITRGT0) * * Access FRPE bank... IND = IW(IQFRPE) IF(IND .EQ.0) THEN * FRPE bank not found. No data. Make 'zero=length FPLC... INDF = NBANK('FPLC',NBN,2) IW(INDF+1) = NCFPLC IW(INDF+2) = 0 INDF = NBANK('FTT0',NBN,2) IW(INDF+1) = 2 IW(INDF+2) = 0 CALL BLIST(IW,'E+','FTT0') RETURN ENDIF * Copy B16 format bank to work bank INFRPE=0 CALL BKTOW(IW,'FRPE',NBN,IW,INFRPE,*999) * error making w/bank * Determine number of hits in FRPE bank NFRPE = IW(INFRPE+2) IF(NFRPE.LE.0) THEN * There were no digis. Should have been no bank! * Make 'zero=length FPLC... INDF = NBANK('FPLC',NBN,2) IW(INDF+1) = NCFPLC IW(INDF+2) = 0 CALL WDROP(IW,INFRPE) INDF = NBANK('FTT0',NBN,2) IW(INDF+1) = 2 IW(INDF+2) = 0 CALL BLIST(IW,'E+','FTT0') RETURN ENDIF IND1PA = IW(IQF1PA) * Extract Digitisations in planar chambers:- ICLOLD = -1 * Create banks IFPLC = NBANK('FPLC',NBN,2+NCFPLC*NFRPE) IF (IFPLC.LE.0) GOTO 997 IW(IFPLC+1) = NCFPLC IW(IFPLC+2) = NFRPE JFIRST = 0 JLAST = 0 TAVG = 0. NTT = 0 DO 1 KDIG = 1, NFRPE ICLNUM= IBTAB(INFRPE,1,KDIG) IF(ICLNUM .LT. 0 .OR. ICLNUM .GT. 1151) THEN GO TO 998 ENDIF * Fix for swapped channels in '95 data IF ((ICLNUM/128).EQ.5) THEN IWCELL = MOD(ICLNUM,128)/4 IF (IWCELL.GE.20 .AND. IWCELL.LE.23) THEN IF (JFIRST.LE.0) JFIRST = KDIG JLAST = KDIG ENDIF ENDIF * Fill FPHC bank... IF(ICLNUM .NE. ICLOLD) THEN IW(INDPHC+ICLNUM*2 + 3) = 1 IW(INDPHC+ICLNUM*2 + 4) = KDIG ICLOLD = ICLNUM ELSE IW(INDPHC+ICLNUM*2 + 3) = IW(INDPHC+ICLNUM*2 + 3) + 1 ENDIF * Drift time in ticks... DTIME = FLOAT(IBTAB(INFRPE,2,KDIG)) CHARGE= FLOAT(IBTAB(INFRPE,3,KDIG)) IFLAG0= IBTAB(INFRPE,4,KDIG) IFLAG1= IBTAB(INFRPE,5,KDIG) IFLAG2= IBTAB(INFRPE,6,KDIG) * Extract wire dependent constants for Channel ICLNUM... T0 = RBTAB(IND1PA,IT0 ,ICLNUM+1) * * Compute drift distance... * * Subtract Tzeros. TT = DTIME - (TZERO + T0) * * Fine correction for T0 difference on inner/outer wires - real data onl * IF(.NOT.MONTE) THEN IF (MOD(ICLNUM,4).EQ.0 .OR. MOD(ICLNUM,4).EQ.3) THEN TT = TT - 0.48*500./96. ELSE TT = TT + 0.48*500./96. ENDIF ENDIF IF(TT.LT.TBMIN) THEN IBADT = 1 ELSE IBADT = 0 IF (TT.LT.5000.) THEN TAVG = TAVG + TT NTT = NTT + 1 ENDIF ENDIF * Apply time-to-distance function... IF(.NOT.MONTE) THEN DRIFT = FPLT2D(TT, 0.0, ICLNUM) DRIFTN= FPLT2D(TT, 1.0, ICLNUM) DRIFTF= FPLT2D(TT, -1.0, ICLNUM) ELSE * T-to-d for M/C...convert ticks to ns... TNS = TT * 0.192 * ...and microns to cms (v in microns/ns) DRIFT = TNS*VEL(1)*0.0001 * ...and no asymmetry DRIFTN= DRIFT DRIFTF= DRIFT ENDIF * 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... PSTG = PSTAGG(IPSMD(ICLNUM)) * ( (-1)**IPZPL(ICLNUM) ) IF(PSTG .GT. 0.0) THEN * This means hits with +drift are near, -drift far... DRIFTP = DRIFTN DRIFTM = DRIFTF ELSE * Other way round... DRIFTP = DRIFTF DRIFTM = DRIFTN ENDIF * Histograms for monitoring... (factor 10 downscale) IF (MOD(NEVENT,10).EQ.0) THEN CALL SHS(109,0,DRIFT) CALL SHS(612,0,TT) ENDIF 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. ISGNW = 0 IF(DRIFT .LT. DRMAX) THEN ERRDRF = ERRD0**2 + DRIFT*ERRD1*ERRD1 + + ERRD2*ERRD2*EXP(-ERRD3*DRIFT) ERRDRF = SQRT(ERRDRF) / EMTOC ELSE ERRDRF = DRIFT-DRMAX ISGNW = IOR(ISGNW,128) ENDIF IF(IFUNNY.NE.0) THEN * only react to flags if 'new model' Qt's... IF(IFLAG1 .NE.1) THEN IF(IFLAG2 .GT. IFUNNY) THEN * unpack rest of flags... * DOS sum of this hit... IDOS = IAND( IFLAG0,255) * Dist to prev hit... * ISPL = IAND( IFLAG1, 31) ISPL = ISHFT(IFLAG0, -8) ISPL = IAND( ISPL, 255) * Relinearised pedestal level... IPED = IAND( IFLAG1,255) * DOS sum of previous hit. * IDPR = IAND( IFLAG1, 31) IDPR = ISHFT(IFLAG1, -8) IDPR = IAND( IDPR, 255) * Dist from beginning of cluster... IDCS = IAND( IFLAG2,127) * Num adjacent bins above DOS threshold (leading edge)... LHIT = ISHFT(IFLAG2, -7) LHIT = IAND( LHIT, 15) * Number of previous hits in the cluster... INDX = ISHFT(IFLAG2,-11) INDX = IAND( INDX, 15) * React to flags here. 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 ENDIF ENDIF IF(IBADT .EQ. 1) THEN ISGNW = IOR(ISGNW,128) ENDIF * Fill row in output bank IAR(1) = ICLNUM BAR(2) = DRIFT BAR(3) = ERRDRF IAR(4) = ISGNW BAR(5) = CHARGE BAR(6) = DRIFTP BAR(7) = DRIFTM C IFPLC = IADROW('FPLC',NBN,NCFPLC,BAR) CALL UCOPY(BAR,IW(INDCR(IFPLC,1,KDIG)),NCFPLC) 1 CONTINUE IF (NTT.GT.0) THEN TAVG = TAVG/FLOAT(NTT) ELSE TAVG = -10000. ENDIF INFTT0 = NBANK('FTT0',0,4) IF (INFTT0.GT.0) THEN IW(INFTT0+1) = 2 IW(INFTT0+2) = 1 RW(INFTT0+3) = TAVG IW(INFTT0+4) = NTT ELSE CALL ERRLOG(113,'S:FPLOCO: Cant create FTT0 bank') ENDIF CALL BLIST(IW,'E+','FTT0') CALL SHS(650,0,TAVG) IF (NTT.LE.500) THEN CALL SHS(651,0,TAVG) ELSEIF (NTT.LE.2000) THEN CALL SHS(652,0,TAVG) ELSE CALL SHS(653,0,TAVG) ENDIF INCJCC = NLINK('CJCC',0) IF (INCJCC.GT.0 .AND. IW(INCJCC+2).GT.0) THEN CJCT0 = RBTAB(INCJCC,2,1) CALL SHS(654,0,TAVG-CJCT0) IF (NTT.LE.500) THEN CALL SHS(655,0,TAVG-CJCT0) ELSEIF (NTT.LE.2000) THEN CALL SHS(656,0,TAVG-CJCT0) CALL SHD(658,0,TAVG,CJCT0) ELSE CALL SHS(657,0,TAVG-CJCT0) CALL SHD(659,0,TAVG,CJCT0) ENDIF ENDIF C IFPLC = IADFIN('FPLC',NBN) CALL WDROP(IW,INFRPE) * Channels were swapped at least in '94 and '95, and probably through '9 IF (MONTE .OR. NCCRUN.LT.70000) RETURN * Fix for swapped channels in '95 data IF (JLAST.GT.0) CALL FPFIX(JFIRST,JLAST) RETURN 998 CONTINUE CALL ERRLOG(114,'S:FPLOCO: Illegal Channel number!!') GOTO 996 997 CONTINUE CALL ERRLOG(115,'S:FPLOCO: Cant create bank') 996 CONTINUE * 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) IW(INDF+1) = NCFPLC IW(INDF+2) = 0 CALL WDROP(IW,INFRPE) CALL BDROP(IW, 'FTT0') INDF = NBANK('FTT0',NBN,2) IW(INDF+1) = 2 IW(INDF+2) = 0 CALL BLIST(IW,'E+','FTT0') RETURN 999 CONTINUE CALL ERRLOG(105,'S:FPLOCO: Error in FRPE work bank creation') CALL WDROP(IW,INFRPE) RETURN END *