1!Program to test EXPONENT and FRACTION intrinsic function.
2
3program test_exponent_fraction
4  real x
5  integer*4 i
6  real*8 y
7  integer*8 j
8  equivalence (x, i), (y, j)
9
10  x = 3.
11  call test_4(x)
12
13  x = 0.
14  call test_4(x)
15
16  i = o'00000000001'
17  call test_4(x)
18
19  i = o'00010000000'
20  call test_4(x)
21
22  i = o'17700000000'
23  call test_4(x)
24
25  i = o'00004000001'
26  call test_4(x)
27
28  i = o'17737777777'
29  call test_4(x)
30
31  i = o'10000000000'
32  call test_4(x)
33
34  i = o'0000010000'
35  call test_4(x)
36
37  y = 0.5
38  call test_8(y)
39
40  y = 0.
41  call test_8(y)
42
43  j = o'00000000001'
44  call test_8(y)
45
46  y = 0.2938735877D-38
47  call test_8(y)
48
49  y = -1.469369D-39
50  call test_8(y)
51
52  y = z'7fe00000'
53  call test_8(y)
54
55  y = -5.739719D+42
56  call test_8(y)
57end
58
59subroutine test_4(x)
60real*4 x,y
61integer z
62y = fraction (x)
63z = exponent(x)
64if (z .gt. 0) then
65  y = (y * 2.) * (2. ** (z - 1))
66else
67  y = (y / 2.) * (2. ** (z + 1))
68end if
69if (abs (x - y) .gt. spacing (max (abs (x), abs (y)))) call abort()
70end
71
72subroutine test_8(x)
73real*8 x, y
74integer z
75y = fraction (x)
76z = exponent(x)
77if (z .gt. 0) then
78  y = (y * 2._8) * (2._8 ** (z - 1))
79else
80  y = (y / 2._8) * (2._8 ** (z + 1))
81end if
82if (abs (x - y) .gt. spacing (max (abs (x), abs(y)))) call abort()
83end
84
85