Delete unneeded directory
[jabaws.git] / website / archive / binaries / mac / src / disembl / Tisean_3.0.1 / source_f / slatec / xersve.f
diff --git a/website/archive/binaries/mac/src/disembl/Tisean_3.0.1/source_f/slatec/xersve.f b/website/archive/binaries/mac/src/disembl/Tisean_3.0.1/source_f/slatec/xersve.f
deleted file mode 100644 (file)
index 6bd2a4f..0000000
+++ /dev/null
@@ -1,155 +0,0 @@
-*DECK XERSVE
-      SUBROUTINE XERSVE (LIBRAR, SUBROU, MESSG, KFLAG, NERR, LEVEL,
-     +   ICOUNT)
-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
-      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/
-C***FIRST EXECUTABLE STATEMENT  XERSVE
-C
-      IF (KFLAG.LE.0) THEN
-C
-C        Dump the table.
-C
-         IF (NMSG.EQ.0) RETURN
-C
-C        Print to each unit.
-C
-         CALL XGETUA (LUN, NUNIT)
-         DO 20 KUNIT = 1,NUNIT
-            IUNIT = LUN(KUNIT)
-            IF (IUNIT.EQ.0) IUNIT = I1MACH(4)
-C
-C           Print the table header.
-C
-            WRITE (IUNIT,9000)
-C
-C           Print body of table.
-C
-            DO 10 I = 1,NMSG
-               WRITE (IUNIT,9010) LIBTAB(I), SUBTAB(I), MESTAB(I),
-     *            NERTAB(I),LEVTAB(I),KOUNT(I)
-   10       CONTINUE
-C
-C           Print number of other errors.
-C
-            IF (KOUNTX.NE.0) WRITE (IUNIT,9020) KOUNTX
-            WRITE (IUNIT,9030)
-   20    CONTINUE
-C
-C        Clear the error tables.
-C
-         IF (KFLAG.EQ.0) THEN
-            NMSG = 0
-            KOUNTX = 0
-         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
-         LIB = LIBRAR
-         SUB = SUBROU
-         MES = MESSG
-         DO 30 I = 1,NMSG
-            IF (LIB.EQ.LIBTAB(I) .AND. SUB.EQ.SUBTAB(I) .AND.
-     *         MES.EQ.MESTAB(I) .AND. NERR.EQ.NERTAB(I) .AND.
-     *         LEVEL.EQ.LEVTAB(I)) THEN
-                  KOUNT(I) = KOUNT(I) + 1
-                  ICOUNT = KOUNT(I)
-                  RETURN
-            ENDIF
-   30    CONTINUE
-C
-         IF (NMSG.LT.LENTAB) THEN
-C
-C           Empty slot found for new message.
-C
-            NMSG = NMSG + 1
-            LIBTAB(I) = LIB
-            SUBTAB(I) = SUB
-            MESTAB(I) = MES
-            NERTAB(I) = NERR
-            LEVTAB(I) = LEVEL
-            KOUNT (I) = 1
-            ICOUNT    = 1
-         ELSE
-C
-C           Table is full.
-C
-            KOUNTX = KOUNTX+1
-            ICOUNT = 0
-         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)
-      END