*DECK XERMSG SUBROUTINE XERMSG (LIBRAR, SUBROU, MESSG, NERR, LEVEL) C***BEGIN PROLOGUE XERMSG C***PURPOSE Process error messages for SLATEC and other libraries. C***LIBRARY SLATEC (XERROR) C***CATEGORY R3C C***TYPE ALL (XERMSG-A) C***KEYWORDS ERROR MESSAGE, XERROR C***AUTHOR Fong, Kirby, (NMFECC at LLNL) C***DESCRIPTION C C XERMSG processes a diagnostic message in a manner determined by the C value of LEVEL and the current value of the library error control C flag, KONTRL. See subroutine XSETF for details. C C LIBRAR A character constant (or character variable) with the name C of the library. This will be 'SLATEC' for the SLATEC C Common Math Library. The error handling package is C general enough to be used by many libraries C simultaneously, so it is desirable for the routine that C detects and reports an error to identify the library name C as well as the routine name. C C SUBROU A character constant (or character variable) with the name C of the routine that detected the error. Usually it is the C name of the routine that is calling XERMSG. There are C some instances where a user callable library routine calls C lower level subsidiary routines where the error is C detected. In such cases it may be more informative to C supply the name of the routine the user called rather than C the name of the subsidiary routine that detected the C error. C C MESSG A character constant (or character variable) with the text C of the error or warning message. In the example below, C the message is a character constant that contains a C generic message. C C CALL XERMSG ('SLATEC', 'MMPY', C *'THE ORDER OF THE MATRIX EXCEEDS THE ROW DIMENSION', C *3, 1) C C It is possible (and is sometimes desirable) to generate a C specific message--e.g., one that contains actual numeric C values. Specific numeric values can be converted into C character strings using formatted WRITE statements into C character variables. This is called standard Fortran C internal file I/O and is exemplified in the first three C lines of the following example. You can also catenate C substrings of characters to construct the error message. C Here is an example showing the use of both writing to C an internal file and catenating character strings. C C CHARACTER*5 CHARN, CHARL C WRITE (CHARN,10) N C WRITE (CHARL,10) LDA C 10 FORMAT(I5) C CALL XERMSG ('SLATEC', 'MMPY', 'THE ORDER'//CHARN// C * ' OF THE MATRIX EXCEEDS ITS ROW DIMENSION OF'// C * CHARL, 3, 1) C C There are two subtleties worth mentioning. One is that C the // for character catenation is used to construct the C error message so that no single character constant is C continued to the next line. This avoids confusion as to C whether there are trailing blanks at the end of the line. C The second is that by catenating the parts of the message C as an actual argument rather than encoding the entire C message into one large character variable, we avoid C having to know how long the message will be in order to C declare an adequate length for that large character C variable. XERMSG calls XERPRN to print the message using C multiple lines if necessary. If the message is very long, C XERPRN will break it into pieces of 72 characters (as C requested by XERMSG) for printing on multiple lines. C Also, XERMSG asks XERPRN to prefix each line with ' * ' C so that the total line length could be 76 characters. C Note also that XERPRN scans the error message backwards C to ignore trailing blanks. Another feature is that C the substring '$$' is treated as a new line sentinel C by XERPRN. If you want to construct a multiline C message without having to count out multiples of 72 C characters, just use '$$' as a separator. '$$' C obviously must occur within 72 characters of the C start of each line to have its intended effect since C XERPRN is asked to wrap around at 72 characters in C addition to looking for '$$'. C C NERR An integer value that is chosen by the library routine's C author. It must be in the range -99 to 999 (three C printable digits). Each distinct error should have its C own error number. These error numbers should be described C in the machine readable documentation for the routine. C The error numbers need be unique only within each routine, C so it is reasonable for each routine to start enumerating C errors from 1 and proceeding to the next integer. C C LEVEL An integer value in the range 0 to 2 that indicates the C level (severity) of the error. Their meanings are C C -1 A warning message. This is used if it is not clear C that there really is an error, but the user's attention C may be needed. An attempt is made to only print this C message once. C C 0 A warning message. This is used if it is not clear C that there really is an error, but the user's attention C may be needed. C C 1 A recoverable error. This is used even if the error is C so serious that the routine cannot return any useful C answer. If the user has told the error package to C return after recoverable errors, then XERMSG will C return to the Library routine which can then return to C the user's routine. The user may also permit the error C package to terminate the program upon encountering a C recoverable error. C C 2 A fatal error. XERMSG will not return to its caller C after it receives a fatal error. This level should C hardly ever be used; it is much better to allow the C user a chance to recover. An example of one of the few C cases in which it is permissible to declare a level 2 C error is a reverse communication Library routine that C is likely to be called repeatedly until it integrates C across some interval. If there is a serious error in C the input such that another step cannot be taken and C the Library routine is called again without the input C error having been corrected by the caller, the Library C routine will probably be called forever with improper C input. In this case, it is reasonable to declare the C error to be fatal. C C Each of the arguments to XERMSG is input; none will be modified by C XERMSG. A routine may make multiple calls to XERMSG with warning C level messages; however, after a call to XERMSG with a recoverable C error, the routine should return to the user. Do not try to call C XERMSG with a second recoverable error after the first recoverable C error because the error package saves the error number. The user C can retrieve this error number by calling another entry point in C the error handling package and then clear the error number when C recovering from the error. Calling XERMSG in succession causes the C old error number to be overwritten by the latest error number. C This is considered harmless for error numbers associated with C warning messages but must not be done for error numbers of serious C errors. After a call to XERMSG with a recoverable error, the user C must be given a chance to call NUMXER or XERCLR to retrieve or C clear the error number. C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC C Error-handling Package, SAND82-0800, Sandia C Laboratories, 1982. C***ROUTINES CALLED FDUMP, J4SAVE, XERCNT, XERHLT, XERPRN, XERSVE C***REVISION HISTORY (YYMMDD) C 880101 DATE WRITTEN C 880621 REVISED AS DIRECTED AT SLATEC CML MEETING OF FEBRUARY 1988. C THERE ARE TWO BASIC CHANGES. C 1. A NEW ROUTINE, XERPRN, IS USED INSTEAD OF XERPRT TO C PRINT MESSAGES. THIS ROUTINE WILL BREAK LONG MESSAGES C INTO PIECES FOR PRINTING ON MULTIPLE LINES. '$$' IS C ACCEPTED AS A NEW LINE SENTINEL. A PREFIX CAN BE C ADDED TO EACH LINE TO BE PRINTED. XERMSG USES EITHER C ' ***' OR ' * ' AND LONG MESSAGES ARE BROKEN EVERY C 72 CHARACTERS (AT MOST) SO THAT THE MAXIMUM LINE C LENGTH OUTPUT CAN NOW BE AS GREAT AS 76. C 2. THE TEXT OF ALL MESSAGES IS NOW IN UPPER CASE SINCE THE C FORTRAN STANDARD DOCUMENT DOES NOT ADMIT THE EXISTENCE C OF LOWER CASE. C 880708 REVISED AFTER THE SLATEC CML MEETING OF JUNE 29 AND 30. C THE PRINCIPAL CHANGES ARE C 1. CLARIFY COMMENTS IN THE PROLOGUES C 2. RENAME XRPRNT TO XERPRN C 3. REWORK HANDLING OF '$$' IN XERPRN TO HANDLE BLANK LINES C SIMILAR TO THE WAY FORMAT STATEMENTS HANDLE THE / C CHARACTER FOR NEW RECORDS. C 890706 REVISED WITH THE HELP OF FRED FRITSCH AND REG CLEMENS TO C CLEAN UP THE CODING. C 890721 REVISED TO USE NEW FEATURE IN XERPRN TO COUNT CHARACTERS IN C PREFIX. C 891013 REVISED TO CORRECT COMMENTS. C 891214 Prologue converted to Version 4.0 format. (WRB) C 900510 Changed test on NERR to be -9999999 < NERR < 99999999, but C NERR .ne. 0, and on LEVEL to be -2 < LEVEL < 3. Added C LEVEL=-1 logic, changed calls to XERSAV to XERSVE, and C XERCTL to XERCNT. (RWC) C 920501 Reformatted the REFERENCES section. (WRB) C***END PROLOGUE XERMSG CHARACTER*(*) LIBRAR, SUBROU, MESSG CHARACTER*8 XLIBR, XSUBR CHARACTER*72 TEMP CHARACTER*20 LFIRST C***FIRST EXECUTABLE STATEMENT XERMSG LKNTRL = J4SAVE (2, 0, .FALSE.) MAXMES = J4SAVE (4, 0, .FALSE.) C C LKNTRL IS A LOCAL COPY OF THE CONTROL FLAG KONTRL. C MAXMES IS THE MAXIMUM NUMBER OF TIMES ANY PARTICULAR MESSAGE C SHOULD BE PRINTED. C C WE PRINT A FATAL ERROR MESSAGE AND TERMINATE FOR AN ERROR IN C CALLING XERMSG. THE ERROR NUMBER SHOULD BE POSITIVE, C AND THE LEVEL SHOULD BE BETWEEN 0 AND 2. C IF (NERR.LT.-9999999 .OR. NERR.GT.99999999 .OR. NERR.EQ.0 .OR. * LEVEL.LT.-1 .OR. LEVEL.GT.2) THEN CALL XERPRN (' ***', -1, 'FATAL ERROR IN...$$ ' // * 'XERMSG -- INVALID ERROR NUMBER OR LEVEL$$ '// * 'JOB ABORT DUE TO FATAL ERROR.', 72) CALL XERSVE (' ', ' ', ' ', 0, 0, 0, KDUMMY) CALL XERHLT (' ***XERMSG -- INVALID INPUT') RETURN ENDIF C C RECORD THE MESSAGE. C I = J4SAVE (1, NERR, .TRUE.) CALL XERSVE (LIBRAR, SUBROU, MESSG, 1, NERR, LEVEL, KOUNT) C C HANDLE PRINT-ONCE WARNING MESSAGES. C IF (LEVEL.EQ.-1 .AND. KOUNT.GT.1) RETURN C C ALLOW TEMPORARY USER OVERRIDE OF THE CONTROL FLAG. C XLIBR = LIBRAR XSUBR = SUBROU LFIRST = MESSG LERR = NERR LLEVEL = LEVEL CALL XERCNT (XLIBR, XSUBR, LFIRST, LERR, LLEVEL, LKNTRL) C LKNTRL = MAX(-2, MIN(2,LKNTRL)) MKNTRL = ABS(LKNTRL) C C SKIP PRINTING IF THE CONTROL FLAG VALUE AS RESET IN XERCNT IS C ZERO AND THE ERROR IS NOT FATAL. C IF (LEVEL.LT.2 .AND. LKNTRL.EQ.0) GO TO 30 IF (LEVEL.EQ.0 .AND. KOUNT.GT.MAXMES) GO TO 30 IF (LEVEL.EQ.1 .AND. KOUNT.GT.MAXMES .AND. MKNTRL.EQ.1) GO TO 30 IF (LEVEL.EQ.2 .AND. KOUNT.GT.MAX(1,MAXMES)) GO TO 30 C C ANNOUNCE THE NAMES OF THE LIBRARY AND SUBROUTINE BY BUILDING A C MESSAGE IN CHARACTER VARIABLE TEMP (NOT EXCEEDING 66 CHARACTERS) C AND SENDING IT OUT VIA XERPRN. PRINT ONLY IF CONTROL FLAG C IS NOT ZERO. C IF (LKNTRL .NE. 0) THEN TEMP(1:21) = 'MESSAGE FROM ROUTINE ' I = MIN(LEN(SUBROU), 16) TEMP(22:21+I) = SUBROU(1:I) TEMP(22+I:33+I) = ' IN LIBRARY ' LTEMP = 33 + I I = MIN(LEN(LIBRAR), 16) TEMP(LTEMP+1:LTEMP+I) = LIBRAR (1:I) TEMP(LTEMP+I+1:LTEMP+I+1) = '.' LTEMP = LTEMP + I + 1 CALL XERPRN (' ***', -1, TEMP(1:LTEMP), 72) ENDIF C C IF LKNTRL IS POSITIVE, PRINT AN INTRODUCTORY LINE BEFORE C PRINTING THE MESSAGE. THE INTRODUCTORY LINE TELLS THE CHOICE C FROM EACH OF THE FOLLOWING THREE OPTIONS. C 1. LEVEL OF THE MESSAGE C 'INFORMATIVE MESSAGE' C 'POTENTIALLY RECOVERABLE ERROR' C 'FATAL ERROR' C 2. WHETHER CONTROL FLAG WILL ALLOW PROGRAM TO CONTINUE C 'PROG CONTINUES' C 'PROG ABORTED' C 3. WHETHER OR NOT A TRACEBACK WAS REQUESTED. (THE TRACEBACK C MAY NOT BE IMPLEMENTED AT SOME SITES, SO THIS ONLY TELLS C WHAT WAS REQUESTED, NOT WHAT WAS DELIVERED.) C 'TRACEBACK REQUESTED' C 'TRACEBACK NOT REQUESTED' C NOTICE THAT THE LINE INCLUDING FOUR PREFIX CHARACTERS WILL NOT C EXCEED 74 CHARACTERS. C WE SKIP THE NEXT BLOCK IF THE INTRODUCTORY LINE IS NOT NEEDED. C IF (LKNTRL .GT. 0) THEN C C THE FIRST PART OF THE MESSAGE TELLS ABOUT THE LEVEL. C IF (LEVEL .LE. 0) THEN TEMP(1:20) = 'INFORMATIVE MESSAGE,' LTEMP = 20 ELSEIF (LEVEL .EQ. 1) THEN TEMP(1:30) = 'POTENTIALLY RECOVERABLE ERROR,' LTEMP = 30 ELSE TEMP(1:12) = 'FATAL ERROR,' LTEMP = 12 ENDIF C C THEN WHETHER THE PROGRAM WILL CONTINUE. C IF ((MKNTRL.EQ.2 .AND. LEVEL.GE.1) .OR. * (MKNTRL.EQ.1 .AND. LEVEL.EQ.2)) THEN TEMP(LTEMP+1:LTEMP+14) = ' PROG ABORTED,' LTEMP = LTEMP + 14 ELSE TEMP(LTEMP+1:LTEMP+16) = ' PROG CONTINUES,' LTEMP = LTEMP + 16 ENDIF C C FINALLY TELL WHETHER THERE SHOULD BE A TRACEBACK. C IF (LKNTRL .GT. 0) THEN TEMP(LTEMP+1:LTEMP+20) = ' TRACEBACK REQUESTED' LTEMP = LTEMP + 20 ELSE TEMP(LTEMP+1:LTEMP+24) = ' TRACEBACK NOT REQUESTED' LTEMP = LTEMP + 24 ENDIF CALL XERPRN (' ***', -1, TEMP(1:LTEMP), 72) ENDIF C C NOW SEND OUT THE MESSAGE. C CALL XERPRN (' * ', -1, MESSG, 72) C C IF LKNTRL IS POSITIVE, WRITE THE ERROR NUMBER AND REQUEST A C TRACEBACK. C IF (LKNTRL .GT. 0) THEN WRITE (TEMP, '(''ERROR NUMBER = '', I8)') NERR DO 10 I=16,22 IF (TEMP(I:I) .NE. ' ') GO TO 20 10 CONTINUE C 20 CALL XERPRN (' * ', -1, TEMP(1:15) // TEMP(I:23), 72) CALL FDUMP ENDIF C C IF LKNTRL IS NOT ZERO, PRINT A BLANK LINE AND AN END OF MESSAGE. C IF (LKNTRL .NE. 0) THEN CALL XERPRN (' * ', -1, ' ', 72) CALL XERPRN (' ***', -1, 'END OF MESSAGE', 72) CALL XERPRN (' ', 0, ' ', 72) ENDIF C C IF THE ERROR IS NOT FATAL OR THE ERROR IS RECOVERABLE AND THE C CONTROL FLAG IS SET FOR RECOVERY, THEN RETURN. C 30 IF (LEVEL.LE.0 .OR. (LEVEL.EQ.1 .AND. MKNTRL.LE.1)) RETURN C C THE PROGRAM WILL BE STOPPED DUE TO AN UNRECOVERED ERROR OR A C FATAL ERROR. PRINT THE REASON FOR THE ABORT AND THE ERROR C SUMMARY IF THE CONTROL FLAG AND THE MAXIMUM ERROR COUNT PERMIT. C IF (LKNTRL.GT.0 .AND. KOUNT.LT.MAX(1,MAXMES)) THEN IF (LEVEL .EQ. 1) THEN CALL XERPRN * (' ***', -1, 'JOB ABORT DUE TO UNRECOVERED ERROR.', 72) ELSE CALL XERPRN(' ***', -1, 'JOB ABORT DUE TO FATAL ERROR.', 72) ENDIF CALL XERSVE (' ', ' ', ' ', -1, 0, 0, KDUMMY) CALL XERHLT (' ') ELSE CALL XERHLT (MESSG) ENDIF RETURN END