SUBROUTINE kerror(icode,maxerr,routine,message) C-------------------------------------------------------------------- C KERROR : print out and monitor errors in KOFIA C Author : Morgan Burke C Date : 1990-May-29 C 1991-Apr-09 -- only kill KOFIA if flag CRASH_ON_FATAL C (namelist NLKFLAGS) is set .TRUE. C 1991-Jul-16 -- added ZERO_ERROR entry point to clear C the error counters C 1991-Dec-02 -- added KERROR2 entry point; allows a C second message string to be passed. The C second message is printed but not saved. C 1992-Jan-27 -- list errors before stopping C 1992-Nov-4 -- (CW) added check for variable numerr C 1992-Nov-10 -- added bell on serious and fatal errors, C improved formatting C-------------------------------------------------------------------- C When an error condition occurs in KOFIA, this routine can be C called to display the error message in a standard format to both C standard ouput and the log file. It will also keep track of how C often the error recurs, and if this number exceeds a certain C value, take special action according to the severity of the error. C The entry point LIST_ERROR can be used to display all errors C that have been monitored up to that point (called by KOFIA C command "SHOW ERRORS"). C C Input Arguments: C C ICODE (INTEGER*4) = severity of error C Errors have 5 levels of severity: C 1 (I) : Informational message only (usually not an error). C 2 (W) : Warning message (execution probably continues despite C the possible problem) C 3 (E) : Error (program probably cannot proceed without further C input) C 4 (X) : Serious error (execution probably cannot proceed under C any circumstances. Procedure is probably aborted.) C 5 (F) : Fatal error; KOFIA will be killed. User is returned C to the operating system. C If ICODE is negative, the severity level becomes |ICODE|, and C the current event and run number are also displayed. ICODE > 3 C will ring the terminal bell. C C MAXERR (INTEGER*4) = maximum tolerable repeat count of this C error. If the error occurs more than this number of times, C special action is taken, depending on ICODE: C icode = 1 : further messages are suppressed C icode = 2 : further messages are suppressed C icode = 3 : message is upgraded to serious (icode = 4) C icode = 4 : messate is upgraded to fatal (icode = 5) C If MAXERR = 0, the maximum repeat count will be unlimited. C C ROUTINE (CHARACTER*(*)) = the name of the calling routine C C MESSAGE (CHARACTER*(*)) = the error message C C MESSAGE2 (CHARACTER*(*)) = second message that is printed but not C monitored. Used to describe the C specifics of this instance of the error. C (entry point KERROR2 only) C-------------------------------------------------------------------- C Error messages will be displayed in the standard VMS format, ie: C C %XXX-Y-ZZZZZ, message text C C where XXX is the program in which the error occurred, Y is the C error type or severity, and ZZZZZ is an error code, in this case C the name of the routine in which the error occurred. It is then C a simple matter to search log files for all errors and messages, C by simply searching for the "%" symbol. C-------------------------------------------------------------------- C Example: C CALL kerror2(-3,0,'DPLOT','could not open file',filename) C might produce the following output: C C %KOFIA-E-DPLOT, could not open file C /usr/people/e787/test/param.dat C in run: 9999 event: 666 C-------------------------------------------------------------------- $$IMPLICIT $$INCLUDE 'KOFIA$INCLUDE:luns.cmn' $$INCLUDE 'KOFIA$INCLUDE:info.cmn' $$INCLUDE 'KOFIA$INCLUDE:kflags.cmn' INTEGER*4 maxmessage PARAMETER( maxmessage = 50 ) INTEGER*4 icode,maxerr,imess,i,lm,Lensig CHARACTER*(*) routine, message, msg2 CHARACTER*64 message2 CHARACTER*1 severity(5) LOGICAL*4 suppress,evdata,log,fatal INTEGER*4 numerr(maxmessage),nmessage,code,severr(maxmessage) CHARACTER*32 blanks CHARACTER*64 errors(maxmessage) DATA severity / 'I','W','E','X','F' / DATA blanks / ' ' / message2 = ' ' GOTO 1 ENTRY kerror2(icode,maxerr,routine,message,msg2) message2 = msg2 fatal = .FALSE. C examine arguments 1 evdata = .FALSE. code = icode IF (code .LT. 0) THEN code = - code evdata = .TRUE. ENDIF IF (code .EQ. 0) THEN code = 1 ELSE IF (code .GT. 5) THEN code = 5 ENDIF suppress = .FALSE. log = lout .NE. llog C see if this message has been printed before imess = 0 10 imess = imess + 1 IF (imess .GT. nmessage) GOTO 100 IF (message .EQ. errors(imess)) GOTO 200 GOTO 10 C this is a new error message 100 IF (nmessage .LT. maxmessage) THEN nmessage = nmessage + 1 errors(imess) = message ELSE WRITE(lerr,201) 'W','KERROR','too many messages to monitor' IF (log) WRITE(llog,201) + 'W','KERROR','too many messages to monitor' GOTO 250 ENDIF C check to see how many times this error has occurred 200 numerr(imess) = numerr(imess) + 1 IF ((maxerr .GT. 0) .AND. (numerr(imess) .GT. maxerr)) THEN IF (code .EQ. 1) THEN suppress = .TRUE. ELSE IF (code .EQ. 2) THEN suppress = .TRUE. ELSE IF (code .EQ. 3) THEN code = 4 IF (numerr(imess) .GT. 2 * maxerr) code = 5 ELSE IF (code .EQ. 4) THEN code = 5 ENDIF ENDIF severr(imess) = code C print out the error message 250 IF (.NOT.suppress) THEN lm = Lensig(message) IF (code .LT. 4) THEN WRITE(lerr,201) severity(code),routine,message(1:lm) IF (log) WRITE(llog,201) severity(code),routine,message(1:lm) ELSE WRITE(lerr,201) severity(code),routine,message(1:lm),CHAR(7) IF (log) WRITE(llog,201) severity(code),routine,message(1:lm), + CHAR(7) ENDIF IF (message2 .NE. ' ') THEN lm = Lensig(message2) WRITE(lerr,203) blanks(1:12+LEN(routine)),message2(1:lm) IF (log) WRITE(llog,203) blanks(1:12+LEN(routine)), + message2(1:lm) ENDIF IF (evdata) THEN WRITE(lerr,202) blanks(1:12+LEN(routine)),nrun,nevt IF (log) WRITE(llog,202) blanks(1:12+LEN(routine)),nrun,nevt ENDIF 201 FORMAT(' %KOFIA-',A1,'-',A,', ',A,:,A1) 202 FORMAT(A,'in run:',I5,' event:',I8) 203 FORMAT(A,A) ENDIF C warn that MAXERR has been reached IF (imess .LE. maxmessage .AND. numerr(imess) .EQ. maxerr) THEN IF ((code .EQ. 1) .OR. (code .EQ. 2)) THEN WRITE(lerr,204) 'supressed' IF (log) WRITE(llog,204) 'supressed' ELSE IF (code .EQ. 3) THEN WRITE(lerr,204) 'serious' IF (log) WRITE(llog,204) 'serious' ELSE IF (code .EQ. 4) THEN WRITE(lerr,204) 'fatal' IF (log) WRITE(llog,204) 'fatal' ENDIF 204 FORMAT(' %KOFIA-W-KERROR, MAXERR reached -- message now ',A) ENDIF C kill KOFIA if it is a fatal error IF ((code .EQ. 5) .AND. (crash_on_fatal)) THEN fatal = .TRUE. c CALL exec_on_exit ENDIF IF (.NOT. fatal) RETURN C--------------------------------------------------------------------- ENTRY list_error IF (nmessage .GT. 0) THEN WRITE(lout,300) WRITE(llog,300) 300 FORMAT(/,' Quantity Messages',/, + ' -------- --------') DO i = 1,nmessage WRITE(lout,310) numerr(i),severity(severr(i)),errors(i) WRITE(llog,310) numerr(i),severity(severr(i)),errors(i) 310 FORMAT(1x,I5,6x,A1,': ',A) ENDDO WRITE(lout,*) WRITE(llog,*) ELSE WRITE(lout,201) 'I','LIST_ERROR','no messages' WRITE(llog,201) 'I','LIST_ERROR','no messages' ENDIF IF (fatal) STOP 'KOFIA terminated on fatal error.' RETURN C--------------------------------------------------------------------- ENTRY zero_error DO i = 1,nmessage numerr(i) = 0 ENDDO nmessage = 0 RETURN END