*-- Author : Stephen Burke LOGICAL FUNCTION FKHUNT(JPL,S,C,IERR) *-----------------------------------------Updates 27/07/93------- **: FFHUNT 30907 RP. Farm changes. *-----------------------------------------Updates 03/05/93------- **: FKHUNT 30907 SB. Extra argument to FFRAD. *-----------------------------------------Updates 07/02/92------- **: FKHUNT 30205.SB. Remove unused HCHI variable. **: FKHUNT 30205.SB. Initialise IFAIL1 to please UNDEF. *-----------------------------------------Updates 24/01/92------- **: FKHUNT 30205.SB. Check for wrong drift sign in debug mode. *-----------------------------------------Updates---------------- ********************************************************************** * * * Look for a new digitisation * * * * ERROR CONDITIONS; * * * * IERR = 0 ; normal termination * * -> IERR = 101 ; invalid probability cut * * -> IERR = 103 ; invalid value in MES array * * -> IERR = 104 ; invalid value in MES array, or internal error * * IERR = 12 ; covariance of residuals not positive definite * * * * -> Fatal errors * * * * Fatal errors all give a return value of .FALSE., and no changes * * are made; they are consequently recoverable. * * * ********************************************************************** IMPLICIT DOUBLE PRECISION (A-H,O-Z) PARAMETER (IUTIL=1,IROUT=8) *KEEP,FKECODE. PARAMETER (IWARN=0,IFATAL=1,IFPRO=2,IFFLT=3,IFSMO=4,IFPRS=5, & IFPAS=6,IFPAF=7) PARAMETER (IINF1=1,IINF2=2,IINF3=3,IINV=4,IDONE=5) PARAMETER (IICV=6,IMCV=7,IOCV=11,IRCV=12,IOVCV=13, & ITHGP2=16,ITHG1=17) PARAMETER (IFREE=20,IFREE1=30,IFREE2=40,IFREE3=50) *KEND. *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,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,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,FKMEAS. DOUBLE PRECISION WMES,CMES,HMES COMMON /FKMEAS/ WMES(2,NPL),CMES(2,2,NPL),HMES(2,2,NPL),MES(NPL) *KEEP,FKCONS. DOUBLE PRECISION ZPL,DZPL,RADL COMMON /FKCONS/ ZPL(NPL),DZPL(NPL),RADL(NPL) *KEEP,FKSMTH. *KEEP,FKRJCT. DOUBLE PRECISION CHITOT,X2PCUT,X2CUTB,X2CUTA,X2CUTN &, X2PCTI,X2CTBI,X2CTAI,X2CTNI LOGICAL LWIRE,LPRINI COMMON /FKRJCT/ X2PCUT,X2CUTB,X2CUTA,X2CUTN &, X2PCTI,X2CTBI,X2CTAI,X2CTNI &, CHITOT(NPL),NDF(NPL) &, NBLOCK(NPL),NBADP(NPL),NBADB(NPL) &, NFAILP(NPL),NFAILB(NPL),NNEWP(NPL) &, NUNRJP(NPL),NUNRJB(NPL),NRERJP(NPL) &, NCPRS,NBPRS,NCPAS,NPASS,IRJCT(NPL) &, LWIRE(NPL),LPRINI *KEEP,FKDBG. *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,FRLORA. REAL ATLORR, ATLORP, DTANGR, DTANGP COMMON /FRLORA/ ATLORR, ATLORP, DTANGR, DTANGP *KEND. DIMENSION S(5),C(5,5),VXYZ(3) DIMENSION WTEMP(2),CTEMP(2,2),HTEMP(2,2),RES(2),CRES(2,2) REAL R(3),B(3) LOGICAL LSAVED,LTRSAV,LTRDSV *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,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)) *KEND. ********************************************************************** IERR = 0 FKHUNT = .FALSE. * Don't try to replace existing points IF (LMES(JPL)) RETURN * Don't look outside the tracker! RAD = SQRT(S(1)**2 + S(2)**2) IF (RAD.LT.RFTMIN .OR. RAD.GT.RFTMAX) RETURN * * Work out the cell number and drift for the supplied state * vector, and then search for a match in the digi bank * IF (IRP(JPL).EQ.1) THEN CALL FFPCEL(S,JPLFT(JPL),ICELL,DRIFT) IF (ICELL.LT.0) THEN CALL FKERR(IUTIL,IROUT,IFATAL,IINF3,IERR) RETURN ENDIF CALL FFPHNT(ICELL,DRIFT,JDIG) ELSE CALL FFRCEL(S,JPLFT(JPL),ICELL,IWEDGE,DRIFT) IF (ICELL.LT.0) THEN CALL FKERR(IUTIL,IROUT,IFATAL,IINF3,IERR) RETURN ENDIF CALL FFRHNT(ICELL,DRIFT,IWEDGE,JDIG) ENDIF * Give up if nothing was found, or if we just found the same point IF (JDIG.EQ.0 .OR. (IRJCT(JPL).GT.0 .AND. & ABS(IDIGI(JPL)).EQ.JDIG)) RETURN * Disallow point sharing IF (INDKX(IRP(JPL)).GT.0 .AND. & IBTAB(INDKX(IRP(JPL)),1,JDIG).NE.0) RETURN IF (IBTAB(INDX(IRP(JPL)),1,JDIG).NE.0) RETURN * If there's something here, save it in case we change our mind IF (IRJCT(JPL).GT.1) THEN CALL UCOPY(WMES(1,JPL),WTEMP,4) CALL UCOPY(CMES(1,1,JPL),CTEMP,8) CALL UCOPY(HMES(1,1,JPL),HTEMP,8) ZTEMP = ZPL(JPL) MTEMP = MES(JPL) ITEMP = IDIGI(JPL) LTRSAV = LTRPL(JPL) LTRDSV = LTRPLD(JPL) LSAVED = .TRUE. ELSE LSAVED = .FALSE. ENDIF * * Fill the measurement arrays * IF (IRP(JPL).EQ.1) THEN CALL FFPLAN(JDIG) ELSE * Always include radius CALL FFRAD(JDIG,0) ENDIF * Event T0 correction CALL FFEVT0(DEVT0,ZNOM,VXYZ) R(1) = S(1) R(2) = S(2) R(3) = ZPL(JPL) CALL GUFLD(R,B) * Track angle, time-of-flight and propagation time CALL FFCORR(JPL,S,ZNOM,VXYZ,DEVT0,B(3),DCORR) WMES(1,JPL) = WMES(1,JPL) + SIGN(1,IDIGI(JPL))*DCORR * * See if the chi**2 is acceptable * LMES(JPL) = .TRUE. CALL FKLRSD(JPL,S,C,3,RES,CRES,CHISQ,IFAIL) * Update the LTRPL array IF (LTRUTH) CALL FFCHTR(JPL,MES(JPL),JDIG) * Histogram residuals IF (MOD(IHFK/10,10).GT.0) CALL FKANAL(JPL,RES,CHISQ,0,0) IFAIL1 = 0 IF (IFAIL.EQ.0 .AND. CHISQ.LT.FKCHPR(4,MES(JPL),IFAIL1)) THEN IF (IFAIL1.EQ.0) THEN * New point, starting from scratch IRJCT(JPL) = 0 FKHUNT = .TRUE. RETURN ENDIF ENDIF * * The new point failed the chi**2 cut, so tidy up * IF (IFAIL.NE.0) CALL FKERR(IUTIL,IROUT,IWARN,IFAIL,IERR) IF (IFAIL1.NE.0) CALL FKERR(IUTIL,IROUT,IFAIL1/100,IFAIL1,IERR) LMES(JPL) = .FALSE. IF (LSAVED) THEN CALL UCOPY(WTEMP,WMES(1,JPL),4) CALL UCOPY(CTEMP,CMES(1,1,JPL),8) CALL UCOPY(HTEMP,HMES(1,1,JPL),8) ZPL(JPL) = ZTEMP MES(JPL) = MTEMP IDIGI(JPL) = ITEMP LTRPL(JPL) = LTRSAV LTRPLD(JPL) = LTRDSV ENDIF RETURN END *