OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [pr33794.f90] - Blame information for rev 801

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { 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
        call abort
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
49
 
50
! { dg-final { cleanup-modules "scc_m" } }

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.