blob: ce7f0fbf1f11347b13a17cebe0c7595e36676dd6 [file] [log] [blame]
 !Program to test EXPONENT and FRACTION intrinsic function. program test_exponent_fraction real x integer*4 i real*8 y integer*8 j equivalence (x, i), (y, j) x = 3. call test_4(x) x = 0. call test_4(x) i = int(o'00000000001') call test_4(x) i = int(o'00010000000') call test_4(x) i = int(o'17700000000') call test_4(x) i = int(o'00004000001') call test_4(x) i = int(o'17737777777') call test_4(x) i = int(o'10000000000') call test_4(x) i = int(o'0000010000') call test_4(x) y = 0.5 call test_8(y) y = 0. call test_8(y) j = int(o'00000000001',8) call test_8(y) y = 0.2938735877D-38 call test_8(y) y = -1.469369D-39 call test_8(y) y = real(z'7fe00000',8) call test_8(y) y = -5.739719D+42 call test_8(y) end subroutine test_4(x) real*4 x,y integer z y = fraction (x) z = exponent(x) if (z .gt. 0) then y = (y * 2.) * (2. ** (z - 1)) else y = (y / 2.) * (2. ** (z + 1)) end if if (abs (x - y) .gt. spacing (max (abs (x), abs (y)))) STOP 1 end subroutine test_8(x) real*8 x, y integer z y = fraction (x) z = exponent(x) if (z .gt. 0) then y = (y * 2._8) * (2._8 ** (z - 1)) else y = (y / 2._8) * (2._8 ** (z + 1)) end if if (abs (x - y) .gt. spacing (max (abs (x), abs(y)))) STOP 2 end