1*DECK CDQAWO
2      SUBROUTINE CDQAWO (LUN, KPRINT, IPASS)
3C***BEGIN PROLOGUE  CDQAWO
4C***PURPOSE  Quick check for DQAWO.
5C***LIBRARY   SLATEC
6C***TYPE      DOUBLE PRECISION (CQAWO-S, CDQAWO-D)
7C***AUTHOR  (UNKNOWN)
8C***ROUTINES CALLED  D1MACH, DF0O, DF1O, DF2O, DPRIN, DQAWO
9C***REVISION HISTORY  (YYMMDD)
10C   ??????  DATE WRITTEN
11C   891214  Prologue converted to Version 4.0 format.  (BAB)
12C   901205  Added PASS/FAIL message and changed the name of the first
13C           argument.  (RWC)
14C   910501  Added PURPOSE and TYPE records.  (WRB)
15C***END PROLOGUE  CDQAWO
16C
17C FOR FURTHER DOCUMENTATION SEE ROUTINE CQPDOC
18C
19      DOUBLE PRECISION A,ABSERR,B,EPMACH,EPSABS,
20     *  EPSREL,ERROR,EXACT0,DF0O,DF1O,DF2O,
21     *  OFLOW,OMEGA,PI,RESULT,D1MACH,UFLOW,WORK
22      INTEGER IER,IERV,INTEGR,IP,IPASS,IWORK,KPRINT,LAST,LENW,LUN,
23     *  MAXP1,NEVAL
24      DIMENSION WORK(1325),IWORK(400),IERV(4)
25      EXTERNAL DF0O,DF1O,DF2O
26      DATA EXACT0/0.1042872789432789D+05/
27      DATA PI/0.31415926535897932D+01/
28C***FIRST EXECUTABLE STATEMENT  CDQAWO
29      IF (KPRINT.GE.2) WRITE (LUN, '(''1DQAWO QUICK CHECK''/)')
30C
31C TEST ON IER = 0
32C
33      IPASS = 1
34      MAXP1 = 21
35      LENIW = 400
36      LENW = LENIW*2+MAXP1*25
37      EPSABS = 0.0D+00
38      EPMACH = D1MACH(4)
39      EPSREL = MAX(SQRT(EPMACH),0.1D-07)
40      A = 0.0D+00
41      B = PI
42      OMEGA = 0.1D+01
43      INTEGR = 2
44      CALL DQAWO(DF0O,A,B,OMEGA,INTEGR,EPSABS,EPSREL,RESULT,ABSERR,
45     * NEVAL,IER,LENIW,MAXP1,LENW,LAST,IWORK,WORK)
46      IERV(1) = IER
47      IP = 0
48      ERROR = ABS(EXACT0-RESULT)
49      IF(IER.EQ.0.AND.ERROR.LE.ABSERR.AND.ABSERR.LE.EPSREL*ABS(EXACT0))
50     *  IP = 1
51      IF(IP.EQ.0) IPASS = 0
52      CALL DPRIN(LUN,0,KPRINT,IP,EXACT0,RESULT,ABSERR,NEVAL,IERV,1)
53C
54C TEST ON IER = 1
55C
56      LENIW = 2
57      LENW = LENIW*2+MAXP1*25
58      CALL DQAWO(DF0O,A,B,OMEGA,INTEGR,EPSABS,EPSREL,RESULT,ABSERR,
59     * NEVAL,IER,LENIW,MAXP1,LENW,LAST,IWORK,WORK)
60      IERV(1) = IER
61      IP = 0
62      IF(IER.EQ.1) IP = 1
63      IF(IP.EQ.0) IPASS = 0
64      CALL DPRIN(LUN,1,KPRINT,IP,EXACT0,RESULT,ABSERR,NEVAL,IERV,1)
65C
66C TEST ON IER = 2 OR 4 OR 1
67C
68      UFLOW = D1MACH(1)
69      LENIW = 400
70      LENW = LENIW*2+MAXP1*25
71      CALL DQAWO(DF0O,A,B,OMEGA,INTEGR,UFLOW,0.0D+00,RESULT,ABSERR,
72     * NEVAL,IER,LENIW,MAXP1,LENW,LAST,IWORK,WORK)
73      IERV(1) = IER
74      IERV(2) = 4
75      IERV(3) = 1
76      IP = 0
77      IF(IER.EQ.2.OR.IER.EQ.4.OR.IER.EQ.1) IP = 1
78      IF(IP.EQ.0) IPASS = 0
79      CALL DPRIN(LUN,2,KPRINT,IP,EXACT0,RESULT,ABSERR,NEVAL,IERV,3)
80C
81C TEST ON IER = 3 OR 4 OR 1 OR 2
82C
83      B = 0.5D+01
84      OMEGA = 0.0D+00
85      INTEGR = 1
86      CALL DQAWO(DF1O,A,B,OMEGA,INTEGR,UFLOW,0.0D+00,RESULT,ABSERR,
87     * NEVAL,IER,LENIW,MAXP1,LENW,LAST,IWORK,WORK)
88      IERV(1) = IER
89      IERV(2) = 4
90      IERV(3) = 1
91      IERV(4) = 2
92      IP = 0
93      IF(IER.EQ.3.OR.IER.EQ.4.OR.IER.EQ.1.OR.IER.EQ.2) IP = 1
94      IF(IP.EQ.0) IPASS = 0
95      CALL DPRIN(LUN,3,KPRINT,IP,PI,RESULT,ABSERR,NEVAL,IERV,4)
96C
97C TEST ON IER = 5
98C
99      B = 0.1D+01
100      OFLOW = D1MACH(2)
101      CALL DQAWO(DF2O,A,B,OMEGA,INTEGR,EPSABS,EPSREL,RESULT,ABSERR,
102     * NEVAL,IER,LENIW,MAXP1,LENW,LAST,IWORK,WORK)
103      IERV(1) = IER
104      IP = 0
105      IF(IER.EQ.5) IP = 1
106      IF(IP.EQ.0) IPASS = 0
107      CALL DPRIN(LUN,5,KPRINT,IP,OFLOW,RESULT,ABSERR,NEVAL,IERV,1)
108C
109C TEST ON IER = 6
110C
111      INTEGR = 3
112      CALL DQAWO(DF0O,A,B,OMEGA,INTEGR,EPSABS,EPSREL,RESULT,ABSERR,
113     * NEVAL,IER,LENIW,MAXP1,LENW,LAST,IWORK,WORK)
114      IERV(1) = IER
115      IP = 0
116      IF(IER.EQ.6.AND.RESULT.EQ.0.0D+00.AND.ABSERR.EQ.0.0D+00.AND.
117     *  NEVAL.EQ.0.AND.LAST.EQ.0) IP = 1
118      IF(IP.EQ.0) IPASS = 0
119      CALL DPRIN(LUN,6,KPRINT,IP,EXACT0,RESULT,ABSERR,NEVAL,IERV,1)
120C
121      IF (KPRINT.GE.1) THEN
122         IF (IPASS.EQ.0) THEN
123            WRITE(LUN, '(/'' SOME TEST(S) IN CDQAWO FAILED''/)')
124         ELSEIF (KPRINT.GE.2) THEN
125            WRITE(LUN, '(/'' ALL TEST(S) IN CDQAWO PASSED''/)')
126         ENDIF
127      ENDIF
128      RETURN
129      END
130