1 !Program to test SET_EXPONENT intrinsic function.
3 program test_set_exponent
8 subroutine test_real4()
15 y = set_exponent (x, n)
16 if ((y .ne. 0.0) .and. (exponent (y) .ne. n)) call abort()
20 y = set_exponent (x, n)
21 if (exponent (y) .ne. n) call abort()
25 x = transfer (i, x) ! z'007fffff' Positive denormalized floating-point.
26 y = set_exponent (x, n)
27 if (exponent (y) .ne. n) call abort()
31 y = set_exponent (x, n)
32 if ((y .ne. 0.0) .and. (exponent (y) .ne. n)) call abort()
36 y = set_exponent (x, n)
37 if (y .ne. -128.0) call abort()
38 if (exponent (y) .ne. n) call abort()
42 x = transfer (i, x) ! z'807fffff' Negative denormalized floating-point.
43 y = set_exponent (x, n)
44 if (exponent (y) .ne. n) call abort()
48 subroutine test_real8()
56 y = set_exponent (x, n)
57 if ((y .ne. 0.0_8) .and. (exponent (y) .ne. n)) call abort()
61 y = set_exponent (x, n)
62 if (y .ne. 128.0) call abort()
63 if (exponent (y) .ne. n) call abort()
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) call abort()
73 y = set_exponent (x, n)
74 if ((y .ne. 0.0) .and. (exponent (y) .ne. n)) call abort()
78 y = set_exponent (x, n)
79 if (y .ne. -128.0) call abort()
80 if (exponent (y) .ne. n) call abort()
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) call abort()