gcc/testsuite/gfortran.dg/pr33794.f90

   1 ! { dg-do run }
   2 ! { dg-options "-O2 -ffast-math -mfpmath=387" { target { { i?86-*-* x86_64-*-* } && { ! { ia32 } } } } }
   3 ! { dg-options "-O2 -ffast-math" }
   4
   5 module scc_m
   6   implicit none
   7   integer, parameter :: dp = selected_real_kind(15,90)
   8 contains
   9   subroutine self_ind_cir_coil (r, l, turns, mu, self_l)
  10   implicit none
  11   real (kind = dp), intent(in) :: r, l, turns, mu
  12   real (kind = dp), intent(out) :: self_l
  13   real (kind = dp) :: alpha, modulus, pk, ak, bk, ae, be, elliptice, elliptick
  14   real (kind = dp) :: expected
  15   alpha = atan(2.0_dp*r/l)
  16   modulus = sin(alpha)
  17   pk = 1.0_dp - modulus**2
  18   ak = (((0.01451196212_dp*pk+0.03742563713_dp)*pk+ &
  19          0.03590092383_dp)*pk+0.09666344259_dp)*pk+1.38629436112_dp
  20   bk = (((0.00441787012_dp*pk+0.03328355346_dp)*pk+ &
  21          0.06880248576_dp)*pk+0.12498593597_dp)*pk+0.5_dp
  22   elliptick = ak - bk * log(pk)
  23   ae = (((0.01736506451_dp*pk+0.04757383546_dp)*pk+ &
  24          0.0626060122_dp)*pk+0.44325141463_dp)*pk+1.0_dp
  25   be = (((0.00526449639_dp*pk+0.04069697526_dp)*pk+ &
  26          0.09200180037_dp)*pk+0.2499836831_dp)*pk
  27   elliptice = ae - be * log(pk)
  28   self_l = (mu * turns**2 * l**2 * 2.0_dp * r)/3.0_dp * &
  29            (((tan(alpha)**2-1.0_dp)*elliptice+elliptick)/sin(alpha) - &
  30             tan(alpha)**2)
  31   expected = 3.66008420600434162E-002_dp
  32   if (abs(self_l - expected) / expected > 1e-3) &
  33         STOP 1
  34   end subroutine self_ind_cir_coil
  35 end module scc_m
  36
  37 program test
  38   use scc_m
  39   implicit none
  40
  41   real (kind = dp) :: mu, turns, r, l, self_l
  42   mu = 1.25663706143591729E-006_dp
  43   turns = 166666.66666666666_dp
  44   l = 3.00000000000000006E-003_dp
  45   r = 2.99999999999999989E-002_dp
  46
  47   call self_ind_cir_coil (r, l, turns, mu, self_l)
  48 end program test