old-autovect-branch/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._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)
  12 end
  13 subroutine 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)) call abort
  20 end
  21
  22 subroutine 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)) call abort
  29 end