1 ! Program to test mathematical intrinsics
2 subroutine dotest (n
, val4
, val8
, known
)
4 real(kind
=4) val4
, known
8 if (abs (val4
- known
) .gt
. 0.001) call abort
9 if (abs (real (val8
, kind
=4) - known
) .gt
. 0.001) call abort
12 subroutine dotestc (n
, val4
, val8
, known
)
14 complex(kind
=4) val4
, known
17 if (abs (val4
- known
) .gt
. 0.001) call abort
18 if (abs (cmplx (val8
, kind
=4) - known
) .gt
. 0.001) call abort
23 real(kind
=4) r
, two4
, half4
24 real(kind
=8) q
, two8
, half8
27 external dotest
, dotestc
35 call dotest (1, r
, q
, 0.9093)
38 call dotest (2, r
, q
, -0.4161)
41 call dotest (3, r
, q
, -2.1850)
44 call dotest (4, r
, q
, 0.5234)
47 call dotest (5, r
, q
, 1.0472)
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)
56 call dotest (8, r
, q
, 7.3891)
59 call dotest (9, r
, q
, 0.6931)
62 call dotest (10, r
, q
, 0.3010)
65 call dotest (11, r
, q
, 3.6269)
68 call dotest (12, r
, q
, 3.7622)
71 call dotest (13, r
, q
, 0.9640)
74 call dotest (14, r
, q
, 1.4142)
77 q
= atan2 (0.0_8
, 1.0_8
)
78 call dotest (15, r
, q
, 0.0)
80 q
= atan2 (-1.0_8
, 1.0_8
)
81 call dotest (16, r
, q
, -0.7854)
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)
89 q
= atan2 (1.0_8
, 0.0_8
)
90 call dotest (19, r
, q
, 1.5708)
92 q
= atan2 (-1.0_8
, 0.0_8
)
93 call dotest (20, r
, q
, -1.5708)
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))