1*DECK TEST40
2      PROGRAM TEST40
3C***BEGIN PROLOGUE  TEST40
4C***PURPOSE  Driver for testing SLATEC subprograms
5C***LIBRARY   SLATEC
6C***CATEGORY  H2
7C***TYPE      DOUBLE PRECISION (TEST39-S, TEST40-D)
8C***KEYWORDS  QUICK CHECK DRIVER
9C***AUTHOR  SLATEC Common Mathematical Library Committee
10C***DESCRIPTION
11C
12C *Usage:
13C     One input data record is required
14C         READ (LIN, '(I1)') KPRINT
15C
16C *Arguments:
17C     KPRINT = 0  Quick checks - No printing.
18C                 Driver       - Short pass or fail message printed.
19C              1  Quick checks - No message printed for passed tests,
20C                                short message printed for failed tests.
21C                 Driver       - Short pass or fail message printed.
22C              2  Quick checks - Print short message for passed tests,
23C                                fuller information for failed tests.
24C                 Driver       - Pass or fail message printed.
25C              3  Quick checks - Print complete quick check results.
26C                 Driver       - Pass or fail message printed.
27C
28C *Description:
29C     Driver for testing SLATEC subprograms
30C        DQAG     DQAGI    DQAGP    DQAGS    DQAWC
31C        DQAWF    DQAWO    DQAWS    DQNG
32C
33C***REFERENCES  Kirby W. Fong, Thomas H. Jefferson, Tokihiko Suyehiro
34C                 and Lee Walton, Guide to the SLATEC Common Mathema-
35C                 tical Library, April 10, 1990.
36C***ROUTINES CALLED  CDQAG, CDQAGI, CDQAGP, CDQAGS, CDQAWC, CDQAWF,
37C                    CDQAWO, CDQAWS, CDQNG, I1MACH, XERMAX, XSETF,
38C                    XSETUN
39C***REVISION HISTORY  (YYMMDD)
40C   890618  DATE WRITTEN
41C   890618  REVISION DATE from Version 3.2
42C   891214  Prologue converted to Version 4.0 format.  (BAB)
43C   900524  Cosmetic changes to code.  (WRB)
44C***END PROLOGUE  TEST40
45      INTEGER IPASS, KPRINT, LIN, LUN, NFAIL
46C***FIRST EXECUTABLE STATEMENT  TEST40
47      LUN = I1MACH(2)
48      LIN = I1MACH(1)
49      NFAIL = 0
50C
51C     Read KPRINT parameter
52C
53      READ (LIN, '(I1)') KPRINT
54      CALL XERMAX(1000)
55      CALL XSETUN(LUN)
56      IF (KPRINT .LE. 1) THEN
57         CALL XSETF(0)
58      ELSE
59         CALL XSETF(1)
60      ENDIF
61C
62C     Test double precision QUADPACK routines
63C
64C     Test DQAG.
65C
66      CALL CDQAG (LUN, KPRINT, IPASS)
67      IF (IPASS .EQ. 0) NFAIL = NFAIL + 1
68C
69C     Test DQAGS.
70C
71      CALL CDQAGS (LUN, KPRINT, IPASS)
72      IF (IPASS .EQ. 0) NFAIL = NFAIL + 1
73C
74C     Test DQAGP.
75C
76      CALL CDQAGP (LUN, KPRINT, IPASS)
77      IF (IPASS .EQ. 0) NFAIL = NFAIL + 1
78C
79C     Test DQAGI.
80C
81      CALL CDQAGI (LUN, KPRINT, IPASS)
82      IF (IPASS .EQ. 0) NFAIL = NFAIL + 1
83C
84C     Test DQAWO.
85C
86      CALL CDQAWO (LUN, KPRINT, IPASS)
87      IF (IPASS .EQ. 0) NFAIL = NFAIL + 1
88C
89C     Test DQAWF.
90C
91      CALL CDQAWF (LUN, KPRINT, IPASS)
92      IF (IPASS .EQ. 0) NFAIL = NFAIL + 1
93C
94C     Test DQAWS.
95C
96      CALL CDQAWS (LUN, KPRINT, IPASS)
97      IF (IPASS .EQ. 0) NFAIL = NFAIL + 1
98C
99C     Test DQAWC.
100C
101      CALL CDQAWC (LUN, KPRINT, IPASS)
102      IF (IPASS .EQ. 0) NFAIL = NFAIL + 1
103C
104C     Test DQNG.
105C
106      CALL CDQNG (LUN, KPRINT, IPASS)
107      IF (IPASS .EQ. 0) NFAIL = NFAIL + 1
108C
109C     Write PASS or FAIL message
110C
111      IF (NFAIL .EQ. 0) THEN
112         WRITE (LUN, 9000)
113      ELSE
114         WRITE (LUN, 9010) NFAIL
115      ENDIF
116      STOP
117 9000 FORMAT (/' --------------TEST40 PASSED ALL TESTS----------------')
118 9010 FORMAT (/' ************* WARNING -- ', I5,
119     1        ' TEST(S) FAILED IN PROGRAM TEST40 *************')
120      END
121