*-- 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
*