gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_scale.f90

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