4 c Test Bessel function intrinsics.
5 c These functions are only available if provided by system
7 c David Billinghurst <David.Billinghurst@riotinto.com>
10 double precision dx
, da
17 c ERF - error function
20 call c_r
(ERF
(x
),a
,'ERF(real)')
21 call c_d
(ERF
(dx
),da
,'ERF(double)')
22 call c_d
(DERF
(dx
),da
,'DERF(double)')
24 c ERFC - complementary error function
27 call c_r
(ERFC
(x
),a
,'ERFC(real)')
28 call c_d
(ERFC
(dx
),da
,'ERFC(double)')
29 call c_d
(DERFC
(dx
),da
,'DERFC(double)')
31 if ( fail
) call abort
()
34 subroutine failure
(label
)
35 c Report failure and set flag
39 write(6,'(a,a,a)') 'Test ',label
,' FAILED'
43 subroutine c_r
(a
,b
,label
)
44 c Check if REAL a equals b, and fail otherwise
47 if ( abs
(a
-b
) .gt
. 1.0e-5 ) then
49 write(6,*) 'Got ',a
,' expected ', b
53 subroutine c_d
(a
,b
,label
)
54 c Check if DOUBLE PRECISION a equals b, and fail otherwise
57 if ( abs
(a
-b
) .gt
. 1.0d
-5 ) then
59 write(6,*) 'Got ',a
,' expected ', b