*-- Author : Stephen Burke SUBROUTINE FFCORR(JPL,SVEC,ZNOM,VXYZ,DEVT0,BZ,DCORR) ********************************************************************** * * * Calculate the corrections for track angle, time-of-flight, * * signal propagation time and magnetic field variation. * * * * INPUT: * * JPL is the plane number * * SVEC is the state vector at plane JPL * * ZNOM is the nominal z vertex * * VXYZ is the event vertex position * * DEVT0 is the event T0 correction * * BZ is the z component of the field * * * OUTPUT: * * DCORR is the correction to the drift distance * * * ********************************************************************** DOUBLE PRECISION SVEC(5) DIMENSION VXYZ(3),R(3) * Estimates for Vdrift from SJM for '94 running; variation is less than PARAMETER (VDRFTP=0.003234,VDRFTR=0.003749) * Nominal drift velocity = 35 km/sec; c = 30 cm/nsec PARAMETER (VDRIFT=0.0035,VTOF=30.0,VPROP=30.0) * Some nominal geometry PARAMETER (ZPNOM=175.0,ZRNOM=200.0,RPLAN=80.0,RPMID=60.0) * Nominal magnetic field PARAMETER (BPNOM=11.5634,BRNOM=11.5875) * Estimates for radial Lorenz angle from SJM for '94 running; error is 1 PARAMETER (S2LORP=0.4132,S2LORR=0.3663) *KEEP,FKNPL. CHARACTER*5 CKDBG PARAMETER (CKDBG='FKDBG') PARAMETER (NPL=72) LOGICAL LTRUE,LFIRST,LTRPL,LTRPLD DOUBLE PRECISION TRUE,RTRUE,CHITRU,SPRO,CPRO,SFIL,CFIL &, SSMT,CSMT,SSMTR,CSMTR,DPRO,CBPRO,QPRO,QGAIN &, RPRO,CRPRO,RFIL,CRFIL,RSMT,CRSMT,CHIFIL,CHISMT * * Per-track values can go in H1WORK; note that LTRUE and LFIRST must * be set at least per event. * * This is about 36k words long; the remaining common blocks are * about 3.6k in total. Some of this could be in /H1WORK/, but the * blocks would have to be reorganised. * COMMON /H1WORK/ * /FKPROJ/ & SPRO(5,NPL),CPRO(5,5,NPL) * /FKFILT/ &, SFIL(5,NPL),CFIL(5,5,NPL) * /FKSMTH/ &, SSMT(5,NPL),CSMT(5,5,NPL) &, SSMTR(5,NPL),CSMTR(5,5,NPL) * /FKINT/ &, DPRO(5,5,NPL),CBPRO(5,5,NPL),QPRO(5,5,NPL) &, QGAIN(5,5,NPL),IAPROX,LFIRST * /FKRSID/ &, RPRO(2,NPL),CRPRO(2,2,NPL),RFIL(2,NPL) &, CRFIL(2,2,NPL),RSMT(2,NPL),CRSMT(2,2,NPL) &, CHIFIL(NPL),CHISMT(NPL) * /FKTRUE/ &, TRUE(5,NPL),RTRUE(5,NPL),CHITRU(NPL),LTRUE * /FKDBG/ &, LTRPL(NPL),LTRPLD(NPL) *KEEP,FKCONS. DOUBLE PRECISION ZPL,DZPL,RADL COMMON /FKCONS/ ZPL(NPL),DZPL(NPL),RADL(NPL) *KEEP,FKPROJ. *KEEP,FKSMTH. *KEEP,FKRSID. *KEEP,FKTRUE. *KEEP,FKMEAS. DOUBLE PRECISION WMES,CMES,HMES COMMON /FKMEAS/ WMES(2,NPL),CMES(2,2,NPL),HMES(2,2,NPL),MES(NPL) *KEEP,FFSTEE. PARAMETER (NFT=72) LOGICAL LRISV,LWMAP,LGRAPH,LTRUTH REAL DSX,DSY,DSQOP,DSTTH,DSPHI,PMCUT,PCUT,CHPCUT &, QOPMAX,THEMAX,RFTMIN,RFTMAX,CEMAX COMMON /FFSTEE/ DSX,DSY,DSQOP,DSTTH,DSPHI &, PMCUT,IDIAG,JPLRSV,LRISV,LWMAP(NFT),JPLMAX &, IRP(NPL),JPLFT(NPL),JFTPL(NFT) &, LUNGKS,IWKGKS,IDGKS,LUNHB,LUNGKM,IWKGKM,IDGKM &, LGRAPH,LTRUTH,IHFF,IHFK,ISRJCT,PCUT,CHPCUT &, QOPMAX,THEMAX,RFTMIN,RFTMAX,CEMAX *KEEP,FFGEO. COMMON /FFGEO/ INDG1(2),INDLC(2),IDIGI(NPL) *KEEP,FFDBG. CHARACTER*5 CFDBG CHARACTER*6 CFKDBG PARAMETER (CFDBG='FFDBG',CFKDBG='FFKDBG') PARAMETER (NTRACK=1000) COMMON /FFDBG/ ITRTR(2,NTRACK),ITRNF(5,NTRACK),JTRTR *KEEP,FKDBG. *KEEP,FKINT. *KEEP,FRLORA. REAL ATLORR, ATLORP, DTANGR, DTANGP COMMON /FRLORA/ ATLORR, ATLORP, DTANGR, DTANGP *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,FTANG. * Statement functions for track angle corrections... * (assumes COMMON FRLORA present) REAL DRIFT FTANGR(DRIFT, TANT, PHI, SINWP, COSWP) = + MIN(DTANGR, DRIFT) * ( SQRT( 1.0 + + ((SIN(PHI) * COSWP - COS(PHI) * SINWP)**2) * + (TANT**2)) - 1.0) * FTANGP(DRIFT, TANT, PHI, SINWP, COSWP) = + MIN(DTANGP, DRIFT) * ( SQRT( 1.0 + + ((SIN(PHI) * COSWP - COS(PHI) * SINWP)**2) * + (TANT**2)) - 1.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,STFCLW. * statement functions acting on the BOS COMMON LW * index of element before row number LWROW LNDR(LND,LWROW) = LND + 2 + LW(LND+1)*(LWROW-1) * index of L-th element of row number LWROW LNDCR(LND,L,LWROW)=LNDR(LND,LWROW)+L * L-th integer element of the LWROW'th row in bank with index LND LBTAB(LND,L,LWROW)=LW(LNDCR(LND,L,LWROW)) * L-th real element of the LWROW'th row in bank with index LND SBTAB(LND,L,LWROW)=SW(LNDCR(LND,L,LWROW)) * *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. ********************************************************************** * * Time-of-flight correction * R(1) = SVEC(1) R(2) = SVEC(2) R(3) = ZPL(JPL) * This is rather arbitrary ... IF (IRP(JPL).EQ.1) THEN ZMID = ZPNOM - ZNOM DTOF = VDRFTP*(ZMID - VDIST(R,VXYZ,3))/VTOF DDEVT = VDRFTP*DEVT0 ELSE ZMID = ZRNOM - ZNOM DTOF = VDRFTR*(ZMID - VDIST(R,VXYZ,3))/VTOF DDEVT = VDRFTR*DEVT0 ENDIF * * Track-angle correction * SINWP = HMES(2,2,JPL) COSWP = HMES(2,1,JPL) TANTH = SVEC(4) PHI = SVEC(5) JDIG = ABS(IDIGI(JPL)) DRIFT = RBTAB(INDLC(IRP(JPL)),2,JDIG) IF (IRP(JPL).EQ.1) THEN DTRANG = FTANGP(DRIFT,TANTH,PHI,SINWP,COSWP) ELSE DTRANG = FTANGR(DRIFT,TANTH,PHI,SINWP,COSWP) ENDIF * Allow for negative drifts! IF (DTRANG.LT.0.) DTRANG = 0. * * Propagation time correction (planars only) * IF (IRP(JPL).EQ.1) THEN * Predicted (absolute) drift and radius W = ABS(SINWP*R(1) - COSWP*R(2)) RR = COSWP*R(1)+ SINWP*R(2) IF (W.LT.RPLAN) THEN CORD = SQRT(RPLAN**2 - W**2) ELSE CORD = 0.0 ENDIF IWCELL = IPWCL(IBTAB(INDLC(1),1,JDIG)) IF (IWCELL.GT.15) THEN SIGN = -1.0 ELSE SIGN = 1.0 ENDIF DPROP = VDRFTP*(RPMID - CORD - SIGN*RR)/VPROP ELSE DPROP = 0. ENDIF * * Magnetic field correction * IF (IRP(JPL).EQ.1) THEN BMID = BPNOM - BZ BRAT = BMID*S2LORP/BPNOM ELSE BMID = BRNOM - BZ BRAT = BMID*S2LORR/BRNOM ENDIF DDBF = DRIFT*BRAT DCORR = DDEVT + DTOF + DTRANG + DPROP + DDBF IF (IHFF/1000.LE.0) RETURN CALL HFILL(100+IRP(JPL),DTRANG,0.,1.) TRANG = 1. + TANTH**2*(SIN(PHI)*COSWP - COS(PHI)*SINWP)**2 IF (TRANG.GE.1.) THEN TRANG = ACOS(1./SQRT(TRANG)) ELSE TRANG = -1. ENDIF CALL HFILL(102+IRP(JPL),TRANG,0.,1.) CALL HFILL(105,DDEVT,0.,1.) CALL HFILL(105+IRP(JPL),DTOF,0.,1.) IF (IRP(JPL).EQ.1) CALL HFILL(108,DPROP,0.,1.) CALL HFILL(108+IRP(JPL),DDBF,0.,1.) CALL HFILL(110+IRP(JPL),BMID,0.,1.) CALL HFILL(112+IRP(JPL),DCORR,0.,1.) RETURN END *