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