*DECK XERSVE

     +   ICOUNT)

      IMPLICIT NONE

C***BEGIN PROLOGUE  XERSVE

C***SUBSIDIARY

C***PURPOSE  Record that an error has occurred.

C***LIBRARY   SLATEC (XERROR)

C***CATEGORY  R3

C***TYPE      ALL (XERSVE-A)

C***KEYWORDS  ERROR, XERROR

C***AUTHOR  Jones, R. E., (SNLA)

C***DESCRIPTION

C

C *Usage:

C

C        INTEGER  KFLAG, NERR, LEVEL, ICOUNT

C        CHARACTER * (len) LIBRAR, SUBROU, MESSG

C

C        CALL XERSVE (LIBRAR, SUBROU, MESSG, KFLAG, NERR, LEVEL, ICOUNT)

C

C *Arguments:

C

C        LIBRAR :IN    is the library that the message is from.

C        SUBROU :IN    is the subroutine that the message is from.

C        MESSG  :IN    is the message to be saved.

C        KFLAG  :IN    indicates the action to be performed.

C                      when KFLAG > 0, the message in MESSG is saved.

C                      when KFLAG=0 the tables will be dumped and

C                      cleared.

C                      when KFLAG < 0, the tables will be dumped and

C                      not cleared.

C        NERR   :IN    is the error number.

C        LEVEL  :IN    is the error severity.

C        ICOUNT :OUT   the number of times this message has been seen,

C                      or zero if the table has overflowed and does not

C                      contain this message specifically.  When KFLAG=0,

C                      ICOUNT will not be altered.

C

C *Description:

C

C   Record that this error occurred and possibly dump and clear the

C   tables.

C

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  I1MACH, XGETUA

C***REVISION HISTORY  (YYMMDD)

C   800319  DATE WRITTEN

C   861211  REVISION DATE from Version 3.2

C   891214  Prologue converted to Version 4.0 format.  (BAB)

C   900413  Routine modified to remove reference to KFLAG.  (WRB)

C   900510  Changed to add LIBRARY NAME and SUBROUTINE to calling

C           sequence, use IF-THEN-ELSE, make number of saved entries

C           easily changeable, changed routine name from XERSAV to

C           XERSVE.  (RWC)

C   910626  Added LIBTAB and SUBTAB to SAVE statement.  (BKS)

C   920501  Reformatted the REFERENCES section.  (WRB)

C***END PROLOGUE  XERSVE

      INTEGER,PARAMETER :: LENTAB=10

      INTEGER LUN(5)

      CHARACTER*(*) LIBRAR, SUBROU, MESSG

      CHARACTER*8  LIBTAB(LENTAB), SUBTAB(LENTAB), LIB, SUB

      CHARACTER*20 MESTAB(LENTAB), MES

      DIMENSION NERTAB(LENTAB), LEVTAB(LENTAB), KOUNT(LENTAB)

      SAVE LIBTAB, SUBTAB, MESTAB, NERTAB, LEVTAB, KOUNT, KOUNTX, NMSG

      DATA KOUNTX/0/, NMSG/0/

      INTEGER NERR,LEVEL,KONTRL

      INTEGER NERTAB, LEVTAB, KOUNT, KOUNTX, NMSG

      INTEGER KFLAG, ICOUNT, NUNIT, KUNIT, IUNIT, I1MACH, I

C***FIRST EXECUTABLE STATEMENT  XERSVE

C

C

C        Dump the table.

C

C

C        Print to each unit.

C

C

C           Print the table header.

C

C

C           Print body of table.

C

C

C           Print number of other errors.

C

C

C        Clear the error tables.

C

         ENDIF

      ELSE

C

C        PROCESS A MESSAGE...

C        SEARCH FOR THIS MESSG, OR ELSE AN EMPTY SLOT FOR THIS MESSG,

C        OR ELSE DETERMINE THAT THE ERROR TABLE IS FULL.

C

            IF (LIB.EQ.LIBTAB(I) .AND. SUB.EQ.SUBTAB(I) .AND.

     *         LEVEL.EQ.LEVTAB(I)) THEN

            ENDIF

C

C

C           Empty slot found for new message.

C

         ELSE

C

C           Table is full.

C

         ENDIF

      ENDIF

      RETURN

C

C     Formats.

C

 9000 FORMAT ('0          ERROR MESSAGE SUMMARY' /

     +   ' LIBRARY    SUBROUTINE MESSAGE START             NERR',

     +   '     LEVEL     COUNT')

 9010 FORMAT (1X,A,3X,A,3X,A,3I10)

 9020 FORMAT ('0OTHER ERRORS NOT INDIVIDUALLY TABULATED = ', I10)

 9030 FORMAT (1X)