*DECK QCDRJ
      SUBROUTINE QCDRJ (LUN, KPRINT, IPASS)
C***BEGIN PROLOGUE  QCDRJ
C***PURPOSE  Quick check for DRJ.
C***LIBRARY   SLATEC
C***KEYWORDS  QUICK CHECK
C***AUTHOR  Pexton, R. L., (LLNL)
C***DESCRIPTION
C
C            QUICK TEST FOR CARLSON INTEGRAL DRJ
C
C***ROUTINES CALLED  D1MACH, DRJ, NUMXER, XERCLR, XGETF, XSETF
C***REVISION HISTORY  (YYMMDD)
C   790801  DATE WRITTEN
C   890618  REVISION DATE from Version 3.2
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   910708  Minor modifications in use of KPRINT.  (WRB)
C   930214  Added more digits to CONSJ.  (WRB)
C***END PROLOGUE  QCDRJ
      INTEGER KPRINT, IPASS, CONTRL, KONTRL, LUN, IER
      INTEGER IPASS1, IPASS2, IPASS3, IPASS4, NUMXER
      DOUBLE PRECISION CONSJ, TRJ, DRJ, DIF, D1MACH
      EXTERNAL D1MACH, DRJ, NUMXER, XERCLR, XGETF, XSETF
C***FIRST EXECUTABLE STATEMENT  QCDRJ
      CALL XERCLR
      CALL XGETF(CONTRL)
      IF ( KPRINT .GE. 3 ) THEN
         KONTRL = +1
      ELSE
         KONTRL = 0
      ENDIF
      CALL XSETF(KONTRL)
C
C  FORCE ERROR 1
C
      IF ( KPRINT .GE. 3 ) WRITE (LUN,101)
  101 FORMAT(' DRJ - FORCE ERROR 1 TO OCCUR')
      TRJ = DRJ(-1.0D0,-1.0D0,-1.0D0,-1.0D0,IER)
      IER = NUMXER(IER)
      IF ( IER .EQ. 1 ) THEN
         IPASS1 = 1
      ELSE
         IPASS1 = 0
      ENDIF
      CALL XERCLR
C
C  FORCE ERROR 2
C
      IF ( KPRINT .GE. 3 ) WRITE (LUN,102)
  102 FORMAT(' DRJ - FORCE ERROR 2 TO OCCUR')
      TRJ = DRJ(D1MACH(1),D1MACH(1),D1MACH(1),D1MACH(1),IER)
      IER = NUMXER(IER)
      IF ( IER .EQ. 2 ) THEN
         IPASS2 = 1
      ELSE
         IPASS2 = 0
      ENDIF
      CALL XERCLR
C
C  FORCE ERROR 3
C
      IF ( KPRINT .GE. 3 ) WRITE (LUN,103)
  103 FORMAT(' DRJ - FORCE ERROR 3 TO OCCUR')
      TRJ = DRJ(D1MACH(2),D1MACH(2),D1MACH(2),D1MACH(2),IER)
      IER = NUMXER(IER)
      IF ( IER .EQ. 3 ) THEN
         IPASS3 = 1
      ELSE
         IPASS3 = 0
      ENDIF
      CALL XERCLR
C
C  ARGUMENTS IN RANGE
C
      CONSJ = 0.14297579667156753833233879421985774801D0
      TRJ   = DRJ(2.0D0,3.0D0,4.0D0,5.0D0,IER)
      CALL XERCLR
      DIF   = TRJ - CONSJ
      IF ( (ABS(DIF/CONSJ).LT.1000.0D0*D1MACH(4)).AND.(IER.EQ.0) ) THEN
         IPASS4 = 1
      ELSE
         IPASS4 = 0
      ENDIF
      IPASS = MIN(IPASS1,IPASS2,IPASS3,IPASS4)
      IF (KPRINT .LE. 0 ) THEN
         GO TO 999
      ELSEIF ( KPRINT .EQ. 1 ) THEN
         IF ( IPASS .EQ. 1 ) THEN
            GO TO 999
         ELSE
            WRITE (LUN,104)
  104       FORMAT(' DRJ - FAILED')
            GO TO 999
         ENDIF
      ELSE
         IF ( IPASS .EQ. 1 ) THEN
            WRITE (LUN,105)
  105       FORMAT(' DRJ - PASSED')
            GO TO 999
         ELSE
            WRITE (LUN,104)
            IF ( IPASS4 .EQ. 0 ) WRITE (LUN,106) CONSJ, TRJ, DIF
  106       FORMAT(' CORRECT ANSWER =', 1PD20.14 /
     *             'COMPUTED ANSWER =',   D20.14 /
     *             '     DIFFERENCE =',   D20.14 )
            GO TO 999
         ENDIF
      ENDIF
  999 CONTINUE
      CALL XSETF(CONTRL)
      RETURN
      END
