1!Program to test SPACING intrinsic function.
2
3program test_spacing
4  call test_real4(3.0)
5  call test_real4(33.0)
6  call test_real4(-3.)
7  call test_real4(0.0)
8  call test_real8(0.0_8)
9  call test_real8(3.0_8)
10  call test_real8(33.0_8)
11  call test_real8(-33._8)
12end
13subroutine test_real4(orig)
14  real x,y,t,orig
15  integer p
16  x = orig
17  p = 24
18  y = 2.0 ** (exponent (x) - p)
19  t = tiny(x)
20  x = spacing(x)
21  if ((abs (x - y) .gt. abs(x * 1e-6)) &
22    .and. (abs (x - t) .gt. abs(x * 1e-6)))call abort
23end
24
25subroutine test_real8(orig)
26  real*8 x,y,t,orig
27  integer p
28  x = orig
29  p = 53
30  y = 2.0 ** (exponent (x) - p)
31  t = tiny (x)
32  x = spacing(x)
33  if ((abs (x - y) .gt. abs(x * 1e-6)) &
34    .and. (abs (x - t) .gt. abs(x * 1e-6)))call abort
35end
36