1!Program to test SCALE intrinsic function. 2 3program test_scale 4 call test_real4 (3.0, 2) 5 call test_real4 (33.0, -2) 6 call test_real4 (-3., 2) 7 call test_real4 (0., 3) 8 call test_real8 (0._8, 3) 9 call test_real8 (3.0_8, 4) 10 call test_real8 (33.0_8, -4) 11 call test_real8 (-33._8, 4) 12end 13subroutine test_real4 (orig, i) 14 real x,y,orig 15 integer i 16 x = orig 17 y = x * (2.0 ** i) 18 x = scale (x, i) 19 if (abs (x - y) .gt. abs(x * 1e-6)) STOP 1 20end 21 22subroutine test_real8 (orig, i) 23 real*8 x,y,orig 24 integer i 25 x = orig 26 y = x * (2.0 ** i) 27 x = scale (x, i) 28 if (abs (x - y) .gt. abs(x * 1e-6)) STOP 2 29end 30