*-- Author : S.Burke / J.V. Morris LOGICAL FUNCTION FKLOOK(JPL,S,C,IERR) *-----------------------------------------Updates 07/02/92------- **: FKLOOK 30205.SB. Initialise IFAIL1 to please UNDEF. *-----------------------------------------Updates---------------- ********************************************************************** * * * Look at a point we've already rejected, to see whether it now fits * * * * ERROR CONDITIONS; * * IERR = 0 ; normal termination * * -> IERR = 103 ; LMES(JPL) already set * * IERR = 12 ; covariance of residuals n.p.d. * * * * -> Fatal error * * * * Note that both errors cause .FALSE. to be returned as the * * function value, and no changes to be made to the measurement * * arrays. * * * ********************************************************************** IMPLICIT DOUBLE PRECISION (A-H,O-Z) PARAMETER (IUTIL=1,IROUT=7) *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,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,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 *KEND. DIMENSION S(5),C(5,5),RES(2),CRES(2,2) ********************************************************************** IERR = 0 FKLOOK = .FALSE. * If LMES is still set we don't want to add it again IF (LMES(JPL)) THEN CALL FKERR(IUTIL,IROUT,IFATAL,IINF3,IERR) RETURN ENDIF * This point was previously rejected; see if we want to put it back LMES(JPL) = .TRUE. IFAIL = 0 IFAIL1 = 0 CALL FKLRSD(JPL,S,C,3,RES,CRES,CHISQ,IFAIL) * NB IFAIL1 not currently checked IF (IFAIL.NE.0 .OR. CHISQ.GE.FKCHPR(3,MES(JPL),IFAIL1)) THEN IF (IFAIL.NE.0) CALL FKERR(IUTIL,IROUT,IWARN,IFAIL,IERR) LMES(JPL) = .FALSE. RETURN ENDIF * Record the statistics IF (IRJCT(JPL).EQ.3) THEN NUNRJB(JPL) = NUNRJB(JPL) + 1 ELSE NUNRJP(JPL) = NUNRJP(JPL) + 1 ENDIF * Flag point so that it won't be tried again IRJCT(JPL) = -1 FKLOOK = .TRUE. RETURN END *