*DECK QCKIN
      SUBROUTINE QCKIN (LUN, KPRINT, IPASS)
C***BEGIN PROLOGUE  QCKIN
C***PURPOSE  Quick check for BSKIN.
C***LIBRARY   SLATEC
C***KEYWORDS  QUICK CHECK
C***AUTHOR  Amos, D. E., (SNLA)
C***DESCRIPTION
C
C     ABSTRACT
C     QCKIN IS A QUICK CHECK ROUTINE WHICH EXERCISES THE MAJOR
C     LOOPS IN SUBROUTINE BSKIN (X,N,KODE,M,Y,NZ,IERR) FOR BICKLEY
C     FUNCTIONS KI(J,X).  MORE PRECISELY, QCKIN DOES CONSISTENCY CHECKS
C     ON THE OUTPUT FROM BSKIN BY COMPARING SINGLE EVALUATIONS (M=1)
C     AGAINST SELECTED MEMBERS OF SEQUENCES WHICH ARE GENERATED BY
C     RECURSION.  IF THE RELATIVE ERROR IS LESS THAN 1000 TIMES UNIT
C     ROUND OFF, THEN THE TEST IS PASSED - IF NOT, THEN X, THE VALUES
C     TO BE COMPARED, THE RELATIVE ERROR AND PARAMETERS KODE, N, M AND K
C     ARE WRITTEN ON LOGICAL UNIT 6 WHERE K IS THE MEMBER OF THE
C     SEQUENCE OF LENGTH M WHICH FAILED THE TEST.  THAT IS, THE INDEX
C     OF THE FUNCTION WHICH FAILED THE TEST IS J=N+K-1.  UNDERFLOW
C     TESTS ARE MADE AND ERROR CONDITIONS ARE TRIGGERED.
C
C     FUNCTIONS I1MACH AND R1MACH MUST BE INITIALIZED ACCORDING TO THE
C     PROLOGUE IN EACH FUNCTION FOR THE MACHINE ENVIRONMENT BEFORE
C     QCKIN OR BSKIN CAN BE EXECUTED.  FIFTEEN MACHINE ENVIRONMENTS
C     CAN BE DEFINED IN I1MACH AND R1MACH.
C
C***ROUTINES CALLED  BSKIN, I1MACH, R1MACH
C***REVISION HISTORY  (YYMMDD)
C   820601  DATE WRITTEN
C   890911  Removed unnecessary intrinsics.  (WRB)
C   890911  REVISION DATE from Version 3.2
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C***END PROLOGUE  QCKIN
      INTEGER I, IERR, IFLG, IX, I1M12, J, K, KODE, LUN, M, MDEL, MM,
     * N, NDEL, NN, NZ
      INTEGER I1MACH
      REAL AIX, ER, TOL, V, X, XINC, Y
      REAL R1MACH
      DIMENSION V(1), Y(10)
C***FIRST EXECUTABLE STATEMENT  QCKIN
      TOL = 1000.0E0*MAX(R1MACH(4),1.0E-18)
      IFLG = 0
      IF(KPRINT.GE.3)WRITE (LUN,99999)
99999 FORMAT (1H1//34H QUICK CHECK DIAGNOSTICS FOR BSKIN//)
      DO 70 KODE=1,2
        N = 0
        DO 60 NN=1,7
          M = 1
          DO 50 MM=1,4
            X = 0.0E0
            DO 40 IX=1,6
              IF (N.EQ.0 .AND. IX.EQ.1) GO TO 30
              CALL BSKIN(X, N, KODE, M, Y, NZ, IERR)
              DO 20 K=1,M,2
                J = N + K - 1
                CALL BSKIN(X, J, KODE, 1, V, NZ, IERR)
                ER = ABS((V(1)-Y(K))/V(1))
                IF (ER.LE.TOL) GO TO 20
                IF (IFLG.NE.0) GO TO 10
                IF(KPRINT.GE.2)WRITE (LUN,99998)
99998           FORMAT (8X, 1HX, 13X, 4HV(1), 11X, 4HY(K), 9X, 6HREL ER,
     *           1HR, 5X, 4HKODE, 3X, 1HN, 4X, 1HM, 4X, 1HK)
   10           CONTINUE
                IFLG = IFLG + 1
                IF(KPRINT.GE.2)
     *          WRITE (LUN,99997) X, V(1), Y(K), ER, KODE, N, M, K
99997           FORMAT (4E15.6, 4I5)
                IF (IFLG.GT.200) GO TO 130
   20         CONTINUE
   30         CONTINUE
              AIX = 2*IX-3
              XINC = MAX(1.0E0,AIX)
              X = X + XINC
   40       CONTINUE
            MDEL = MAX(1,MM-1)
            M = M + MDEL
   50     CONTINUE
          NDEL = MAX(1,2*N-2)
          N = N + NDEL
   60   CONTINUE
   70 CONTINUE
C-----------------------------------------------------------------------
C     TEST UNDERFLOW
C-----------------------------------------------------------------------
      KODE = 1
      M = 10
      N = 10
      I1M12 = I1MACH(12)
      X = -2.302E0*R1MACH(5)*I1M12
      CALL BSKIN(X, N, KODE, M, Y, NZ, IERR)
      IF (NZ.EQ.M) GO TO 80
      IF(KPRINT.GE.2)WRITE (LUN,99996)
99996 FORMAT (//30H NZ IN UNDERFLOW TEST IS NOT 1//)
      IFLG = IFLG + 1
      GO TO 110
   80 CONTINUE
      DO 90 I=1,M
        IF (Y(I).NE.0.0E0) GO TO 100
   90 CONTINUE
      GO TO 110
  100 CONTINUE
      IFLG = IFLG + 1
      IF(KPRINT.GE.2)WRITE (LUN,99995)
99995 FORMAT (//43H SOME Y VALUE IN UNDERFLOW TEST IS NOT ZERO//)
  110 CONTINUE
      IF (IFLG.NE.0.OR.KPRINT.LT.3) GO TO 120
      WRITE (LUN,99994)
99994 FORMAT (//16H QUICK CHECKS OK//)
  120 CONTINUE
      IPASS=0
      IF(IFLG.EQ.0) IPASS=1
      RETURN
  130 CONTINUE
      IF(KPRINT.GE.2)WRITE (LUN,99992)
99992 FORMAT (//52H PROCESSING OF MAIN LOOPS TERMINATED BECAUSE THE NUM,
     * 36HBER OF DIAGNOSTIC PRINTS EXCEEDS 200//)
      IPASS=0
      IF(IFLG.EQ.0) IPASS=1
      RETURN
      END
