*-- Author : S.Burke / J.V. Morris
SUBROUTINE FKERR(IUTIL,IROUT,ISEV,ICODE,IERR)
**********************************************************************
* *
* Routine to record errors. *
* *
**********************************************************************
*KEEP,FKCNTL.
COMMON /FKCNTL/ LUN,IPR,ITR,IPL,JSTART,JSTOP,JLAST,JSTEP
*KEEP,FKLERR.
PARAMETER(NROUT=20,NCODE=50)
COMMON /FKLERR/ NMERR(NCODE,NROUT),NUERR(NCODE,NROUT)
&, NFAT,NERR,NOFL,NUFL,IULAST,IRLAST,MAXERR
*KEND.
SAVE NMESS
DATA NMESS/0/
**********************************************************************
* Remember last routine code for printout routine
IULAST = IUTIL
IRLAST = IROUT
* Clear counters if error code is zero
IF (ICODE.EQ.0) THEN
CALL VZERO(NMERR,NCODE*NROUT)
CALL VZERO(NUERR,NCODE*NROUT)
NFAT = 0
NERR = 0
NOFL = 0
NUFL = 0
IERR = 0
RETURN
ENDIF
* Remove old severity code from ICODE
IERR = MOD(ICODE,100)
* Write error message to ERRLOG
CALL FKEM(IUTIL,IROUT,ISEV,ICODE)
*
* Deal with bad arguments - there isn't much point passing
* these back as an error!
*
IF (IROUT.LE.0 .OR. IERR.LE.0) THEN
NUFL = NUFL + 1
RETURN
ELSEIF (IROUT.GT.NROUT .OR. IERR.GT.NCODE) THEN
NOFL = NOFL + 1
RETURN
ENDIF
IF (IUTIL.EQ.0) THEN
NMERR(IERR,IROUT) = NMERR(IERR,IROUT) + 1
ELSE
NUERR(IERR,IROUT) = NUERR(IERR,IROUT) + 1
ENDIF
IF (ISEV.GT.0) NFAT = NFAT + 1
NERR = NERR + 1
IERR = 100*ISEV + IERR
IF (NMESS.GE.MAXERR) RETURN
* Print out a message if requested
IF (IUTIL.EQ.0 .AND. (IROUT.EQ.1 .OR. IROUT.EQ.10)) THEN
IFLAG = 10
ELSEIF (IUTIL.EQ.0) THEN
IFLAG = 14
ELSE
IFLAG = 18
ENDIF
IF (ISEV.GT.0) IFLAG = IFLAG - 2
IF (IPR.LT.IFLAG) RETURN
CALL FKPRNT(-1,IERR)
NMESS = NMESS + 1
IF (NMESS.NE.MAXERR) RETURN
WRITE(LUN,*)
WRITE(LUN,*) '*** Kalman filter - max error count exceeded ***'
WRITE(LUN,*)
RETURN
END
*