1*DECK TEST13
2      PROGRAM TEST13
3C***BEGIN PROLOGUE  TEST13
4C***PURPOSE  Driver for testing SLATEC subprograms
5C***LIBRARY   SLATEC
6C***CATEGORY  C14
7C***TYPE      SINGLE PRECISION (TEST13-S, TEST14-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        RC       RD       RF       RJ
31C
32C***REFERENCES  Kirby W. Fong, Thomas H. Jefferson, Tokihiko Suyehiro
33C                 and Lee Walton, Guide to the SLATEC Common Mathema-
34C                 tical Library, April 10, 1990.
35C***ROUTINES CALLED  I1MACH, QCRC, QCRD, QCRF, QCRJ, XERMAX, XSETF,
36C                    XSETUN
37C***REVISION HISTORY  (YYMMDD)
38C   890618  DATE WRITTEN
39C   890618  REVISION DATE from Version 3.2
40C   891214  Prologue converted to Version 4.0 format.  (BAB)
41C   900524  Cosmetic changes to code.  (WRB)
42C***END PROLOGUE  TEST13
43      INTEGER IPASS, KPRINT, LIN, LUN, NFAIL
44C***FIRST EXECUTABLE STATEMENT  TEST13
45      LUN = I1MACH(2)
46      LIN = I1MACH(1)
47      NFAIL = 0
48C
49C     Read KPRINT parameter
50C
51      READ (LIN, '(I1)') KPRINT
52      CALL XERMAX(1000)
53      CALL XSETUN(LUN)
54      IF (KPRINT .LE. 1) THEN
55         CALL XSETF(0)
56      ELSE
57         CALL XSETF(1)
58      ENDIF
59C
60C     Test single precision Carlson elliptic routines
61C
62      CALL QCRC(LUN,KPRINT,IPASS)
63      IF (IPASS .EQ. 0) NFAIL = NFAIL + 1
64      CALL QCRD(LUN,KPRINT,IPASS)
65      IF (IPASS .EQ. 0) NFAIL = NFAIL + 1
66      CALL QCRF(LUN,KPRINT,IPASS)
67      IF (IPASS .EQ. 0) NFAIL = NFAIL + 1
68      CALL QCRJ(LUN,KPRINT,IPASS)
69      IF (IPASS .EQ. 0) NFAIL = NFAIL + 1
70C
71C     Write PASS or FAIL message
72C
73      IF (NFAIL .EQ. 0) THEN
74         WRITE (LUN, 9000)
75      ELSE
76         WRITE (LUN, 9010) NFAIL
77      ENDIF
78      STOP
79 9000 FORMAT (/' --------------TEST13 PASSED ALL TESTS----------------')
80 9010 FORMAT (/' ************* WARNING -- ', I5,
81     1        ' TEST(S) FAILED IN PROGRAM TEST13  *************')
82      END
83