doxy/html/xermsg_8_f_source.html

*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