*-- Author : Stephen Burke SUBROUTINE FFSTART(SSTART,CSTART,ZSTART) ********************************************************************** * * * Set up the starting vector for the Kalman filter * * * * SSTART and CSTART give the initial state vector, and its * * covariance, at z = ZSTART. * * * ********************************************************************** DOUBLE PRECISION SSTART(5),CSTART(5,5),ZSTART DOUBLE PRECISION DZ,DTRAN(5,5),CTEMP(5,5) *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,FKCNTL. COMMON /FKCNTL/ LUN,IPR,ITR,IPL,JSTART,JSTOP,JLAST,JSTEP *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,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. ********************************************************************** * Set up the start and end points IF (LPOINT .OR. LBLOCK) THEN JSTOP = 1 JLAST = JPLMAX ELSE JSTOP = 0 DO 100 JPL=1,JPLMAX IF (LMES(JPL)) THEN IF (JSTOP.EQ.0) JSTOP = JPL JLAST = JPL ENDIF 100 CONTINUE ENDIF IF (LRISV) THEN JSTART = JFTPL(JPLRSV) IF (JSTART.LE.0) THEN CALL ERRLOG(391,'F:FFSTART: Starting plane mapped out') JSTART = JPLMAX/2 ENDIF ELSE JSTART = JSTOP ENDIF * Swim to 1st plane (ignoring MS) DZ = ZPL(JSTART) - ZSTART CALL FKTRAN(DZ,ZSTART,SSTART,SPRO(1,JSTART),DTRAN) CALL FKMUL(CSTART,DTRAN,CPRO(1,1,JSTART)) LPRO(JSTART) = .TRUE. IF (LRISV) RETURN * Fix for low-momentum tracks FAC = 1. IF (ABS(SPRO(3,JSTART)).GT.1.0) THEN FAC = FAC + (ABS(SPRO(3,JSTART)) - 1.0)*10.0 IF (FAC.GT.100.) FAC = 100. ENDIF * Starting errors - these are just fixed at the moment CALL UCOPY(CPRO(1,1,JSTART),CTEMP,50) CALL VZERO(CPRO(1,1,JSTART),50) CPRO(1,1,JSTART) = MAX(CTEMP(1,1),DBLE(DSX**2)) CPRO(2,2,JSTART) = MAX(CTEMP(2,2),DBLE(DSY**2)) CPRO(3,3,JSTART) = MAX(CTEMP(3,3),DBLE(DSQOP**2))*FAC**2 CPRO(4,4,JSTART) = MAX(CTEMP(4,4),DBLE(DSTTH**2)) CPRO(5,5,JSTART) = MAX(CTEMP(5,5),DBLE(DSPHI**2)) RETURN END *