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