*DECK EG8CK
      SUBROUTINE EG8CK (LUN, KPRINT, IPASS)
C***BEGIN PROLOGUE  EG8CK
C***PURPOSE  Quick check for EXINT and GAUS8.
C***LIBRARY   SLATEC
C***TYPE      SINGLE PRECISION (EG8CK-S, DEG8CK-D)
C***KEYWORDS  QUICK CHECK
C***AUTHOR  Amos, D. E., (SNLA)
C***DESCRIPTION
C
C   EG8CK is a quick check routine for EXINT and GAUS8.  Exponential
C   integrals from EXINT are checked against quadratures from GAUS8.
C
C***ROUTINES CALLED  EXINT, FEIN, GAUS8, R1MACH
C***COMMON BLOCKS    FEINX
C***REVISION HISTORY  (YYMMDD)
C   800501  DATE WRITTEN
C   890718  Added check when testing error conditions.  (WRB)
C   890718  REVISION DATE from Version 3.2
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   910708  Code revised to test error returns for all values of
C           KPRINT.  (WRB)
C   920206  Corrected argument list in CALL to EXINT.  (WRB)
C***END PROLOGUE  EG8CK
      COMMON /FEINX/ X, A, FKM
      INTEGER I, ICASE, IE, IERR, II, IK, IPASS, IX, IY, K, KE, KK,
     * KODE, KX, LUN, M, N, NM, NZ
      REAL A, ANS, ATOL, BB, EN, ER, EX, FKM, SIG, SUM, TOL, T1, T2, X,
     * XX, Y
      REAL R1MACH, FEIN
      DIMENSION EN(4), Y(4), XX(5)
      LOGICAL FATAL
      EXTERNAL FEIN
C***FIRST EXECUTABLE STATEMENT  EG8CK
      IF (KPRINT .GE. 2) WRITE (LUN,90000)
      IPASS=1
      TOL = SQRT(MAX(R1MACH(4),1.0E-18))
      DO 150 KODE=1,2
        IK = KODE - 1
        FKM = IK
        DO 140 N=1,25,8
          DO 130 M=1,4
            NM = N + M - 1
            DO 120 IX=1,25,8
              X = IX- 0.20E0
              CALL EXINT(X, N, KODE, M, TOL, EN, NZ, IERR)
              KX = X+0.5E0
              IF (KX.EQ.0) KX = 1
              ICASE = 1
              A = N
              IF (KX.LE.N) GO TO 10
              ICASE = 2
              A = NM
              IF (KX.GE.NM) GO TO 10
              ICASE = 3
              A = KX
   10         CONTINUE
              SIG = 3.0E0/X
              T2 = 1.0E0
              SUM = 0.0E0
   20         CONTINUE
              T1 = T2
              T2 = T2 + SIG
              ATOL = TOL
              CALL GAUS8(FEIN, T1, T2, ATOL, ANS, IERR)
              SUM = SUM + ANS
              IF (ABS(ANS).LT.ABS(SUM)*TOL) GO TO 30
              GO TO 20
   30         CONTINUE
              EX = 1.0E0
              IF (KODE.EQ.1) EX = EXP(-X)
              BB = A
              IF (ICASE.NE.3) GO TO 40
              IY = KX - N + 1
              Y(IY) = SUM
              KE = M - IY
              IE = IY - 1
              KK = IY
              II = IY
              GO TO 60
   40         CONTINUE
              IF (ICASE.NE.2) GO TO 50
              Y(M) = SUM
              IF (M.EQ.1) GO TO 100
              IE = M - 1
              II = M
              GO TO 80
   50         CONTINUE
              Y(1) = SUM
              IF (M.EQ.1) GO TO 100
              KE = M - 1
              KK = 1
   60         CONTINUE
C
C             Forward recur
C
              DO 70 K=1,KE
                Y(KK+1) = (EX-X*Y(KK))/BB
                BB = BB + 1.0E0
                KK = KK + 1
   70         CONTINUE
              IF (ICASE.NE.3) GO TO 100
   80         BB = A - 1.0E0
C
C             Backward recur
C
              DO 90 I=1,IE
                Y(II-1) = (EX-BB*Y(II))/X
                BB = BB - 1.0E0
                II = II - 1
   90         CONTINUE
  100         CONTINUE
              DO 110 I=1,M
                ER = ABS((Y(I)-EN(I))/Y(I))
                IF (ER .GT. TOL) THEN
                   WRITE (LUN,90010)
                   IPASS = 0
                   GO TO 160
                ENDIF
  110         CONTINUE
  120       CONTINUE
  130     CONTINUE
  140   CONTINUE
  150 CONTINUE
C
C     Trigger 6 error conditions.
C
  160 FATAL = .FALSE.
C
      IF (KPRINT .GE. 3) WRITE (LUN, 90020)
      XX(1) = 1.0E0
      XX(2) = 1.0E0
      XX(3) = 1.0E0
      XX(4) = 1.0E0
      XX(5) = 0.01E0
      DO 170 I=1,5
        XX(I) = -XX(I)
        K = XX(2)
        N = XX(3)
        M = XX(4)
        CALL EXINT (XX(I), N, K, M, XX(5), EN, NZ, IERR)
        IF (IERR .NE. 1) THEN
           IPASS = 0
           FATAL = .TRUE.
           WRITE (LUN, 90030) I
        ENDIF
        XX(I) = -XX(I)
  170 CONTINUE
      X = 0.0E0
      TOL = 1.0E-2
      CALL EXINT (X, 1, 1, 1, TOL, EN, NZ, IERR)
      IF (IERR .NE. 1) THEN
         IPASS = 0
         FATAL = .TRUE.
         WRITE (LUN, 90040)
      ENDIF
      IF (FATAL) THEN
         IF (KPRINT .GE. 2) THEN
            WRITE (LUN, 90070)
         ENDIF
      ELSE
         IF (KPRINT .GE. 3) THEN
            WRITE (LUN, 90080)
         ENDIF
      ENDIF
C
      IF(IPASS.EQ.1 .AND. KPRINT.GE.2) WRITE (LUN, 90100)
      IF(IPASS.EQ.0 .AND. KPRINT.GE.1) WRITE (LUN, 90110)
      RETURN
C
90000 FORMAT ('1' / ' QUICK CHECK FOR EXINT AND GAUS8' /)
90010 FORMAT (// ' ERROR IN EG8CK COMPARISON TEST' /)
90020 FORMAT (/ ' TRIGGER 6 ERROR CONDITIONS')
90030 FORMAT (' Error occurred with DO index I =', I2)
90040 FORMAT (' Error occurred with X = 0.0')
90070 FORMAT (/' AT LEAST ONE INCORRECT ARGUMENT TEST FAILED')
90080 FORMAT (/' ALL INCORRECT ARGUMENT TESTS PASSED')
90100 FORMAT (/ ' **********EXINT AND GAUS8 PASSED ALL TESTS**********')
90110 FORMAT (/ ' **********EXINT OR GAUS8 FAILED SOME TESTS**********')
      END