*DECK CDQAGI
SUBROUTINE CDQAGI (LUN, KPRINT, IPASS)
C***BEGIN PROLOGUE CDQAGI
C***PURPOSE Quick check for DQAGI.
C***LIBRARY SLATEC
C***TYPE DOUBLE PRECISION (CQAGI-S, CDQAGI-D)
C***AUTHOR (UNKNOWN)
C***ROUTINES CALLED D1MACH, DPRIN, DQAGI, DT0, DT1, DT2, DT3, DT4, DT5
C***REVISION HISTORY (YYMMDD)
C ?????? DATE WRITTEN
C 891009 Removed unreferenced variables. (WRB)
C 891214 Prologue converted to Version 4.0 format. (BAB)
C 901205 Added PASS/FAIL message and changed the name of the first
C argument. (RWC)
C 910501 Added PURPOSE and TYPE records. (WRB)
C***END PROLOGUE CDQAGI
C
C FOR FURTHER DOCUMENTATION SEE ROUTINE CQPDOC
C
DOUBLE PRECISION ABSERR,BOUND,D1MACH,EPMACH,EPSABS,
* EPSREL,ERROR,EXACT0,EXACT1,EXACT2,EXACT3,EXACT4,
* OFLOW,RESULT,DT0,DT1,DT2,DT3,DT4,DT5,UFLOW,WORK
INTEGER IER,IP,IPASS,IWORK,KPRINT,LAST,LENW,LIMIT,LUN,NEVAL
DIMENSION WORK(800),IWORK(200),IERV(4)
EXTERNAL DT0,DT1,DT2,DT3,DT4,DT5
DATA EXACT0/2.0D+00/,EXACT1/0.115470066904D1/
DATA EXACT2/0.909864525656D-02/
DATA EXACT3/0.31415926535897932D+01/
DATA EXACT4/0.19984914554328673D+04/
C***FIRST EXECUTABLE STATEMENT CDQAGI
IF (KPRINT.GE.2) WRITE (LUN, '(''1DQAGI QUICK CHECK''/)')
C
C TEST ON IER = 0
C
IPASS = 1
LIMIT = 200
LENW = LIMIT*4
EPSABS = 0.0D+00
EPMACH = D1MACH(4)
EPSREL = MAX(SQRT(EPMACH),0.1D-07)
BOUND = 0.0D+00
INF = 1
CALL DQAGI(DT0,BOUND,INF,EPSABS,EPSREL,RESULT,ABSERR,NEVAL,IER,
* LIMIT,LENW,LAST,IWORK,WORK)
ERROR = ABS(RESULT-EXACT0)
IERV(1) = IER
IP = 0
IF(IER.EQ.0.AND.ERROR.LE.EPSREL*ABS(EXACT0))
* IP = 1
IF(IP.EQ.0) IPASS = 0
CALL DPRIN(LUN,0,KPRINT,IP,EXACT0,RESULT,ABSERR,NEVAL,IERV,1)
C
C TEST ON IER = 1
C
CALL DQAGI(DT1,BOUND,INF,EPSABS,EPSREL,RESULT,ABSERR,NEVAL,IER,
* 1,4,LAST,IWORK,WORK)
IERV(1) = IER
IP = 0
IF(IER.EQ.1) IP = 1
IF(IP.EQ.0) IPASS = 0
CALL DPRIN(LUN,1,KPRINT,IP,EXACT1,RESULT,ABSERR,NEVAL,IERV,1)
C
C TEST ON IER = 2 OR 4 OR 1
C
UFLOW = D1MACH(1)
CALL DQAGI(DT2,BOUND,INF,UFLOW,0.0D+00,RESULT,ABSERR,NEVAL,IER,
* LIMIT,LENW,LAST,IWORK,WORK)
IERV(1) = IER
IERV(2) = 4
IERV(3) = 1
IP = 0
IF(IER.EQ.2.OR.IER.EQ.4.OR.IER.EQ.1) IP = 1
IF(IP.EQ.0) IPASS = 0
CALL DPRIN(LUN,2,KPRINT,IP,EXACT2,RESULT,ABSERR,NEVAL,IERV,3)
C
C TEST ON IER = 3 OR 4 OR 1 OR 2
C
CALL DQAGI(DT3,BOUND,INF,UFLOW,0.0D+00,RESULT,ABSERR,NEVAL,IER,
* LIMIT,LENW,LAST,IWORK,WORK)
IERV(1) = IER
IERV(2) = 4
IERV(3) = 1
IERV(4) = 2
IP = 0
IF(IER.EQ.3.OR.IER.EQ.4.OR.IER.EQ.1.OR.IER.EQ.2) IP = 1
IF(IP.EQ.0) IPASS = 0
CALL DPRIN(LUN,3,KPRINT,IP,EXACT3,RESULT,ABSERR,NEVAL,IERV,4)
C
C TEST ON IER = 4 OR 3 OR 1 OR 0
C
CALL DQAGI(DT4,BOUND,INF,EPSABS,EPSREL,RESULT,ABSERR,NEVAL,IER,
* LIMIT,LENW,LAST,IWORK,WORK)
IERV(1) = IER
IERV(2) = 3
IERV(3) = 1
IERV(4) = 0
IP = 0
IF(IER.EQ.4.OR.IER.EQ.3.OR.IER.EQ.1.OR.IER.EQ.0) IP = 1
IF(IP.EQ.0) IPASS = 0
CALL DPRIN(LUN,4,KPRINT,IP,EXACT4,RESULT,ABSERR,NEVAL,IERV,4)
C
C TEST ON IER = 5
C
OFLOW = D1MACH(2)
CALL DQAGI(DT5,BOUND,INF,EPSABS,EPSREL,RESULT,ABSERR,NEVAL,IER,
* LIMIT,LENW,LAST,IWORK,WORK)
IERV(1) = IER
IP = 0
IF(IER.EQ.5) IP = 1
IF(IP.EQ.0) IPASS = 0
CALL DPRIN(LUN,5,KPRINT,IP,OFLOW,RESULT,ABSERR,NEVAL,IERV,1)
C
C TEST ON IER = 6
C
CALL DQAGI(DT1,BOUND,INF,EPSABS,0.0D+00,RESULT,ABSERR,NEVAL,IER,
* LIMIT,LENW,LAST,IWORK,WORK)
IERV(1) = IER
IP = 0
IF(IER.EQ.6.AND.RESULT.EQ.0.0D+00.AND.ABSERR.EQ.0.0D+00.AND.
* NEVAL.EQ.0.AND.LAST.EQ.0) IP = 1
IF(IP.EQ.0) IPASS = 0
CALL DPRIN(LUN,6,KPRINT,IP,EXACT1,RESULT,ABSERR,NEVAL,IERV,1)
C
IF (KPRINT.GE.1) THEN
IF (IPASS.EQ.0) THEN
WRITE(LUN, '(/'' SOME TEST(S) IN CDQAGI FAILED''/)')
ELSEIF (KPRINT.GE.2) THEN
WRITE(LUN, '(/'' ALL TEST(S) IN CDQAGI PASSED''/)')
ENDIF
ENDIF
RETURN
END
.