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