SUBROUTINE FKLPRS
*-- 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.                          *                                        
*                                                                    *                                        
**********************************************************************                                        
                                                                        
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)                               
                                                                        
      PARAMETER (IUTIL=0,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,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,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,FKMEAS.                                                                                                 
      DOUBLE PRECISION WMES,CMES,HMES                                   
      COMMON /FKMEAS/ WMES(2,NPL),CMES(2,2,NPL),HMES(2,2,NPL),MES(NPL)  
*KEEP,FKRSID.                                                                                                 
*KEEP,FKTRUE.                                                                                                 
*KEND.                                                                                                        
                                                                        
      SAVE JBPL                                                         
      DATA JBPL/0/                                                      
                                                                        
**********************************************************************                                        
                                                                        
      IERR = 0                                                          
                                                                        
      IF (.NOT.LPOINT .AND. .NOT.LBLOCK) THEN                           
         CALL FKERR(IUTIL,IROUT,IWARN,IINV,IERR)
         RETURN                                                         
      ENDIF                                                             
                                                                        
*                                                                                                             
* Just count calls on the first pass (not quite right, but closer than                                        
* counting all calls)                                                                                         
*                                                                                                             
      IF (NPASS.EQ.1) NCPRS = NCPRS + 1                                 
                                                                        
*                                                                                                             
* 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.                                                                                               
*                                                                                                             
      IFAIL = 0                                                         
      IF (((LPOINT .OR. LWIRE(JPL)) .AND. LMES(JPL) .AND.               
     &                  CHISMT(JPL).GT.FKCHPR(1,MES(JPL),IFAIL))
     &                     .OR. IRJCT(JPL).LE.-2) THEN                  
         CALL FKLRFL(JPL,-2,IFAIL)
         IF (IFAIL.NE.0) CALL FKERR(IUTIL,IROUT,IWARN,IFAIL,IERR)
         IF (IFAIL.LT.100) THEN                                         
            IF (IRJCT(JPL).LT.0) THEN                                   
* We've tried this one before                                                                                 
               IF (IRJCT(JPL).EQ.-1) THEN                               
                  NRERJP(JPL) = NRERJP(JPL) + 1                         
               ELSEIF (IRJCT(JPL).EQ.-2) THEN                           
                  NFAILP(JPL) = NFAILP(JPL) - 1                         
                  NBADP(JPL) = NBADP(JPL) + 1                           
               ELSE                                                     
                  NFAILB(JPL) = NFAILB(JPL) - 1                         
                  NBADB(JPL) = NBADB(JPL) + 1                           
               ENDIF                                                    
               IRJCT(JPL) = ABS(IRJCT(JPL))                             
            ELSE                                                        
               IRJCT(JPL) = 2                                           
               NBADP(JPL) = NBADP(JPL) + 1                              
            ENDIF                                                       
            NDROP = JPL                                                 
            LMES(JPL) = .FALSE.                                         
            CALL VZERO(RSMT(1,JPL),4)                                                                  
            CALL VZERO(CRSMT(1,1,JPL),8)                                                               
            CHISMT(JPL) = 0.D0                                          
            IF (LTRUE) THEN                                             
               CALL FKRST(JPL,IFAIL)
               IF (IFAIL.NE.0) CALL FKERR(IUTIL,IROUT,IWARN,IFAIL,IERR)
            ENDIF                                                       
         ELSEIF (IRJCT(JPL).GE.0) THEN                                  
            IRJCT(JPL) = -2                                             
            NFAILP(JPL) = NFAILP(JPL) + 1                               
         ENDIF                                                          
      ENDIF                                                             
                                                                        
      IF (.NOT.LBLOCK) RETURN                                           
                                                                        
*                                                                                                             
* Accumulate the chi-sq and ndf for a block of planes                                                         
*                                                                                                             
                                                                        
      IF (NBLOCK(JPL).GT.0) THEN                                        
* This is the start of a block                                                                                
         JBPL = JPL                                                     
         NBPRS = NBPRS + 1                                              
         IF (LMES(JPL)) THEN                                            
            CHITOT(JPL) = CHISMT(JPL)                                   
            NDF(JPL) = MES(JPL)                                         
         ELSE                                                           
            CHITOT(JPL) = 0.D0                                          
            NDF(JPL) = 0                                                
         ENDIF                                                          
         RETURN                                                         
      ENDIF                                                             
                                                                        
* Is this wire in a block?                                                                                    
      IF (JBPL.LE.0) RETURN                                             
                                                                        
      IF (NPASS.EQ.1) NBPRS = NBPRS + 1                                 
                                                                        
* Increment the chisq                                                                                         
      IF (LMES(JPL)) THEN                                               
         CHITOT(JBPL) = CHITOT(JBPL) + CHISMT(JPL)                      
         NDF(JBPL) = NDF(JBPL) + MES(JPL)                               
      ENDIF                                                             
                                                                        
* Check for last wire                                                                                         
      IF (NBLOCK(JBPL).GT.ABS(JBPL-JPL)) RETURN                         
                                                                        
* This is the end, so unset JBPL (but the value is still needed)                                              
      KBPL = JBPL                                                       
      JBPL = 0                                                          
                                                                        
      IF (NBLOCK(KBPL).LT.ABS(KBPL-JPL)) THEN                           
* Some kind of error - we've gone past the end of the block                                                   
         CALL FKERR(IUTIL,IROUT,IWARN,IINF3,IERR)
         RETURN                                                         
      ENDIF                                                             
                                                                        
* Check against chi-squared cut                                                                               
      IF (NDF(KBPL).LE.0 .OR.                                           
     &            CHITOT(KBPL).LT.FKCHPR(2,NDF(KBPL),IFAIL)) RETURN
                                                                        
* Remove the block                                                                                            
      DO 200 LPL=KBPL,JPL,-JSTEP                                        
         IF (LMES(LPL)) THEN                                            
            CALL FKLRFL(LPL,-2,IFAIL)
            IF (IFAIL.NE.0) CALL FKERR(IUTIL,IROUT,IWARN,IFAIL,IERR)
            IF (IFAIL.LT.100) THEN                                      
               IF (IRJCT(LPL).EQ.-1) THEN                               
                  NRERJP(LPL) = NRERJP(LPL) + 1                         
                  IRJCT(LPL)  = 1                                       
               ELSE                                                     
                  IRJCT(LPL)  = 3                                       
                  NBADB(LPL)  = NBADB(LPL) + 1                          
               ENDIF                                                    
               NDROP     = LPL                                          
               LMES(LPL) = .FALSE.                                      
            ELSEIF (IRJCT(LPL).GE.0) THEN                               
               NDROP      = LPL                                         
               NBADB(LPL) = NBADB(LPL) + 1                              
               LMES(LPL)  = .FALSE.                                     
            ELSE                                                        
               IRJCT(JPL)  = -3                                         
               NFAILB(LPL) = NFAILB(LPL) + 1                            
            ENDIF                                                       
         ENDIF                                                          
* Re-smooth                                                                                                   
         IF (LPL.NE.JPL) THEN                                           
            LSMT(LPL-JSTEP)=.FALSE.                                     
            CALL FKLSMO(LPL-JSTEP,IFAIL)
            IF (IFAIL.NE.0)                                             
     &         CALL FKERR(IUTIL,IROUT,IFAIL/100,IFAIL,IERR)
            IF (IERR.GT.100) RETURN                                     
         ELSE                                                           
            CALL VZERO(RSMT(1,JPL),4)                                                                  
            CALL VZERO(CRSMT(1,1,JPL),8)                                                               
            CHISMT(JPL) = 0.D0                                          
            IF (LTRUE) THEN                                             
               CALL FKRST(JPL,IFAIL)
               IF (IFAIL.NE.0) CALL FKERR(IUTIL,IROUT,IWARN,IFAIL,IERR)
            ENDIF                                                       
         ENDIF                                                          
 200  CONTINUE                                                          
                                                                        
      RETURN                                                            
      END                                                               
*