| ! { dg-options "-fdec-math" } |
| ! { dg-do run } |
| ! |
| ! Test extra math intrinsics offered by -fdec-math. |
| ! |
| |
| subroutine cmpf(f1, f2, tolerance, str) |
| implicit none |
| real(4), intent(in) :: f1, f2, tolerance |
| character(len=*), intent(in) :: str |
| if ( abs(f2 - f1) .gt. tolerance ) then |
| write (*, '(A,F12.6,F12.6)') str, f1, f2 |
| STOP 1 |
| endif |
| endsubroutine |
| |
| subroutine cmpd(d1, d2, tolerance, str) |
| implicit none |
| real(8), intent(in) :: d1, d2, tolerance |
| character(len=*), intent(in) :: str |
| if ( dabs(d2 - d1) .gt. tolerance ) then |
| write (*, '(A,F12.6,F12.6)') str, d1, d2 |
| STOP 2 |
| endif |
| endsubroutine |
| |
| implicit none |
| |
| real(4), parameter :: pi_f = (4.0_4 * atan(1.0_4)) |
| real(8), parameter :: pi_d = (4.0_8 * datan(1.0_8)) |
| real(4), parameter :: r2d_f = 180.0_4 / pi_f |
| real(8), parameter :: r2d_d = 180.0_8 / pi_d |
| real(4), parameter :: d2r_f = pi_f / 180.0_4 |
| real(8), parameter :: d2r_d = pi_d / 180.0_8 |
| |
| ! inputs |
| real(4) :: f_i1, f_i2 |
| real(4), volatile :: xf |
| real(8) :: d_i1, d_i2 |
| real(8), volatile :: xd |
| |
| ! expected outputs from (oe) default (oxe) expression |
| real(4) :: f_oe, f_oxe |
| real(8) :: d_oe, d_oxe |
| |
| ! actual outputs from (oa) default (oc) constant (ox) expression |
| real(4) :: f_oa, f_oc, f_ox |
| real(8) :: d_oa, d_oc, d_ox |
| |
| ! tolerance of the answer: assert |exp-act| <= tol |
| real(4) :: f_tol |
| real(8) :: d_tol |
| |
| ! equivalence tolerance |
| f_tol = 5e-5_4 |
| d_tol = 5e-6_8 |
| |
| ! multiplication factors to test non-constant expressions |
| xf = 2.0_4 |
| xd = 2.0_8 |
| |
| ! Input |
| f_i1 = 0.68032123_4 |
| d_i1 = 0.68032123_8 |
| |
| ! Expected |
| f_oe = r2d_f*acos (f_i1) |
| f_oxe = xf*r2d_f*acos (f_i1) |
| d_oe = r2d_d*dacos(d_i1) |
| d_oxe = xd*r2d_d*dacos(d_i1) |
| |
| ! Actual |
| f_oa = acosd (f_i1) |
| f_oc = acosd (0.68032123_4) |
| f_ox = xf*acosd (f_i1) |
| d_oa = dacosd (d_i1) |
| d_oc = dacosd (0.68032123_8) |
| d_ox = xd*dacosd (0.68032123_8) |
| |
| call cmpf(f_oe, f_oa, f_tol, "( ) acosd") |
| call cmpf(f_oe, f_oc, f_tol, "(c) acosd") |
| call cmpf(f_oxe, f_ox, f_tol, "(x) acosd") |
| call cmpd(d_oe, d_oa, d_tol, "( ) dacosd") |
| call cmpd(d_oe, d_oc, d_tol, "(c) dacosd") |
| call cmpd(d_oxe, d_ox, d_tol, "(x) dacosd") |
| |
| ! Input |
| f_i1 = 60.0_4 |
| d_i1 = 60.0_8 |
| |
| ! Expected |
| f_oe = cos (d2r_f*f_i1) |
| f_oxe = xf*cos (d2r_f*f_i1) |
| d_oe = cos (d2r_d*d_i1) |
| d_oxe = xd*cos (d2r_d*d_i1) |
| |
| ! Actual |
| f_oa = cosd (f_i1) |
| f_oc = cosd (60.0_4) |
| f_ox = xf* cosd (f_i1) |
| d_oa = dcosd (d_i1) |
| d_oc = dcosd (60.0_8) |
| d_ox = xd* cosd (d_i1) |
| |
| call cmpf(f_oe, f_oa, f_tol, "( ) cosd") |
| call cmpf(f_oe, f_oc, f_tol, "(c) cosd") |
| call cmpf(f_oxe, f_ox, f_tol, "(x) cosd") |
| call cmpd(d_oe, d_oa, d_tol, "( ) dcosd") |
| call cmpd(d_oe, d_oc, d_tol, "(c) dcosd") |
| call cmpd(d_oxe, d_ox, d_tol, "(x) cosd") |
| |
| ! Input |
| f_i1 = 0.79345021_4 |
| d_i1 = 0.79345021_8 |
| |
| ! Expected |
| f_oe = r2d_f*asin (f_i1) |
| f_oxe = xf*r2d_f*asin (f_i1) |
| d_oe = r2d_d*asin (d_i1) |
| d_oxe = xd*r2d_d*asin (d_i1) |
| |
| ! Actual |
| f_oa = asind (f_i1) |
| f_oc = asind (0.79345021_4) |
| f_ox = xf* asind (f_i1) |
| d_oa = dasind (d_i1) |
| d_oc = dasind (0.79345021_8) |
| d_ox = xd* asind (d_i1) |
| |
| call cmpf(f_oe, f_oa, f_tol, "( ) asind") |
| call cmpf(f_oe, f_oc, f_tol, "(c) asind") |
| call cmpf(f_oxe, f_ox, f_tol, "(x) asind") |
| call cmpd(d_oe, d_oa, d_tol, "( ) dasind") |
| call cmpd(d_oe, d_oc, d_tol, "(c) dasind") |
| call cmpd(d_oxe, d_ox, d_tol, "(x) asind") |
| |
| ! Input |
| f_i1 = 60.0_4 |
| d_i1 = 60.0_8 |
| |
| ! Expected |
| f_oe = sin (d2r_f*f_i1) |
| f_oxe = xf*sin (d2r_f*f_i1) |
| d_oe = sin (d2r_d*d_i1) |
| d_oxe = xd*sin (d2r_d*d_i1) |
| |
| ! Actual |
| f_oa = sind (f_i1) |
| f_oc = sind (60.0_4) |
| f_ox = xf* sind (f_i1) |
| d_oa = dsind (d_i1) |
| d_oc = dsind (60.0_8) |
| d_ox = xd* sind (d_i1) |
| |
| call cmpf(f_oe, f_oa, f_tol, "( ) sind") |
| call cmpf(f_oe, f_oc, f_tol, "(c) sind") |
| call cmpf(f_oxe, f_ox, f_tol, "(x) sind") |
| call cmpd(d_oe, d_oa, d_tol, "( ) dsind") |
| call cmpd(d_oe, d_oc, d_tol, "(c) dsind") |
| call cmpd(d_oxe, d_ox, d_tol, "(x) sind") |
| |
| ! Input |
| f_i1 = 2.679676_4 |
| f_i2 = 1.0_4 |
| d_i1 = 2.679676_8 |
| d_i2 = 1.0_8 |
| |
| ! Expected |
| f_oe = r2d_f*atan2 (f_i1, f_i2) |
| f_oxe = xf*r2d_f*atan2 (f_i1, f_i2) |
| d_oe = r2d_d*atan2 (d_i1, d_i2) |
| d_oxe = xd*r2d_d*atan2 (d_i1, d_i2) |
| |
| ! Actual |
| f_oa = atan2d (f_i1, f_i2) |
| f_oc = atan2d (2.679676_4, 1.0_4) |
| f_ox = xf* atan2d (f_i1, f_i2) |
| d_oa = datan2d (d_i1, d_i2) |
| d_oc = datan2d (2.679676_8, 1.0_8) |
| d_ox = xd* atan2d (d_i1, d_i2) |
| |
| call cmpf(f_oe, f_oa, f_tol, "( ) atan2d") |
| call cmpf(f_oe, f_oc, f_tol, "(c) atan2d") |
| call cmpf(f_oxe, f_ox, f_tol, "(x) atan2d") |
| call cmpd(d_oe, d_oa, d_tol, "( ) datan2d") |
| call cmpd(d_oe, d_oc, d_tol, "(c) datan2d") |
| call cmpd(d_oxe, d_ox, d_tol, "(x) atan2d") |
| |
| ! Input |
| f_i1 = 1.5874993_4 |
| d_i1 = 1.5874993_8 |
| |
| ! Expected |
| f_oe = r2d_f*atan (f_i1) |
| f_oxe = xf*r2d_f*atan (f_i1) |
| d_oe = r2d_d*atan (d_i1) |
| d_oxe = xd*r2d_d*atan (d_i1) |
| |
| ! Actual |
| f_oa = atand (f_i1) |
| f_oc = atand (1.5874993_4) |
| f_ox = xf* atand (f_i1) |
| d_oa = datand (d_i1) |
| d_oc = datand (1.5874993_8) |
| d_ox = xd* atand (d_i1) |
| |
| call cmpf(f_oe, f_oa, f_tol, "( ) atand") |
| call cmpf(f_oe, f_oc, f_tol, "(c) atand") |
| call cmpf(f_oxe, f_ox, f_tol, "(x) atand") |
| call cmpd(d_oe, d_oa, d_tol, "( ) datand") |
| call cmpd(d_oe, d_oc, d_tol, "(c) datand") |
| call cmpd(d_oxe, d_ox, d_tol, "(x) atand") |
| |
| ! Input |
| f_i1 = 0.6_4 |
| d_i1 = 0.6_8 |
| |
| ! Expected |
| f_oe = cotan (d2r_f*f_i1) |
| f_oxe = xf*cotan (d2r_f*f_i1) |
| d_oe = cotan (d2r_d*d_i1) |
| d_oxe = xd*cotan (d2r_d*d_i1) |
| |
| ! Actual |
| f_oa = cotand (f_i1) |
| f_oc = cotand (0.6_4) |
| f_ox = xf* cotand (f_i1) |
| d_oa = dcotand (d_i1) |
| d_oc = dcotand (0.6_8) |
| d_ox = xd* cotand (d_i1) |
| |
| call cmpf(f_oe, f_oa, f_tol, "( ) cotand") |
| call cmpf(f_oe, f_oc, f_tol, "(c) cotand") |
| call cmpf(f_oxe, f_ox, f_tol, "(x) cotand") |
| call cmpd(d_oe, d_oa, d_tol, "( ) dcotand") |
| call cmpd(d_oe, d_oc, d_tol, "(c) dcotand") |
| call cmpd(d_oxe, d_ox, d_tol, "(x) cotand") |
| |
| ! Input |
| f_i1 = 0.6_4 |
| d_i1 = 0.6_8 |
| |
| ! Expected |
| f_oe = 1.0_4/tan (f_i1) |
| f_oxe = xf* 1.0_4/tan (f_i1) |
| d_oe = 1.0_8/dtan (d_i1) |
| d_oxe = xd*1.0_8/dtan (d_i1) |
| |
| ! Actual |
| f_oa = cotan (f_i1) |
| f_oc = cotan (0.6_4) |
| f_ox = xf* cotan (f_i1) |
| d_oa = dcotan (d_i1) |
| d_oc = dcotan (0.6_8) |
| d_ox = xd* cotan (d_i1) |
| |
| call cmpf(f_oe, f_oa, f_tol, "( ) cotan") |
| call cmpf(f_oe, f_oc, f_tol, "(c) cotan") |
| call cmpf(f_oxe, f_ox, f_tol, "(x) cotan") |
| call cmpd(d_oe, d_oa, d_tol, "( ) dcotan") |
| call cmpd(d_oe, d_oc, d_tol, "(c) dcotan") |
| call cmpd(d_oxe, d_ox, d_tol, "(x) cotan") |
| |
| ! Input |
| f_i1 = 60.0_4 |
| d_i1 = 60.0_8 |
| |
| ! Expected |
| f_oe = tan (d2r_f*f_i1) |
| f_oxe = xf*tan (d2r_f*f_i1) |
| d_oe = tan (d2r_d*d_i1) |
| d_oxe = xd*tan (d2r_d*d_i1) |
| |
| ! Actual |
| f_oa = tand (f_i1) |
| f_oc = tand (60.0_4) |
| f_ox = xf* tand (f_i1) |
| d_oa = dtand (d_i1) |
| d_oc = dtand (60.0_8) |
| d_ox = xd* tand (d_i1) |
| |
| call cmpf(f_oe, f_oa, f_tol, "( ) tand") |
| call cmpf(f_oe, f_oc, f_tol, "(c) tand") |
| call cmpf(f_oxe, f_ox, f_tol, "(x) tand") |
| call cmpd(d_oe, d_oa, d_tol, "( ) dtand") |
| call cmpd(d_oe, d_oc, d_tol, "(c) dtand") |
| call cmpd(d_oxe, d_ox, d_tol, "(x) tand") |
| |
| end |
