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