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