This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[PATCH] fortran testcase for PR 33794
- From: Uros Bizjak <ubizjak at gmail dot com>
- To: François-Xavier Coudert <fxcoudert at gmail dot com>
- Cc: Fortran List <fortran at gcc dot gnu dot org>, GCC Patches <gcc-patches at gcc dot gnu dot org>
- Date: Wed, 17 Oct 2007 19:10:03 +0200
- Subject: [PATCH] fortran testcase for PR 33794
- Dkim-signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=beta; h=domainkey-signature:received:received:message-id:date:from:user-agent:mime-version:to:cc:subject:references:in-reply-to:content-type; bh=36KC3BWd3wYk3Mzd8K8CN3xtWxcSikerqjY4/VscbvY=; b=aD33DM3UbKgugUcPYV8cUASD19cX1Iw/KDWl834nLixFcRHKZ5Bx8bpM19qanto7rNnWk8rLVNSuWFzCJAGnE8j1HINJMVieznVKjcKyqtfr+6O3uQfHB3M8HhV19rVqeDHX1fT3XTmm6/V1lJQoaROY5zKYMqKaLwsnvwvO/4o=
- Domainkey-signature: a=rsa-sha1; c=nofws; d=gmail.com; s=beta; h=received:message-id:date:from:user-agent:mime-version:to:cc:subject:references:in-reply-to:content-type; b=VYSO7IIaC82lN8y1ugV0GCGYNE8DHw8b73iTEJqT9wSuHRbVJq7uuQVsxtT61IF6paug55YvkYdU38Mnakr8+OmbHTwr6J1Qahypxh/x+j8QllvNm8mBmWRdL92Hajnzu1Vteg2OZUWKxtv6ax0uyjhzP7u8KenVOIBxkVS1cp0=
- References: <5787cf470710170756v6cbbe7c0w95f536113f089cb@mail.gmail.com> <19c433eb0710170819l4f94136ak8e3e1da2c867f5ec@mail.gmail.com>
François-Xavier Coudert wrote:
What about this? You can change the tolerance in the line before "call abort".
Thank you very much! I think that 0.1% is more than enough for this
testcase. I have added a couple of dg directives and committed attached
patch.
2007-10-17 Uros Bizjak <ubizjak@gmail.com>
Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR middle-end/33794
* gfortran.dg/pr33794.f90: New testcase.
Patch was tested on i686-pc-linux-gnu.
Thanks again for your kind help,
Uros.
Index: testsuite/gfortran.dg/pr33794.f90
===================================================================
--- testsuite/gfortran.dg/pr33794.f90 (revision 0)
+++ testsuite/gfortran.dg/pr33794.f90 (revision 0)
@@ -0,0 +1,50 @@
+! { dg-do run }
+! { dg-options "-O2 -ffast-math -mfpmath=387" { target { { i?86-*-* x86_64-*-* } && lp64 } } }
+! { dg-options "-O2 -ffast-math" }
+
+module scc_m
+ implicit none
+ integer, parameter :: dp = selected_real_kind(15,90)
+contains
+ subroutine self_ind_cir_coil (r, l, turns, mu, self_l)
+ implicit none
+ real (kind = dp), intent(in) :: r, l, turns, mu
+ real (kind = dp), intent(out) :: self_l
+ real (kind = dp) :: alpha, modulus, pk, ak, bk, ae, be, elliptice, elliptick
+ real (kind = dp) :: expected
+ alpha = atan(2.0_dp*r/l)
+ modulus = sin(alpha)
+ pk = 1.0_dp - modulus**2
+ ak = (((0.01451196212_dp*pk+0.03742563713_dp)*pk+ &
+ 0.03590092383_dp)*pk+0.09666344259_dp)*pk+1.38629436112_dp
+ bk = (((0.00441787012_dp*pk+0.03328355346_dp)*pk+ &
+ 0.06880248576_dp)*pk+0.12498593597_dp)*pk+0.5_dp
+ elliptick = ak - bk * log(pk)
+ ae = (((0.01736506451_dp*pk+0.04757383546_dp)*pk+ &
+ 0.0626060122_dp)*pk+0.44325141463_dp)*pk+1.0_dp
+ be = (((0.00526449639_dp*pk+0.04069697526_dp)*pk+ &
+ 0.09200180037_dp)*pk+0.2499836831_dp)*pk
+ elliptice = ae - be * log(pk)
+ self_l = (mu * turns**2 * l**2 * 2.0_dp * r)/3.0_dp * &
+ (((tan(alpha)**2-1.0_dp)*elliptice+elliptick)/sin(alpha) - &
+ tan(alpha)**2)
+ expected = 3.66008420600434162E-002_dp
+ if (abs(self_l - expected) / expected > 1e-3) &
+ call abort
+ end subroutine self_ind_cir_coil
+end module scc_m
+
+program test
+ use scc_m
+ implicit none
+
+ real (kind = dp) :: mu, turns, r, l, self_l
+ mu = 1.25663706143591729E-006_dp
+ turns = 166666.66666666666_dp
+ l = 3.00000000000000006E-003_dp
+ r = 2.99999999999999989E-002_dp
+
+ call self_ind_cir_coil (r, l, turns, mu, self_l)
+end program test
+
+! { dg-final { cleanup-modules "scc_m" } }