*-- Author : S.Burke / J.V. Morris
SUBROUTINE FKLPRS(JPL,NDROP,IERR)
**********************************************************************
* *
* Point rejection during smoothing (at plane JPL) *
* *
* ERROR CONDITIONS; *
* IERR = 0 ; normal termination *
* (->) IERR = 101 ; smoothed vector missing *
* -> IERR = 102 ; projected vector missing *
* IERR = 3 ; end plane of block was skipped *
* IERR = 4 ; LPOINT and LBLOCK both .FALSE. *
* IERR = 5 ; internal error (bad call to FKLSMO) *
* IERR = 11 ; smoothed covariance n.p.d. *
* IERR = 12 ; covariance of smoothed residuals n.p.d. *
* IERR = 16 ; theta > pi/2 (reset to pi/4) *
* IERR = 17 ; theta > 1 (warning) *
* *
* -> Fatal error *
* *
* Error code 1 is only fatal if generated in FKLSMO during the *
* removal of a block of points. It can also be generated in FKLRFL, *
* but is treated as a warning in this case. *
* *
**********************************************************************
*KEEP,FKECODE.
*KEND.
*KEEP,FKNPL.
*
* 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.
*
* /FKPROJ/
* /FKFILT/
* /FKSMTH/
* /FKINT/
* /FKRSID/
* /FKTRUE/
* /FKDBG/
*KEEP,FKCNTL.
*KEEP,FKFLAG.
*KEEP,FKRJCT.
*KEEP,FKMEAS.
*KEEP,FKRSID.
*KEEP,FKTRUE.
*KEND.
**********************************************************************
CALL FKERR(IUTIL,IROUT,IWARN,IINV,IERR)
*
* Just count calls on the first pass (not quite right, but closer than
* counting all calls)
*
*
* If smoothed residual has poor chisquared, reject the plane ...
* (but only if this has been requested)
* Also try again to get rid of it if it was flagged on a previous pass.
* This clause is a bit of a monster, but I think it's all needed!
* The error condition from FKCHPR is not currently checked; an error
* can only occur if X2PCUT has a silly value, in which case every point
* will be kept.
*
& CHISMT(JPL).GT.FKCHPR(1,MES(JPL),IFAIL))
CALL FKLRFL(JPL,-2,IFAIL)
IF (IFAIL.NE.0) CALL FKERR(IUTIL,IROUT,IWARN,IFAIL,IERR)
* We've tried this one before
CALL VZERO(RSMT(1,JPL),4)
CALL VZERO(CRSMT(1,1,JPL),8)
CALL FKRST(JPL,IFAIL)
IF (IFAIL.NE.0) CALL FKERR(IUTIL,IROUT,IWARN,IFAIL,IERR)
*
* Accumulate the chi-sq and ndf for a block of planes
*
* This is the start of a block
* Is this wire in a block?
* Increment the chisq
* Check for last wire
* This is the end, so unset JBPL (but the value is still needed)
* Some kind of error - we've gone past the end of the block
CALL FKERR(IUTIL,IROUT,IWARN,IINF3,IERR)
* Check against chi-squared cut
& CHITOT(KBPL).LT.FKCHPR(2,NDF(KBPL),IFAIL)) RETURN
* Remove the block
CALL FKLRFL(LPL,-2,IFAIL)
IF (IFAIL.NE.0) CALL FKERR(IUTIL,IROUT,IWARN,IFAIL,IERR)
* Re-smooth
CALL FKLSMO(LPL-JSTEP,IFAIL)
& CALL FKERR(IUTIL,IROUT,IFAIL/100,IFAIL,IERR)
CALL VZERO(RSMT(1,JPL),4)
CALL VZERO(CRSMT(1,1,JPL),8)
CALL FKRST(JPL,IFAIL)
IF (IFAIL.NE.0) CALL FKERR(IUTIL,IROUT,IWARN,IFAIL,IERR)
*