SUBROUTINE FKEM
*-- Author :    Stephen Burke   28/08/91
      SUBROUTINE FKEM(IUTIL,IROUT,ISEV,ICODE)
*-----------------------------------------Updates 27/07/93-------                                             
**: FKEM   30907 SB. Change 'error 17' message.                                                               
*-----------------------------------------Updates 04/05/92-------                                             
**: FKEM   30907 SB. Severity added to ERRLOG messages.                                                       
*-----------------------------------------Updates 27/04/92-------                                             
**: FKEM 30301.SB. New error messages for FKLPAS and FKLPAF.                                                  
*-----------------------------------------Updates 24/01/92-------                                             
**: FKEM 30205.SB.   New error code (IOVCV).                                                                  
**: FKEM 30205.SB.   Message format changed.                                                                  
*-----------------------------------------Updates----------------                                             
**********************************************************************                                        
*                                                                    *                                        
* Interface to ERRLOG error reporting                                *                                        
*                                                                    *                                        
**********************************************************************                                        
                                                                        
      PARAMETER (NROUT=20,NERR=10)                                      
      CHARACTER*6 CROUT(6)                                              
      CHARACTER*7 CNAME(NROUT,0:1)                                      
      CHARACTER*60 CMESS(NERR,NROUT,0:1),CITER(4),CSTAND(10)            
      CHARACTER*2 CNUM                                                  
      CHARACTER*60 MESS                                                 
      CHARACTER*62 MESS2                                                
      DIMENSION IMESS(NERR,NROUT,0:1)                                   
                                                                        
      SAVE CROUT,CNAME,CMESS,CITER,CSTAND,IMESS,IFIRST                  
                                                                        
      DATA CROUT/'FKLPRO','FKLFLT','FKLSMO','FKLPRS','FKLPAS','FKLPAF'/ 
                                                                        
      DATA CNAME/'FKLFIT:','FKLPRO:','FKLFLT:','FKLSMO:','FKLRFL:'      
     &,          'FKLWM: ','FKLRSD:','FKLPRS:','FKLPAS:','FKLFTR:'      
     &,          'FKLSPR:','FKLFXY:','FKLSSM:','FKLXY: ','FKLXYZ:'      
     &,          'FKLPAF:','Unused:','Unused:','Unused:','Unused:'      
     &,          'FKCOVP:','FKCOVR:','FKINV: ','FKNORM:','FKRST: '      
     &,          'FKQG:  ','FKLOOK:','FKHUNT:','FKCHPR:','FKCHXY:'
     &,          'FKCVXY:','Unused:','Unused:','Unused:','Unused:'      
     &,          'Unused:','Unused:','Unused:','Unused:','Unused:'/     
                                                                        
      DATA IMESS/1,2,3,4,6*0   ,1,5,8*0         ,1,5,7,7*0 ,1,2,5,7*0   
     &,          1,3,4,7,6*0   ,10*0            ,3,9*0   ,1,2,3,4,5,5*0 
     &,          1,2,3,4,7,5*0 ,1,2,3,4,8,9,4*0 ,10*0      ,7,9*0       
     &,          10*0          ,7,9*0           ,7,9*0     ,1,3,4,7*0   
     &,          10*0          ,10*0            ,10*0      ,10*0        
     &,          10*0          ,10*0            ,7,9*0     ,10*0        
     &,          10*0          ,10*0            ,3,9*0     ,1,3,4,7*0   
     &,          1,4,8*0       ,10*0            ,10*0      ,10*0        
     &,          10*0          ,10*0            ,10*0      ,10*0        
     &,          10*0          ,10*0            ,10*0      ,10*0/       
                                                                        
      DATA IFIRST/0/                                                    
                                                                        
**********************************************************************                                        
                                                                        
      IF (IFIRST.GT.0) GOTO 1000                                        
                                                                        
      IFIRST = 1                                                        
                                                                        
      CMESS(1,1,0) = 'No starting point provided'                       
      CMESS(2,1,0) = 'Not enough measurements to fit'                   
      CMESS(3,1,0) = 'Invalid value in MES array'                       
      CMESS(4,1,0) = 'Invalid value of JSTART, JSTOP or JLAST'          
                                                                        
      CMESS(1,2,0) = 'Filtered vector missing'                          
      CMESS(2,2,0) = 'Projection already done'                          
                                                                        
      CMESS(1,3,0) = 'Projected vector missing'                         
      CMESS(2,3,0) = 'Filtering already done'                           
      CMESS(3,3,0) = 'Failure to invert measurement covariance'         
                                                                        
      CMESS(1,4,0) = 'Smoothed vector missing'                          
      CMESS(2,4,0) = 'Projected vector missing'                         
      CMESS(3,4,0) = 'Smoothing already done'                           
                                                                        
      CMESS(1,5,0) = 'Smoothed vector missing'                          
      CMESS(2,5,0) = 'No measurement to remove'                         
      CMESS(3,5,0) = 'Invalid value of IFLAG'                           
      CMESS(4,5,0) = 'Failure to invert measurement covariance'         
                                                                        
      CMESS(1,7,0) = 'No measurement'                                   
                                                                        
      CMESS(1,8,0) = 'Smoothed vector missing'                          
      CMESS(2,8,0) = 'Projected vector missing'                         
      CMESS(3,8,0) = 'End plane of block was skipped'                   
      CMESS(4,8,0) = 'LPOINT and LBLOCK both .FALSE.'                   
      CMESS(5,8,0) = 'Internal error (bad call to FKLSMO)'              
                                                                        
      CMESS(1,9,0) = 'Invalid probability cut or '//                    
     &               'smoothed vector missing'                          
      CMESS(2,9,0) = 'LMES(JPL) set on entry, but IRJCT(JPL) > 1'       
      CMESS(3,9,0) = 'LMES(JPL) not set by FKLOOK or FKHUNT'
      CMESS(4,9,0) = 'Internal error (IFLAG=0 in call to FKLRFL)'       
      CMESS(5,9,0) = 'Measurement covariance not positive definite'     
                                                                        
      CMESS(1,10,0) = 'No starting point provided'                      
      CMESS(2,10,0) = 'Not enough measurements to fit'                  
      CMESS(3,10,0) = 'Invalid value in MES array'                      
      CMESS(4,10,0) = 'Invalid value of JSTART, JSTOP or JLAST'         
      CMESS(5,10,0) = 'Covariance n.p.d. in FKLWM (1st call)'           
      CMESS(6,10,0) = 'Covariance n.p.d. in FKLWM (2nd call)'           
                                                                        
      CMESS(1,12,0) = 'Failure to invert measurement covariance'        
                                                                        
      CMESS(1,14,0) = 'Failure to invert measurement covariance'        
                                                                        
      CMESS(1,15,0) = 'Failure to invert measurement covariance'        
                                                                        
      CMESS(1,16,0) = 'Invalid probability cut or '//                   
     &                'projected vector missing'                        
      CMESS(2,16,0) = 'Invalid value in MES array'                      
      CMESS(3,16,0) = 'Invalid value in MES array, or internal error'   
                                                                        
      CMESS(1,3,1) = 'Measurement covariance not positive definite'     
                                                                        
      CMESS(1,7,1) = 'LMES(JPL) already set'                            
                                                                        
      CMESS(1,8,1) = 'Invalid probability cut'                          
      CMESS(2,8,1) = 'Invalid value in MES array'                       
      CMESS(3,8,1) = 'Invalid value in MES array, or internal error'    
                                                                        
      CMESS(1,9,1) = 'Invalid probability cut'                          
      CMESS(2,9,1) = 'Invalid value of NPROB or NFREE'                  
                                                                        
      CITER(1) = ' iterations in point rejection'                       
      CITER(2) = ' iterations over fit sections'                        
      CITER(3) = ' restarts'                                            
      CITER(4) = ' iterations'                                          
                                                                        
      CSTAND(1)  = 'Output covariance not positive definite'            
      CSTAND(2)  = 'Covariance of residuals not positive definite'//    
     &             ' (chi-sq zero)'                                     
      CSTAND(3)  = 'Covariance element .GT. 10**10'                     
      CSTAND(4)  = 'Unknown error'                                      
      CSTAND(5)  = 'Unknown error'                                      
      CSTAND(6)  = 'TAN(theta)>10**6, or x or y >10**4 (reset)'         
      CSTAND(7)  = 'TAN(theta)>50'                                      
      CSTAND(8)  = 'Unknown error'                                      
      CSTAND(9)  = 'Unknown error'                                      
      CSTAND(10) = 'Unknown error'                                      
                                                                        
 1000 CONTINUE                                                          
                                                                        
      ICODE1 = MOD(ICODE,100)                                           
                                                                        
      IF (IUTIL.LT.0 .OR. IUTIL.GT.1 .OR. IROUT.LT.1 .OR.               
     &    IROUT.GT.NROUT .OR. ISEV.LT.0 .OR. ISEV.GT.7 .OR.             
     &    ICODE1.LT.1 .OR. ICODE1.GT.50 ) THEN                          
         CALL ERRLOG(1000,'W:FKEM:   Illegal error code')                                              
         RETURN                                                         
      ENDIF                                                             
                                                                        
      IF (ISEV.GE.2) THEN                                               
         WRITE(CNUM,9000) ICODE1                                        
         MESS = CNAME(IROUT,IUTIL)//' Fatal error '//CNUM//             
     &                              ' from '//CROUT(ISEV-1)             
      ELSE                                                              
         IF (ICODE1.LE.10) THEN                                         
            INDEX = 0                                                   
            DO 100 I=1,NERR                                             
               IF (IMESS(I,IROUT,IUTIL).EQ.ICODE1) INDEX = I            
 100        CONTINUE                                                    
            IF (INDEX.GT.0) THEN                                        
               MESS = CNAME(IROUT,IUTIL)//' '//CMESS(INDEX,IROUT,IUTIL) 
            ELSE                                                        
               MESS = CNAME(IROUT,IUTIL)//' Unknown error'              
            ENDIF                                                       
         ELSEIF (ICODE1.LE.20) THEN                                     
            MESS = CNAME(IROUT,IUTIL)//' '//CSTAND(ICODE1-10)           
         ELSE                                                           
            INUM = MOD(ICODE1,10)                                       
            ICAUSE = ICODE1/10 - 1                                      
            IF (INUM.EQ.0) THEN                                         
               INUM = 10                                                
               ICAUSE = ICAUSE - 1                                      
            ENDIF                                                       
            IF (IROUT.EQ.14 .OR. IROUT.EQ.15) ICAUSE = 4                
            WRITE(CNUM,9000) INUM                                       
            MESS = CNAME(IROUT,IUTIL)//' '//CNUM//CITER(ICAUSE)         
         ENDIF                                                          
      ENDIF                                                             
                                                                        
      MESS2= 'W:'//MESS                                                 
      MESS = MESS2                                                      
                                                                        
      CALL ERRLOG(1000+2000*IUTIL+100*IROUT+ICODE1,MESS)                                               
                                                                        
 9000 FORMAT(I2)                                                        
                                                                        
      RETURN                                                            
      END                                                               
*