*-- Author : Stephen Burke SUBROUTINE FFFILL(JTR,LFAILP,LFAILR) ********************************************************************** * * * Fill the Kalman filter common blocks with the hit information * * * * INPUT: * * JTR is the FTUR track number * * * * OUTPUT: * * LFAILP is .TRUE. if the planar digi pointers are corrupt * * LFAILR is .TRUE. if the radial digi pointers are corrupt * * * ********************************************************************** LOGICAL LFAILP,LFAILR *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,FKFLAG. LOGICAL LPRO,LFIL,LSMT,LMES,LRAD,LRPRO,LRFIL,LRSMT,LPOINT,LBLOCK COMMON /FKFLAG/ LPRO(NPL),LFIL(NPL),LSMT(NPL),LMES(NPL) &, LRAD(NPL),LRPRO,LRFIL,LRSMT,LPOINT,LBLOCK *KEEP,FKCONS. DOUBLE PRECISION ZPL,DZPL,RADL COMMON /FKCONS/ ZPL(NPL),DZPL(NPL),RADL(NPL) *KEEP,FKPROJ. *KEEP,FKSMTH. *KEEP,FKRSID. *KEEP,FKTRUE. *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,FFWBI. * Work bank indices (note that INDKTR is *NOT* a work bank index!) PARAMETER (NWBI=10) COMMON /FFWBI/ INDRSX(2),INDX(2),INDKX(2),INDPUR &, INDKTR,INDKTX,INDTPR *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. ********************************************************************** DO 100 JPL=1,JPLMAX * No measurements yet LMES(JPL) = .FALSE. ZPL(JPL) = SBTAB(INDG1(IRP(JPL)),4,ICELSB(JPLFT(JPL))+1) LTRPL(JPL) = .TRUE. LTRPLD(JPL) = .TRUE. 100 CONTINUE * * Loop over hits, filling the common blocks * LFAILP = .TRUE. LFAILR = .FALSE. NRAD = IBTAB(INDPUR,1,JTR) JDIGR = IBTAB(INDPUR,2,JTR) NPLAN = IBTAB(INDPUR,3,JTR) JDIGP = IBTAB(INDPUR,4,JTR) IF (NPLAN.GT.36) RETURN DO 200 IDIG=1,NPLAN IF (JDIGP.LE.0 .OR. JDIGP.GT.IW(INDX(1)+2)) RETURN CALL FFPLAN(JDIGP) JDIGP = IBTAB(INDX(1),1,JDIGP) 200 CONTINUE IF (JDIGP.NE.IBTAB(INDPUR,4,JTR)) RETURN LFAILP = .FALSE. LFAILR = .TRUE. IF (NRAD.GT.36) RETURN DO 300 IDIG=1,NRAD IF (JDIGR.LE.0 .OR. JDIGR.GT.IW(INDX(2)+2)) RETURN CALL FFRAD(JDIGR,NPLAN) JDIGR = IBTAB(INDX(2),1,JDIGR) 300 CONTINUE IF (JDIGR.EQ.IBTAB(INDPUR,2,JTR)) LFAILR = .FALSE. RETURN END *