! { dg-do run }
! { dg-additional-options "-cpp -std=gnu" }
!
! Test values for degree-valued trigonometric intrinsics.
!
! Run under ieee/ as
!   use ieee_arithmetic
! (used for result checking) is not available on all platforms)

module dec_math_5


  ! Use the highest precision available.
  ! Note however that if both __GFC_REAL_10__ and __GFC_REAL_16__ are defined,
  ! the size of real(16) is actually that of REAL(10) (80 bits) in which case
  ! we should not over-estimate the precision available, or the test will fail.
#if defined(__GFC_REAL_10__)
  integer, parameter :: real_kind = 10
  real(real_kind), parameter :: eps = 5e-11_10

  real(real_kind), parameter :: pi_2 = 1.57079632679489656_10
  real(real_kind), parameter :: pi = 3.14159265358979312_10
  real(real_kind), parameter :: tau = 6.28318530717958623_10

#elif defined(__GFC_REAL_16__)
  integer, parameter :: real_kind = 16
  real(real_kind), parameter :: eps = 5e-16_16

  real(real_kind), parameter :: pi_2 = 1.5707963267948966192313216916397514_16
  real(real_kind), parameter :: pi = 3.1415926535897932384626433832795_16
  real(real_kind), parameter :: tau = 6.28318530717958647692528676655900559_16

#else
  integer, parameter :: real_kind = 8
  real(real_kind), parameter :: eps = 5e-10_8

  real(real_kind), parameter :: pi_2 = 1.57079632679490_8
  real(real_kind), parameter :: pi = 3.14159265358979_8
  real(real_kind), parameter :: tau = 6.28318530717959_8

#endif

  ! Important angles in canonical form.

  integer, parameter :: nangle = 16

  real(real_kind), dimension(nangle), parameter :: degrees = (/ &
      0, & !  180 * 0
     30, & ! 180 * 1/6
     45, & ! 180 * 1/4
     60, & ! 180 * 1/3
     90, & ! 180 * 1/2
    120, & ! 180 * 2/3
    135, & ! 180 * 3/4
    150, & ! 180 * 5/6
    180, & ! 180
    210, & ! 180 * 7/6
    225, & ! 180 * 5/4
    240, & ! 180 * 4/3
    270, & ! 180 * 3/2
    300, & ! 180 * 5/3
    315, & ! 180 * 7/4
    330  & ! 180 * 11/6
  /)

  real(real_kind), dimension(nangle), parameter :: radians = (/ &
#ifdef __GFC_REAL_10__
    0.000000000000000000_10, & ! pi * 0
    0.523598775598298873_10, & ! pi * 1/6
    0.785398163397448310_10, & ! pi * 1/4
    1.047197551196597750_10, & ! pi * 1/3
    1.570796326794896620_10, & ! pi * 1/2
    2.094395102393195490_10, & ! pi * 2/3
    2.356194490192344930_10, & ! pi * 3/4
    2.617993877991494370_10, & ! pi * 5/6
    3.141592653589793240_10, & ! pi
    3.665191429188092110_10, & ! pi * 7/6
    3.926990816987241550_10, & ! pi * 5/4
    4.188790204786390980_10, & ! pi * 4/3
    4.712388980384689860_10, & ! pi * 3/2
    5.235987755982988730_10, & ! pi * 5/3
    5.497787143782138170_10, & ! pi * 7/4
    5.759586531581287600_10  & ! pi * 11/6

#elif defined(__GFC_REAL_16__)
    0.000000000000000000000000000000000_16, & ! pi * 0
    0.523598775598298873077107230546584_16, & ! pi * 1/6
    0.785398163397448309615660845819876_16, & ! pi * 1/4
    1.047197551196597746154214461093170_16, & ! pi * 1/3
    1.570796326794896619231321691639750_16, & ! pi * 1/2
    2.094395102393195492308428922186330_16, & ! pi * 2/3
    2.356194490192344928846982537459630_16, & ! pi * 3/4
    2.617993877991494365385536152732920_16, & ! pi * 5/6
    3.141592653589793238462643383279500_16, & ! pi
    3.665191429188092111539750613826090_16, & ! pi * 7/6
    3.926990816987241548078304229099380_16, & ! pi * 5/4
    4.188790204786390984616857844372670_16, & ! pi * 4/3
    4.712388980384689857693965074919250_16, & ! pi * 3/2
    5.235987755982988730771072305465840_16, & ! pi * 5/3
    5.497787143782138167309625920739130_16, & ! pi * 7/4
    5.759586531581287603848179536012420_16  & ! pi * 11/6

#else
    0.000000000000000_8, & ! pi * 0
    0.523598775598299_8, & ! pi * 1/6
    0.785398163397448_8, & ! pi * 1/4
    1.047197551196600_8, & ! pi * 1/3
    1.570796326794900_8, & ! pi * 1/2
    2.094395102393200_8, & ! pi * 2/3
    2.356194490192340_8, & ! pi * 3/4
    2.617993877991490_8, & ! pi * 5/6
    3.141592653589790_8, & ! pi
    3.665191429188090_8, & ! pi * 7/6
    3.926990816987240_8, & ! pi * 5/4
    4.188790204786390_8, & ! pi * 4/3
    4.712388980384690_8, & ! pi * 3/2
    5.235987755982990_8, & ! pi * 5/3
    5.497787143782140_8, & ! pi * 7/4
    5.759586531581290_8  & ! pi * 11/6
#endif
  /)

  ! sind, cosd, tand, cotand

  ! Ensure precision degrades minimally for large values.
  integer, parameter :: nphase = 5

  integer, dimension(nphase), parameter :: phases = (/ &
    0, 1, 5, 100, 10000  &
  /)

contains

  subroutine compare(strl, xl_in, xl_out, strr, xr_in, xr_out, eps)
    use ieee_arithmetic
    implicit none
    character(*), intent(in) :: strl, strr
    real(real_kind), intent(in) :: xl_in, xl_out, xr_in, xr_out, eps

    if ((ieee_is_nan(xl_out) .neqv. ieee_is_nan(xr_out)) &
        .or. (ieee_is_finite(xl_out) .neqv. ieee_is_finite(xr_out)) &
        .or. (abs(xl_out - xr_out) .gt. eps)) then
      write (*, 100) strl, "(", xl_in, "): ", xl_out
      write (*, 100) strr, "(", xr_in, "): ", xr_out

      if ((ieee_is_nan(xl_out) .eqv. ieee_is_nan(xr_out)) &
          .and. ieee_is_finite(xl_out) .and. ieee_is_finite(xr_out)) then
        write (*, 300) "|xl - xr| = ", abs(xl_out - xr_out)
        write (*, 300) "    > eps = ", eps
      endif

      call abort()
    endif

#ifdef __GFC_REAL_16__
    100  format((A8,A,F34.30,A,F34.30,F34.30))
    200  format((A12,F34.30))
    !500  format((A8,A,G34.29,A,G34.29,G34.29))
#elif defined(__GFC_REAL_10__)
    100  format((A8,A,F21.17,A,F21.17,F21.17))
    200  format((A12,F21.17))
    !500  format((A8,A,G21.16,A,G21.16,G21.16))
#else
    100  format((A8,A,F18.14,A,F18.14,F18.14))
    200  format((A12,F18.14))
    !500  format((A8,A,G18.13,A,G18.13,G18.13))
#endif
    300  format((A12,G8.2))
  endsubroutine

endmodule

use dec_math_5
use ieee_arithmetic
implicit none

integer :: phase_index, angle_index, phase
real(real_kind) :: deg_in, deg_out, deg_out2, rad_in, rad_out

! Try every value in degrees, and make sure they are correct compared to the
! corresponding radian function.

do phase_index = 1, size(phases)
  phase = phases(phase_index)

  do angle_index = 1, size(degrees)
    ! eqv to degrees(angle_index) modulo 360
    deg_in = degrees(angle_index) + phase * 360
    rad_in = radians(angle_index) + phase * tau

    ! sind vs. sin
    deg_out = sind(deg_in)
    rad_out = sin(rad_in)
    call compare("sind", deg_in, deg_out, "sin", rad_in, rad_out, eps)

    ! cosd vs. cos
    deg_out = cosd(deg_in)
    rad_out = cos(rad_in)
    call compare("cosd", deg_in, deg_out, "cos", rad_in, rad_out, eps)

    ! tand vs. tan
    deg_out = tand(deg_in)
    rad_out = tan(rad_in)
    if ( ieee_is_finite(deg_out) ) then
      call compare("tand", deg_in, deg_out, "tan", rad_in, rad_out, eps)
    endif

    ! cotand vs. cotan
    deg_out = cotand(deg_in)
    rad_out = cotan(rad_in)

    ! Skip comparing infinity, because cotan does not return infinity
    if ( ieee_is_finite(deg_out) ) then
      call compare("cotand", deg_in, deg_out, "cotan", rad_in, rad_out, eps)

      ! cotand vs. tand
      deg_out = cotand(deg_in)
      deg_out2 = -tand(deg_in + 90)

      call compare("cotand", deg_in, deg_out, "-tand+90", deg_in, deg_out2, eps)
      deg_out2 = 1 / tand(deg_in)
      call compare("cotand", deg_in, deg_out, "1/tand", deg_in, deg_out2, eps)
    endif

  enddo


enddo


end