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