1! Program to test mathematical intrinsics
2subroutine dotest (n, val4, val8, known)
3   implicit none
4   real(kind=4) val4, known
5   real(kind=8) val8
6   integer n
7
8   if (abs (val4 - known) .gt. 0.001) call abort
9   if (abs (real (val8, kind=4) - known) .gt. 0.001) call abort
10end subroutine
11
12subroutine dotestc (n, val4, val8, known)
13   implicit none
14   complex(kind=4) val4, known
15   complex(kind=8) val8
16   integer n
17   if (abs (val4 - known) .gt. 0.001) call abort
18   if (abs (cmplx (val8, kind=4) - known) .gt. 0.001) call abort
19end subroutine
20
21program testmath
22   implicit none
23   real(kind=4) r, two4, half4
24   real(kind=8) q, two8, half8
25   complex(kind=4) cr
26   complex(kind=8) cq
27   external dotest, dotestc
28
29   two4 = 2.0
30   two8 = 2.0_8
31   half4 = 0.5
32   half8 = 0.5_8
33   r = sin (two4)
34   q = sin (two8)
35   call dotest (1, r, q, 0.9093)
36   r = cos (two4)
37   q = cos (two8)
38   call dotest (2, r, q, -0.4161)
39   r = tan (two4)
40   q = tan (two8)
41   call dotest (3, r, q, -2.1850)
42   r = asin (half4)
43   q = asin (half8)
44   call dotest (4, r, q, 0.5234)
45   r = acos (half4)
46   q = acos (half8)
47   call dotest (5, r, q, 1.0472)
48   r = atan (half4)
49   q = atan (half8)
50   call dotest (6, r, q, 0.4636)
51   r = atan2 (two4, half4)
52   q = atan2 (two8, half8)
53   call dotest (7, r, q, 1.3258)
54   r = exp (two4)
55   q = exp (two8)
56   call dotest (8, r, q, 7.3891)
57   r = log (two4)
58   q = log (two8)
59   call dotest (9, r, q, 0.6931)
60   r = log10 (two4)
61   q = log10 (two8)
62   call dotest (10, r, q, 0.3010)
63   r = sinh (two4)
64   q = sinh (two8)
65   call dotest (11, r, q, 3.6269)
66   r = cosh (two4)
67   q = cosh (two8)
68   call dotest (12, r, q, 3.7622)
69   r = tanh (two4)
70   q = tanh (two8)
71   call dotest (13, r, q, 0.9640)
72   r = sqrt (two4)
73   q = sqrt (two8)
74   call dotest (14, r, q, 1.4142)
75
76   r = atan2 (0.0, 1.0)
77   q = atan2 (0.0_8, 1.0_8)
78   call dotest (15, r, q, 0.0)
79   r = atan2 (-1.0, 1.0)
80   q = atan2 (-1.0_8, 1.0_8)
81   call dotest (16, r, q, -0.7854)
82   r = atan2 (0.0, -1.0)
83   q = atan2 (0.0_8, -1.0_8)
84   call dotest (17, r, q, 3.1416)
85   r = atan2 (-1.0, -1.0)
86   q = atan2 (-1.0_8, -1.0_8)
87   call dotest (18, r, q, -2.3562)
88   r = atan2 (1.0, 0.0)
89   q = atan2 (1.0_8, 0.0_8)
90   call dotest (19, r, q, 1.5708)
91   r = atan2 (-1.0, 0.0)
92   q = atan2 (-1.0_8, 0.0_8)
93   call dotest (20, r, q, -1.5708)
94
95   cr = log ((-1.0, -1.0))
96   cq = log ((-1.0_8, -1.0_8))
97   call dotestc (21, cr, cq, (0.3466, -2.3562))
98
99end program
100
101