2 SUBROUTINE XERSVE (LIBRAR, SUBROU, MESSG, KFLAG, NERR, LEVEL,
4 C***BEGIN PROLOGUE XERSVE
6 C***PURPOSE Record that an error has occurred.
7 C***LIBRARY SLATEC (XERROR)
9 C***TYPE ALL (XERSVE-A)
10 C***KEYWORDS ERROR, XERROR
11 C***AUTHOR Jones, R. E., (SNLA)
16 C INTEGER KFLAG, NERR, LEVEL, ICOUNT
17 C CHARACTER * (len) LIBRAR, SUBROU, MESSG
19 C CALL XERSVE (LIBRAR, SUBROU, MESSG, KFLAG, NERR, LEVEL, ICOUNT)
23 C LIBRAR :IN is the library that the message is from.
24 C SUBROU :IN is the subroutine that the message is from.
25 C MESSG :IN is the message to be saved.
26 C KFLAG :IN indicates the action to be performed.
27 C when KFLAG > 0, the message in MESSG is saved.
28 C when KFLAG=0 the tables will be dumped and
30 C when KFLAG < 0, the tables will be dumped and
32 C NERR :IN is the error number.
33 C LEVEL :IN is the error severity.
34 C ICOUNT :OUT the number of times this message has been seen,
35 C or zero if the table has overflowed and does not
36 C contain this message specifically. When KFLAG=0,
37 C ICOUNT will not be altered.
41 C Record that this error occurred and possibly dump and clear the
44 C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
45 C Error-handling Package, SAND82-0800, Sandia
47 C***ROUTINES CALLED I1MACH, XGETUA
48 C***REVISION HISTORY (YYMMDD)
50 C 861211 REVISION DATE from Version 3.2
51 C 891214 Prologue converted to Version 4.0 format. (BAB)
52 C 900413 Routine modified to remove reference to KFLAG. (WRB)
53 C 900510 Changed to add LIBRARY NAME and SUBROUTINE to calling
54 C sequence, use IF-THEN-ELSE, make number of saved entries
55 C easily changeable, changed routine name from XERSAV to
57 C 910626 Added LIBTAB and SUBTAB to SAVE statement. (BKS)
58 C 920501 Reformatted the REFERENCES section. (WRB)
59 C***END PROLOGUE XERSVE
62 CHARACTER*(*) LIBRAR, SUBROU, MESSG
63 CHARACTER*8 LIBTAB(LENTAB), SUBTAB(LENTAB), LIB, SUB
64 CHARACTER*20 MESTAB(LENTAB), MES
65 DIMENSION NERTAB(LENTAB), LEVTAB(LENTAB), KOUNT(LENTAB)
66 SAVE LIBTAB, SUBTAB, MESTAB, NERTAB, LEVTAB, KOUNT, KOUNTX, NMSG
67 DATA KOUNTX/0/, NMSG/0/
68 C***FIRST EXECUTABLE STATEMENT XERSVE
78 CALL XGETUA (LUN, NUNIT)
81 IF (IUNIT.EQ.0) IUNIT = I1MACH(4)
83 C Print the table header.
87 C Print body of table.
90 WRITE (IUNIT,9010) LIBTAB(I), SUBTAB(I), MESTAB(I),
91 * NERTAB(I),LEVTAB(I),KOUNT(I)
94 C Print number of other errors.
96 IF (KOUNTX.NE.0) WRITE (IUNIT,9020) KOUNTX
100 C Clear the error tables.
108 C PROCESS A MESSAGE...
109 C SEARCH FOR THIS MESSG, OR ELSE AN EMPTY SLOT FOR THIS MESSG,
110 C OR ELSE DETERMINE THAT THE ERROR TABLE IS FULL.
116 IF (LIB.EQ.LIBTAB(I) .AND. SUB.EQ.SUBTAB(I) .AND.
117 * MES.EQ.MESTAB(I) .AND. NERR.EQ.NERTAB(I) .AND.
118 * LEVEL.EQ.LEVTAB(I)) THEN
119 KOUNT(I) = KOUNT(I) + 1
125 IF (NMSG.LT.LENTAB) THEN
127 C Empty slot found for new message.
149 9000 FORMAT ('0 ERROR MESSAGE SUMMARY' /
150 + ' LIBRARY SUBROUTINE MESSAGE START NERR',
152 9010 FORMAT (1X,A,3X,A,3X,A,3I10)
153 9020 FORMAT ('0OTHER ERRORS NOT INDIVIDUALLY TABULATED = ', I10)