1!Program to test SET_EXPONENT intrinsic function.
2
3program test_set_exponent
4  call test_real4()
5  call test_real8()
6end
7
8subroutine test_real4()
9  real*4 x,y
10  integer*4 i,n
11  equivalence(x, i)
12
13  n = -148
14  x = 1024.0
15  y = set_exponent (x, n)
16  if ((y .ne. 0.0) .and. (exponent (y) .ne. n)) STOP 1
17
18  n = 8
19  x = 1024.0
20  y = set_exponent (x, n)
21  if (exponent (y) .ne. n) STOP 2
22
23  n = 128
24  i = 8388607
25  x = transfer (i, x) ! z'007fffff' Positive denormalized floating-point.
26  y = set_exponent (x, n)
27  if (exponent (y) .ne. n) STOP 3
28
29  n = -148
30  x = -1024.0
31  y = set_exponent (x, n)
32  if  ((y .ne. 0.0) .and. (exponent (y) .ne. n)) STOP 4
33
34  n = 8
35  x = -1024.0
36  y = set_exponent (x, n)
37  if (y .ne. -128.0) STOP 5
38  if (exponent (y) .ne. n) STOP 6
39
40  n = 128
41  i = -2139095041
42  x = transfer (i, x) ! z'807fffff' Negative denormalized floating-point.
43  y = set_exponent (x, n)
44  if (exponent (y) .ne. n) STOP 7
45
46end
47
48subroutine test_real8()
49  implicit none
50  real*8 x, y
51  integer*8 i, n
52  equivalence(x, i)
53
54  n = -1073
55  x = 1024.0_8
56  y = set_exponent (x, n)
57  if  ((y .ne. 0.0_8) .and. (exponent (y) .ne. n)) STOP 8
58
59  n = 8
60  x = 1024.0_8
61  y = set_exponent (x, n)
62  if (y .ne. 128.0) STOP 9
63  if (exponent (y) .ne. n) STOP 10
64
65  n = 1024
66  i = 4503599627370495_8
67  x = transfer (i, x) !z'000fffffffffffff' Positive denormalized floating-point.
68  y = set_exponent (x, n)
69  if (exponent (y) .ne. n) STOP 11
70
71  n = -1073
72  x = -1024.0
73  y = set_exponent (x, n)
74  if ((y .ne. 0.0) .and. (exponent (y) .ne. n)) STOP 12
75
76  n = 8
77  x = -1024.0
78  y = set_exponent (x, n)
79  if (y .ne. -128.0) STOP 13
80  if (exponent (y) .ne. n) STOP 14
81
82  n = 1024
83  i = -9218868437227405313_8
84  x = transfer (i, x)!z'800fffffffffffff' Negative denormalized floating-point.
85  y = set_exponent (x, n)
86  if (exponent (y) .ne. n) STOP 15
87end
88