*DECK DBIKCK
      SUBROUTINE DBIKCK (LUN, KPRINT, IPASS)
C***BEGIN PROLOGUE  DBIKCK
C***PURPOSE  Quick check for DBESI and DBESK.
C***LIBRARY   SLATEC
C***TYPE      DOUBLE PRECISION (BIKCK-S, DBIKCK-D)
C***KEYWORDS  QUICK CHECK
C***AUTHOR  Amos, D. E., (SNLA)
C***DESCRIPTION
C
C   DBIKCK is a quick check routine for DBESI and DBESK.  The main loops
C   evaluate the Wronskian and test the error.  Underflow and overflow
C   diagnostics are checked in addition to illegal arguments.
C
C***ROUTINES CALLED  D1MACH, DBESI, DBESK, NUMXER, XERCLR, XGETF, XSETF
C***REVISION HISTORY  (YYMMDD)
C   750101  DATE WRITTEN
C   890911  Removed unnecessary intrinsics.  (WRB)
C   891004  Removed unreachable code.  (WRB)
C   891004  REVISION DATE from Version 3.2
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   901205  Changed usage of D1MACH(3) to D1MACH(4).  (RWC)
C   910121  Editorial Changes.  (RWC)
C   910501  Added TYPE record.  (WRB)
C   910708  Code revised to test error returns for all values of
C           KPRINT.  (WRB)
C   910801  Editorial changes, some restructing and modifications to
C           obtain more information when there is failure of the
C           Wronskian.  (WRB)
C***END PROLOGUE  DBIKCK
      INTEGER I, IPASS, IX, K, KODE, KONTRL, LUN, M, N, NERR, NU, NW, NY
      DOUBLE PRECISION ALP, DEL, ER, FNU, FNUP, RX, TOL, X
      DOUBLE PRECISION FN(3), W(5), XX(5), Y(5)
      DOUBLE PRECISION D1MACH
      LOGICAL FATAL
C***FIRST EXECUTABLE STATEMENT  DBIKCK
      IF (KPRINT .GE. 2) WRITE (LUN,90000)
C
      IPASS = 1
      XX(1) = 0.49D0
      XX(2) = 1.3D0
      XX(3) = 5.3D0
      XX(4) = 13.3D0
      XX(5) = 21.3D0
      FN(1) = 0.095D0
      FN(2) = 0.70D0
      FN(3) = 0.0D0
      TOL = MAX(500.0D0*D1MACH(4), 7.1D-12)
      DO 60 KODE=1,2
         DO 50 M=1,3
            DO 40 N=1,4
               DO 30 NU=1,4
                  FNU = FN(M) + 12*(NU-1)
                  DO 20 IX=1,5
                     IF (IX.LT.2 .AND. NU.GT.3) GO TO 20
                     X = XX(IX)
                     RX = 1.0D0/X
                     CALL DBESI(X, FNU, KODE, N, Y, NY)
                     IF (NY.NE.0) GO TO 20
                     CALL DBESK(X, FNU, KODE, N, W, NW)
                     IF (NW.NE.0) GO TO 20
                     FNUP = FNU + N
                     CALL DBESI(X,FNUP,KODE,1,Y(N+1),NY)
                     IF (NY.NE.0) GO TO 20
                     CALL DBESK(X,FNUP,KODE,1,W(N+1),NW)
                     IF (NW.NE.0) GO TO 20
                     DO 10 I=1,N
                        ER = Y(I+1)*W(I) + W(I+1)*Y(I) - RX
                        ER = ABS(ER)*X
                        IF (ER.GT.TOL) THEN
                           IPASS = 0
                           IF (KPRINT.GE.2) WRITE (LUN,90010) KODE,M,N,
     *                        NU,IX,I,X,ER,TOL,
     *                        Y(I),Y(I+1),W(I),W(I+1)
                        ENDIF
   10                CONTINUE
   20             CONTINUE
   30          CONTINUE
   40       CONTINUE
   50    CONTINUE
   60 CONTINUE
C
C     Check small values of X and order
C
      N = 2
      FNU = 1.0D0
      X = D1MACH(4)
      DO 80 I=1,3
         DO 70 KODE=1,2
            CALL DBESI(X, FNU, KODE, N, Y, NY)
            CALL DBESK(X, FNU, KODE, N, W, NW)
            ER = Y(2)*W(1) + W(2)*Y(1) - 1.0D0/X
            ER = ABS(ER)*X
            IF (ER.GT.TOL) THEN
               IPASS = 0
               IF (KPRINT.GE.2) WRITE (LUN,90020) I,KODE,FNU,X,ER,TOL,
     +            Y(1),Y(2),W(1),W(2)
               GO TO 700
            ENDIF
   70    CONTINUE
C
  700    FNU = D1MACH(4)/100.0D0
         X = XX(2*I-1)
   80 CONTINUE
C
C     Check large values of X and order
C
      KODE = 2
      DO 76 K=1,2
         DEL = 30*(K-1)
         FNU = 45.0D0+DEL
         DO 75 N=1,2
            X = 20.0D0 + DEL
            DO 71 I=1,5
               RX = 1.0D0/X
               CALL DBESI(X, FNU, KODE, N, Y, NY)
               IF (NY.NE.0) GO TO 71
               CALL DBESK(X, FNU, KODE, N, W, NW)
               IF (NW.NE.0) GO TO 71
               IF (N.EQ.1) THEN
                  FNUP = FNU + 1.0D0
                  CALL DBESI(X,FNUP,KODE,1,Y(2),NY)
                  IF (NY.NE.0) GO TO 71
                  CALL DBESK(X,FNUP,KODE,1,W(2),NW)
                  IF (NW.NE.0) GO TO 71
               ENDIF
               ER = Y(2)*W(1) + Y(1)*W(2) - RX
               ER = ABS(ER)*X
               IF (ER.GT.TOL) THEN
                  IPASS = 0
                  IF (KPRINT.GE.2) WRITE (LUN,90030) K,N,I,FNUP,X,
     +               ER,TOL,Y(1),Y(2),W(1),W(2)
                  GO TO 760
               ENDIF
               X = X + 10.0D0
   71       CONTINUE
   75    CONTINUE
   76 CONTINUE
C
C     Check underflow flags
C
  760 X = D1MACH(1)*10.0D0
      ALP = 12.3D0
      N = 3
      CALL DBESI(X, ALP, 1, N, Y, NY)
      IF (NY.NE.3) THEN
         IPASS = 0
         IF (KPRINT.GE.2) WRITE (LUN,90040)
      ENDIF
C
      X = LOG(D1MACH(2)/10.0D0) + 20.0D0
      ALP = 1.3D0
      N = 3
      CALL DBESK(X, ALP, 1, N, W, NW)
      IF (NW.NE.3) THEN
         IPASS = 0
         IF (KPRINT.GE.2) WRITE (LUN,90050)
      ENDIF
C
C     Trigger 10 error conditions
C
      CALL XGETF (KONTRL)
      IF (KPRINT .LE. 2) THEN
         CALL XSETF (0)
      ELSE
         CALL XSETF (1)
      ENDIF
      FATAL = .FALSE.
      CALL XERCLR
C
      IF (KPRINT .GE. 3) WRITE (LUN,90060)
      XX(1) = 1.0D0
      XX(2) = 1.0D0
      XX(3) = 1.0D0
      XX(4) = 1.0D0
C
C     Illegal arguments
C
      DO 90 I=1,4
         XX(I) = -XX(I)
         K = INT(XX(3))
         N = INT(XX(4))
         CALL DBESI(XX(1), XX(2), K, N, Y, NY)
         IF (NUMXER(NERR) .NE. 2) THEN
            IPASS = 0
            FATAL = .TRUE.
         ENDIF
         CALL XERCLR
         CALL DBESK(XX(1), XX(2), K, N, W, NW)
         IF (NUMXER(NERR) .NE. 2) THEN
            IPASS = 0
            FATAL = .TRUE.
         ENDIF
         CALL XERCLR
         XX(I) = -XX(I)
   90 CONTINUE
C
C     Trigger overflow
C
      X = LOG(D1MACH(2)/10.0D0) + 20.0D0
      N = 3
      ALP = 2.3D0
      CALL DBESI(X, ALP, 1, N, Y, NY)
      IF (NUMXER(NERR) .NE. 6) THEN
         IPASS = 0
         FATAL = .TRUE.
      ENDIF
      CALL XERCLR
C
      X = D1MACH(1)*10.0D0
      CALL DBESK(X, ALP, 1, N, W, NW)
      IF (NUMXER(NERR) .NE. 6) THEN
         IPASS = 0
         FATAL = .TRUE.
      ENDIF
      CALL XERCLR
C
      CALL XSETF (KONTRL)
      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
90000 FORMAT (/ ' QUICK CHECKS FOR DBESI AND DBESK' //)
90010 FORMAT (/ ' ERROR IN QUICK CHECK OF WRONSKIAN', 1P /
     +        ' KODE = ', I1,', M = ', I1, ', N = ', I1, ', NU = ', I1,
     +        ', IX = ', I1, ', I = ', I1 /
     +        ' X = ', E14.7, ', ER   = ', E14.7, ', TOL = ', E14.7 /
     +        ' Y(I) = ', E14.7, ', Y(I+1) = ', E14.7 /
     +        ' W(I) = ', E14.7, ', W(I+1) = ', E14.7)
90020 FORMAT (/ ' ERROR IN QUICK CHECK OF SMALL X AND ORDER', 1P /
     +        ' I = ', I1,', KODE = ', I1, ', FNU = ', E14.7 /
     +        ' X = ', E14.7, ', ER = ', E14.7, ', TOL = ', E14.7 /
     +        ' Y(1) = ', E14.7, ', Y(2) = ', E14.7 /
     +        ' W(1) = ', E14.7, ', W(2) = ', E14.7)
90030 FORMAT (/ ' ERROR IN QUICK CHECK OF LARGE X AND ORDER', 1P /
     +        ' K = ', I1,', N = ', I1, ', I = ', I1,
     +        ', FNUP = ', E14.7 /
     +        ' X = ', E14.7, ', ER = ', E14.7, ', TOL = ', E14.7 /
     +        ' Y(1) = ', E14.7, ', Y(2) = ', E14.7 /
     +        ' W(1) = ', E14.7, ', W(2) = ', E14.7)
90040 FORMAT (/ ' ERROR IN DBESI UNDERFLOW TEST' /)
90050 FORMAT (/ ' ERROR IN DBESK UNDERFLOW TEST' /)
90060 FORMAT (// ' TRIGGER 10 ERROR CONDITIONS' //)
90070 FORMAT (/ ' AT LEAST ONE INCORRECT ARGUMENT TEST FAILED')
90080 FORMAT (/ ' ALL INCORRECT ARGUMENT TESTS PASSED')
90100 FORMAT (/' *********DBESI AND DBESK PASSED ALL TESTS***********')
90110 FORMAT (/' *********DBESI OR DBESK FAILED SOME TESTS***********')
      END