module/ieee_arithmetic.f90

!===-- module/ieee_arithmetic.f90 ------------------------------------------===!
!
! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
! See https://llvm.org/LICENSE.txt for license information.
! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
!
!===------------------------------------------------------------------------===!

! Fortran 2018 Clause 17

module ieee_arithmetic
  ! 17.1: "The module IEEE_ARITHMETIC behaves as if it contained a
  ! USE statement for IEEE_EXCEPTIONS; everything that is public in
  ! IEEE_EXCEPTIONS is public in IEEE_ARITHMETIC."
  use __Fortran_ieee_exceptions

  use __Fortran_builtins, only: &
    ieee_fma => __builtin_fma, &
    ieee_is_nan => __builtin_ieee_is_nan, &
    ieee_is_negative => __builtin_ieee_is_negative, &
    ieee_is_normal => __builtin_ieee_is_normal, &
    ieee_next_after => __builtin_ieee_next_after, &
    ieee_next_down => __builtin_ieee_next_down, &
    ieee_next_up => __builtin_ieee_next_up, &
    ieee_scalb => scale, &
    ieee_selected_real_kind => __builtin_ieee_selected_real_kind, &
    ieee_support_datatype => __builtin_ieee_support_datatype, &
    ieee_support_denormal => __builtin_ieee_support_denormal, &
    ieee_support_divide => __builtin_ieee_support_divide, &
    ieee_support_inf => __builtin_ieee_support_inf, &
    ieee_support_io => __builtin_ieee_support_io, &
    ieee_support_nan => __builtin_ieee_support_nan, &
    ieee_support_sqrt => __builtin_ieee_support_sqrt, &
    ieee_support_standard => __builtin_ieee_support_standard, &
    ieee_support_subnormal => __builtin_ieee_support_subnormal, &
    ieee_support_underflow_control => __builtin_ieee_support_underflow_control

  implicit none

  type :: ieee_class_type
    private
    integer(kind=1) :: which = 0
  end type ieee_class_type

  type(ieee_class_type), parameter :: &
    ieee_signaling_nan = ieee_class_type(1), &
    ieee_quiet_nan = ieee_class_type(2), &
    ieee_negative_inf = ieee_class_type(3), &
    ieee_negative_normal = ieee_class_type(4), &
    ieee_negative_denormal = ieee_class_type(5), &
    ieee_negative_zero = ieee_class_type(6), &
    ieee_positive_zero = ieee_class_type(7), &
    ieee_positive_subnormal = ieee_class_type(8), &
    ieee_positive_normal = ieee_class_type(9), &
    ieee_positive_inf = ieee_class_type(10), &
    ieee_other_value = ieee_class_type(11)

  type(ieee_class_type), parameter :: &
    ieee_negative_subnormal = ieee_negative_denormal, &
    ieee_positive_denormal = ieee_negative_subnormal

  type :: ieee_round_type
    private
    integer(kind=1) :: mode = 0
  end type ieee_round_type

  type(ieee_round_type), parameter :: &
    ieee_nearest = ieee_round_type(1), &
    ieee_to_zero = ieee_round_type(2), &
    ieee_up = ieee_round_type(3), &
    ieee_down = ieee_round_type(4), &
    ieee_away = ieee_round_type(5), &
    ieee_other = ieee_round_type(6)

  interface operator(==)
    elemental logical function ieee_class_eq(x, y)
      import ieee_class_type
      type(ieee_class_type), intent(in) :: x, y
    end function ieee_class_eq
    elemental logical function ieee_round_eq(x, y)
      import ieee_round_type
      type(ieee_round_type), intent(in) :: x, y
    end function ieee_round_eq
  end interface operator(==)
  interface operator(/=)
    elemental logical function ieee_class_ne(x, y)
      import ieee_class_type
      type(ieee_class_type), intent(in) :: x, y
    end function ieee_class_ne
    elemental logical function ieee_round_ne(x, y)
      import ieee_round_type
      type(ieee_round_type), intent(in) :: x, y
    end function ieee_round_ne
  end interface operator(/=)
  private :: ieee_class_eq, ieee_round_eq, ieee_class_ne, ieee_round_ne

! Define specifics with 1 or 2 INTEGER, LOGICAL, or REAL arguments for
! generic G.
#define SPECIFICS_I(G) \
  G(1) G(2) G(4) G(8) G(16)
#define SPECIFICS_L(G) \
  G(1) G(2) G(4) G(8)
#if __x86_64__
#define SPECIFICS_R(G) \
  G(2) G(3) G(4) G(8) G(10) G(16)
#else
#define SPECIFICS_R(G) \
  G(2) G(3) G(4) G(8) G(16)
#endif
#define SPECIFICS_II(G) \
  G(1,1) G(1,2) G(1,4) G(1,8) G(1,16) \
  G(2,1) G(2,2) G(2,4) G(2,8) G(2,16) \
  G(4,1) G(4,2) G(4,4) G(4,8) G(4,16) \
  G(8,1) G(8,2) G(8,4) G(8,8) G(8,16) \
  G(16,1) G(16,2) G(16,4) G(16,8) G(16,16)
#if __x86_64__
#define SPECIFICS_RI(G) \
  G(2,1) G(2,2) G(2,4) G(2,8) G(2,16) \
  G(3,1) G(3,2) G(3,4) G(3,8) G(3,16) \
  G(4,1) G(4,2) G(4,4) G(4,8) G(4,16) \
  G(8,1) G(8,2) G(8,4) G(8,8) G(8,16) \
  G(10,1) G(10,2) G(10,4) G(10,8) G(10,16) \
  G(16,1) G(16,2) G(16,4) G(16,8) G(16,16)
#else
#define SPECIFICS_RI(G) \
  G(2,1) G(2,2) G(2,4) G(2,8) G(2,16) \
  G(3,1) G(3,2) G(3,4) G(3,8) G(3,16) \
  G(4,1) G(4,2) G(4,4) G(4,8) G(4,16) \
  G(8,1) G(8,2) G(8,4) G(8,8) G(8,16) \
  G(16,1) G(16,2) G(16,4) G(16,8) G(16,16)
#endif

#if __x86_64__
#define SPECIFICS_RR(G) \
  G(2,2) G(2,3) G(2,4) G(2,8) G(2,10) G(2,16) \
  G(3,2) G(3,3) G(3,4) G(3,8) G(3,10) G(3,16) \
  G(4,2) G(4,3) G(4,4) G(4,8) G(4,10) G(4,16) \
  G(8,2) G(8,3) G(8,4) G(8,8) G(8,10) G(8,16) \
  G(10,2) G(10,3) G(10,4) G(10,8) G(10,10) G(10,16) \
  G(16,2) G(16,3) G(16,4) G(16,8) G(16,10) G(16,16)
#else
#define SPECIFICS_RR(G) \
  G(2,2) G(2,3) G(2,4) G(2,8) G(2,16) \
  G(3,2) G(3,3) G(3,4) G(3,8) G(3,16) \
  G(4,2) G(4,3) G(4,4) G(4,8) G(4,16) \
  G(8,2) G(8,3) G(8,4) G(8,8) G(8,16) \
  G(16,2) G(16,3) G(16,4) G(16,8) G(16,16)
#endif

! Set PRIVATE accessibility for specifics with 1 or 2 INTEGER, LOGICAL, or REAL
! arguments for generic G.
#define PRIVATE_I(G) private :: \
  G##_i1, G##_i2, G##_i4, G##_i8, G##_i16
#define PRIVATE_L(G) private :: \
  G##_l1, G##_l2, G##_l4, G##_l8
#if __x86_64__
#define PRIVATE_R(G) private :: \
  G##_a2, G##_a3, G##_a4, G##_a8, G##_a10, G##_a16
#else
#define PRIVATE_R(G) private :: \
  G##_a2, G##_a3, G##_a4, G##_a8, G##_a16
#endif
#define PRIVATE_II(G) private :: \
  G##_i1_i1, G##_i1_i2, G##_i1_i4, G##_i1_i8, G##_i1_i16, \
  G##_i2_i1, G##_i2_i2, G##_i2_i4, G##_i2_i8, G##_i2_i16, \
  G##_i4_i1, G##_i4_i2, G##_i4_i4, G##_i4_i8, G##_i4_i16, \
  G##_i8_i1, G##_i8_i2, G##_i8_i4, G##_i8_i8, G##_i8_i16, \
  G##_i16_i1, G##_i16_i2, G##_i16_i4, G##_i16_i8, G##_i16_i16
#if __x86_64__
#define PRIVATE_RI(G) private :: \
  G##_a2_i1, G##_a2_i2, G##_a2_i4, G##_a2_i8, G##_a2_i16, \
  G##_a3_i1, G##_a3_i2, G##_a3_i4, G##_a3_i8, G##_a3_i16, \
  G##_a4_i1, G##_a4_i2, G##_a4_i4, G##_a4_i8, G##_a4_i16, \
  G##_a8_i1, G##_a8_i2, G##_a8_i4, G##_a8_i8, G##_a8_i16, \
  G##_a10_i1, G##_a10_i2, G##_a10_i4, G##_a10_i8, G##_a10_i16, \
  G##_a16_i1, G##_a16_i2, G##_a16_i4, G##_a16_i8, G##_a16_i16
#else
#define PRIVATE_RI(G) private :: \
  G##_a2_i1, G##_a2_i2, G##_a2_i4, G##_a2_i8, G##_a2_i16, \
  G##_a3_i1, G##_a3_i2, G##_a3_i4, G##_a3_i8, G##_a3_i16, \
  G##_a4_i1, G##_a4_i2, G##_a4_i4, G##_a4_i8, G##_a4_i16, \
  G##_a8_i1, G##_a8_i2, G##_a8_i4, G##_a8_i8, G##_a8_i16, \
  G##_a16_i1, G##_a16_i2, G##_a16_i4, G##_a16_i8, G##_a16_i16
#endif
#if __x86_64__
#define PRIVATE_RR(G) private :: \
  G##_a2_a2, G##_a2_a3, G##_a2_a4, G##_a2_a8, G##_a2_a10, G##_a2_a16, \
  G##_a3_a2, G##_a3_a3, G##_a3_a4, G##_a3_a8, G##_a3_a10, G##_a3_a16, \
  G##_a4_a2, G##_a4_a3, G##_a4_a4, G##_a4_a8, G##_a4_a10, G##_a4_a16, \
  G##_a8_a2, G##_a8_a3, G##_a8_a4, G##_a8_a8, G##_a8_a10, G##_a8_a16, \
  G##_a10_a2, G##_a10_a3, G##_a10_a4, G##_a10_a8, G##_a10_a10, G##_a10_a16, \
  G##_a16_a2, G##_a16_a3, G##_a16_a4, G##_a16_a8, G##_a16_a10, G##_a16_a16
#else
#define PRIVATE_RR(G) private :: \
  G##_a2_a2, G##_a2_a3, G##_a2_a4, G##_a2_a8, G##_a2_a16, \
  G##_a3_a2, G##_a3_a3, G##_a3_a4, G##_a3_a8, G##_a3_a16, \
  G##_a4_a2, G##_a4_a3, G##_a4_a4, G##_a4_a8, G##_a4_a16, \
  G##_a8_a2, G##_a8_a3, G##_a8_a4, G##_a8_a8, G##_a8_a16, \
  G##_a16_a2, G##_a16_a3, G##_a16_a4, G##_a16_a8, G##_a16_a16
#endif

#define IEEE_CLASS_R(XKIND) \
  elemental type(ieee_class_type) function ieee_class_a##XKIND(x); \
    import ieee_class_type; \
    real(XKIND), intent(in) :: x; \
  end function ieee_class_a##XKIND;
  interface ieee_class
    SPECIFICS_R(IEEE_CLASS_R)
  end interface ieee_class
  PRIVATE_R(IEEE_CLASS)
#undef IEEE_CLASS_R

#define IEEE_COPY_SIGN_RR(XKIND, YKIND) \
  elemental real(XKIND) function ieee_copy_sign_a##XKIND##_a##YKIND(x, y); \
    real(XKIND), intent(in) :: x; \
    real(YKIND), intent(in) :: y; \
  end function ieee_copy_sign_a##XKIND##_a##YKIND;
  interface ieee_copy_sign
    SPECIFICS_RR(IEEE_COPY_SIGN_RR)
  end interface ieee_copy_sign
  PRIVATE_RR(IEEE_COPY_SIGN)
#undef IEEE_COPY_SIGN_RR

#define IEEE_GET_ROUNDING_MODE_I(RKIND) \
  subroutine ieee_get_rounding_mode_i##RKIND(round_value, radix); \
    import ieee_round_type; \
    type(ieee_round_type), intent(out) :: round_value; \
    integer(RKIND), intent(in) :: radix; \
  end subroutine ieee_get_rounding_mode_i##RKIND;
  interface ieee_get_rounding_mode
    subroutine ieee_get_rounding_mode_0(round_value)
      import ieee_round_type
      type(ieee_round_type), intent(out) :: round_value
    end subroutine ieee_get_rounding_mode_0
    SPECIFICS_I(IEEE_GET_ROUNDING_MODE_I)
  end interface ieee_get_rounding_mode
  PRIVATE_I(IEEE_GET_ROUNDING_MODE)
#undef IEEE_GET_ROUNDING_MODE_I

#define IEEE_GET_UNDERFLOW_MODE_L(GKIND) \
  subroutine ieee_get_underflow_mode_l##GKIND(gradual); \
    logical(GKIND), intent(out) :: gradual; \
  end subroutine ieee_get_underflow_mode_l##GKIND;
  interface ieee_get_underflow_mode
    SPECIFICS_L(IEEE_GET_UNDERFLOW_MODE_L)
  end interface ieee_get_underflow_mode
  PRIVATE_L(IEEE_GET_UNDERFLOW_MODE)
#undef IEEE_GET_UNDERFLOW_MODE_L

! When kind argument is present, kind(result) is value(kind), not kind(kind).
! That is not known here, so return integer(16).
#define IEEE_INT_R(AKIND) \
  elemental integer function ieee_int_a##AKIND(a, round); \
    import ieee_round_type; \
    real(AKIND), intent(in) :: a; \
    type(ieee_round_type), intent(in) :: round; \
  end function ieee_int_a##AKIND;
#define IEEE_INT_RI(AKIND, KKIND) \
  elemental integer(16) function ieee_int_a##AKIND##_i##KKIND(a, round, kind); \
    import ieee_round_type; \
    real(AKIND), intent(in) :: a; \
    type(ieee_round_type), intent(in) :: round; \
    integer(KKIND), intent(in) :: kind; \
  end function ieee_int_a##AKIND##_i##KKIND;
  interface ieee_int
    SPECIFICS_R(IEEE_INT_R)
    SPECIFICS_RI(IEEE_INT_RI)
  end interface ieee_int
  PRIVATE_R(IEEE_INT)
  PRIVATE_RI(IEEE_INT)
#undef IEEE_INT_R
#undef IEEE_INT_RI

#define IEEE_IS_FINITE_R(XKIND) \
  elemental logical function ieee_is_finite_a##XKIND(x); \
    real(XKIND), intent(in) :: x; \
  end function ieee_is_finite_a##XKIND;
  interface ieee_is_finite
    SPECIFICS_R(IEEE_IS_FINITE_R)
  end interface ieee_is_finite
  PRIVATE_R(IEEE_IS_FINITE)
#undef IEEE_IS_FINITE_R

#define IEEE_LOGB_R(XKIND) \
  elemental real(XKIND) function ieee_logb_a##XKIND(x); \
    real(XKIND), intent(in) :: x; \
  end function ieee_logb_a##XKIND;
  interface ieee_logb
    SPECIFICS_R(IEEE_LOGB_R)
  end interface ieee_logb
  PRIVATE_R(IEEE_LOGB)
#undef IEEE_LOGB_R

#define IEEE_MAX_NUM_R(XKIND) \
  elemental real(XKIND) function ieee_max_num_a##XKIND(x, y); \
    real(XKIND), intent(in) :: x, y; \
  end function ieee_max_num_a##XKIND;
  interface ieee_max_num
    SPECIFICS_R(IEEE_MAX_NUM_R)
  end interface ieee_max_num
  PRIVATE_R(IEEE_MAX_NUM)
#undef IEEE_MAX_NUM_R

#define IEEE_MAX_NUM_MAG_R(XKIND) \
  elemental real(XKIND) function ieee_max_num_mag_a##XKIND(x, y); \
    real(XKIND), intent(in) :: x, y; \
  end function ieee_max_num_mag_a##XKIND;
  interface ieee_max_num_mag
    SPECIFICS_R(IEEE_MAX_NUM_MAG_R)
  end interface ieee_max_num_mag
  PRIVATE_R(IEEE_MAX_NUM_MAG)
#undef IEEE_MAX_NUM_MAG_R

#define IEEE_MIN_NUM_R(XKIND) \
  elemental real(XKIND) function ieee_min_num_a##XKIND(x, y); \
    real(XKIND), intent(in) :: x, y; \
  end function ieee_min_num_a##XKIND;
  interface ieee_min_num
    SPECIFICS_R(IEEE_MIN_NUM_R)
  end interface ieee_min_num
  PRIVATE_R(IEEE_MIN_NUM)
#undef IEEE_MIN_NUM_R

#define IEEE_MIN_NUM_MAG_R(XKIND) \
  elemental real(XKIND) function ieee_min_num_mag_a##XKIND(x, y); \
    real(XKIND), intent(in) :: x, y; \
  end function ieee_min_num_mag_a##XKIND;
  interface ieee_min_num_mag
    SPECIFICS_R(IEEE_MIN_NUM_MAG_R)
  end interface ieee_min_num_mag
  PRIVATE_R(IEEE_MIN_NUM_MAG)
#undef IEEE_MIN_NUM_MAG_R

#define IEEE_QUIET_EQ_R(AKIND) \
  elemental logical function ieee_quiet_eq_a##AKIND(a, b); \
    real(AKIND), intent(in) :: a, b; \
  end function ieee_quiet_eq_a##AKIND;
  interface ieee_quiet_eq
    SPECIFICS_R(IEEE_QUIET_EQ_R)
  end interface ieee_quiet_eq
  PRIVATE_R(IEEE_QUIET_EQ)
#undef IEEE_QUIET_EQ_R

#define IEEE_QUIET_GE_R(AKIND) \
  elemental logical function ieee_quiet_ge_a##AKIND(a, b); \
    real(AKIND), intent(in) :: a, b; \
  end function ieee_quiet_ge_a##AKIND;
  interface ieee_quiet_ge
    SPECIFICS_R(IEEE_QUIET_GE_R)
  end interface ieee_quiet_ge
  PRIVATE_R(IEEE_QUIET_GE)
#undef IEEE_QUIET_GE_R

#define IEEE_QUIET_GT_R(AKIND) \
  elemental logical function ieee_quiet_gt_a##AKIND(a, b); \
    real(AKIND), intent(in) :: a, b; \
  end function ieee_quiet_gt_a##AKIND;
  interface ieee_quiet_gt
    SPECIFICS_R(IEEE_QUIET_GT_R)
  end interface ieee_quiet_gt
  PRIVATE_R(IEEE_QUIET_GT)
#undef IEEE_QUIET_GT_R

#define IEEE_QUIET_LE_R(AKIND) \
  elemental logical function ieee_quiet_le_a##AKIND(a, b); \
    real(AKIND), intent(in) :: a, b; \
  end function ieee_quiet_le_a##AKIND;
  interface ieee_quiet_le
    SPECIFICS_R(IEEE_QUIET_LE_R)
  end interface ieee_quiet_le
  PRIVATE_R(IEEE_QUIET_LE)
#undef IEEE_QUIET_LE_R

#define IEEE_QUIET_LT_R(AKIND) \
  elemental logical function ieee_quiet_lt_a##AKIND(a, b); \
    real(AKIND), intent(in) :: a, b; \
  end function ieee_quiet_lt_a##AKIND;
  interface ieee_quiet_lt
    SPECIFICS_R(IEEE_QUIET_LT_R)
  end interface ieee_quiet_lt
  PRIVATE_R(IEEE_QUIET_LT)
#undef IEEE_QUIET_LT_R

#define IEEE_QUIET_NE_R(AKIND) \
  elemental logical function ieee_quiet_ne_a##AKIND(a, b); \
    real(AKIND), intent(in) :: a, b; \
  end function ieee_quiet_ne_a##AKIND;
  interface ieee_quiet_ne
    SPECIFICS_R(IEEE_QUIET_NE_R)
  end interface ieee_quiet_ne
  PRIVATE_R(IEEE_QUIET_NE)
#undef IEEE_QUIET_NE_R

! When kind argument is present, kind(result) is value(kind), not kind(kind).
! That is not known here, so return real(16).
#define IEEE_REAL_I(AKIND) \
  elemental real function ieee_real_i##AKIND(a); \
    integer(AKIND), intent(in) :: a; \
  end function ieee_real_i##AKIND;
#define IEEE_REAL_R(AKIND) \
  elemental real function ieee_real_a##AKIND(a); \
    real(AKIND), intent(in) :: a; \
  end function ieee_real_a##AKIND;
#define IEEE_REAL_II(AKIND, KKIND) \
  elemental real(16) function ieee_real_i##AKIND##_i##KKIND(a, kind); \
    integer(AKIND), intent(in) :: a; \
    integer(KKIND), intent(in) :: kind; \
  end function ieee_real_i##AKIND##_i##KKIND;
#define IEEE_REAL_RI(AKIND, KKIND) \
  elemental real(16) function ieee_real_a##AKIND##_i##KKIND(a, kind); \
    real(AKIND), intent(in) :: a; \
    integer(KKIND), intent(in) :: kind; \
  end function ieee_real_a##AKIND##_i##KKIND;
  interface ieee_real
    SPECIFICS_I(IEEE_REAL_I)
    SPECIFICS_R(IEEE_REAL_R)
    SPECIFICS_II(IEEE_REAL_II)
    SPECIFICS_RI(IEEE_REAL_RI)
  end interface ieee_real
  PRIVATE_I(IEEE_REAL)
  PRIVATE_R(IEEE_REAL)
  PRIVATE_II(IEEE_REAL)
  PRIVATE_RI(IEEE_REAL)
#undef IEEE_REAL_I
#undef IEEE_REAL_R
#undef IEEE_REAL_II
#undef IEEE_REAL_RI

#define IEEE_REM_RR(XKIND, YKIND) \
  elemental real(XKIND) function ieee_rem_a##XKIND##_a##YKIND(x, y); \
    real(XKIND), intent(in) :: x; \
    real(YKIND), intent(in) :: y; \
  end function ieee_rem_a##XKIND##_a##YKIND;
  interface ieee_rem
    SPECIFICS_RR(IEEE_REM_RR)
  end interface ieee_rem
  PRIVATE_RR(IEEE_REM)
#undef IEEE_REM_RR

#define IEEE_RINT_R(XKIND) \
  elemental real(XKIND) function ieee_rint_a##XKIND(x, round); \
    import ieee_round_type; \
    real(XKIND), intent(in) :: x; \
    type(ieee_round_type), optional, intent(in) :: round; \
  end function ieee_rint_a##XKIND;
  interface ieee_rint
    SPECIFICS_R(IEEE_RINT_R)
  end interface ieee_rint
  PRIVATE_R(IEEE_RINT)
#undef IEEE_RINT_R

#define IEEE_SET_ROUNDING_MODE_I(RKIND) \
  subroutine ieee_set_rounding_mode_i##RKIND(round_value, radix); \
    import ieee_round_type; \
    type(ieee_round_type), intent(in) :: round_value; \
    integer(RKIND), intent(in) :: radix; \
  end subroutine ieee_set_rounding_mode_i##RKIND;
  interface ieee_set_rounding_mode
    subroutine ieee_set_rounding_mode_0(round_value)
      import ieee_round_type
      type(ieee_round_type), intent(in) :: round_value
    end subroutine ieee_set_rounding_mode_0
    SPECIFICS_I(IEEE_SET_ROUNDING_MODE_I)
  end interface ieee_set_rounding_mode
  PRIVATE_I(IEEE_SET_ROUNDING_MODE)
#undef IEEE_SET_ROUNDING_MODE_I

#define IEEE_SET_UNDERFLOW_MODE_L(GKIND) \
  subroutine ieee_set_underflow_mode_l##GKIND(gradual); \
    logical(GKIND), intent(in) :: gradual; \
  end subroutine ieee_set_underflow_mode_l##GKIND;
  interface ieee_set_underflow_mode
    SPECIFICS_L(IEEE_SET_UNDERFLOW_MODE_L)
  end interface ieee_set_underflow_mode
  PRIVATE_L(IEEE_SET_UNDERFLOW_MODE)
#undef IEEE_SET_UNDERFLOW_MODE_L

#define IEEE_SIGNALING_EQ_R(AKIND) \
  elemental logical function ieee_signaling_eq_a##AKIND(a, b); \
    real(AKIND), intent(in) :: a, b; \
  end function ieee_signaling_eq_a##AKIND;
  interface ieee_signaling_eq
    SPECIFICS_R(IEEE_SIGNALING_EQ_R)
  end interface ieee_signaling_eq
  PRIVATE_R(IEEE_SIGNALING_EQ)
#undef IEEE_SIGNALING_EQ_R

#define IEEE_SIGNALING_GE_R(AKIND) \
  elemental logical function ieee_signaling_ge_a##AKIND(a, b); \
    real(AKIND), intent(in) :: a, b; \
  end function ieee_signaling_ge_a##AKIND;
  interface ieee_signaling_ge
    SPECIFICS_R(IEEE_SIGNALING_GE_R)
  end interface ieee_signaling_ge
  PRIVATE_R(IEEE_SIGNALING_GE)
#undef IEEE_SIGNALING_GE_R

#define IEEE_SIGNALING_GT_R(AKIND) \
  elemental logical function ieee_signaling_gt_a##AKIND(a, b); \
    real(AKIND), intent(in) :: a, b; \
  end function ieee_signaling_gt_a##AKIND;
  interface ieee_signaling_gt
    SPECIFICS_R(IEEE_SIGNALING_GT_R)
  end interface ieee_signaling_gt
  PRIVATE_R(IEEE_SIGNALING_GT)
#undef IEEE_SIGNALING_GT_R

#define IEEE_SIGNALING_LE_R(AKIND) \
  elemental logical function ieee_signaling_le_a##AKIND(a, b); \
    real(AKIND), intent(in) :: a, b; \
  end function ieee_signaling_le_a##AKIND;
  interface ieee_signaling_le
    SPECIFICS_R(IEEE_SIGNALING_LE_R)
  end interface ieee_signaling_le
  PRIVATE_R(IEEE_SIGNALING_LE)
#undef IEEE_SIGNALING_LE_R

#define IEEE_SIGNALING_LT_R(AKIND) \
  elemental logical function ieee_signaling_lt_a##AKIND(a, b); \
    real(AKIND), intent(in) :: a, b; \
  end function ieee_signaling_lt_a##AKIND;
  interface ieee_signaling_lt
    SPECIFICS_R(IEEE_SIGNALING_LT_R)
  end interface ieee_signaling_lt
  PRIVATE_R(IEEE_SIGNALING_LT)
#undef IEEE_SIGNALING_LT_R

#define IEEE_SIGNALING_NE_R(AKIND) \
  elemental logical function ieee_signaling_ne_a##AKIND(a, b); \
    real(AKIND), intent(in) :: a, b; \
  end function ieee_signaling_ne_a##AKIND;
  interface ieee_signaling_ne
    SPECIFICS_R(IEEE_SIGNALING_NE_R)
  end interface ieee_signaling_ne
  PRIVATE_R(IEEE_SIGNALING_NE)
#undef IEEE_SIGNALING_NE_R

#define IEEE_SIGNBIT_R(XKIND) \
  elemental logical function ieee_signbit_a##XKIND(x); \
    real(XKIND), intent(in) :: x; \
  end function ieee_signbit_a##XKIND;
  interface ieee_signbit
    SPECIFICS_R(IEEE_SIGNBIT_R)
  end interface ieee_signbit
  PRIVATE_R(IEEE_SIGNBIT)
#undef IEEE_SIGNBIT_R

#define IEEE_SUPPORT_ROUNDING_R(XKIND) \
  pure logical function ieee_support_rounding_a##XKIND(round_value, x); \
    import ieee_round_type; \
    type(ieee_round_type), intent(in) :: round_value; \
    real(XKIND), intent(in) :: x(..); \
  end function ieee_support_rounding_a##XKIND;
  interface ieee_support_rounding
    pure logical function ieee_support_rounding_0(round_value)
      import ieee_round_type
      type(ieee_round_type), intent(in) :: round_value
    end function ieee_support_rounding_0
    SPECIFICS_R(IEEE_SUPPORT_ROUNDING_R)
  end interface ieee_support_rounding
  PRIVATE_R(IEEE_SUPPORT_ROUNDING)
#undef IEEE_SUPPORT_ROUNDING_R

#define IEEE_UNORDERED_RR(XKIND, YKIND) \
 elemental logical function ieee_unordered_a##XKIND##_a##YKIND(x, y); \
    real(XKIND), intent(in) :: x; \
    real(YKIND), intent(in) :: y; \
  end function ieee_unordered_a##XKIND##_a##YKIND;
  interface ieee_unordered
    SPECIFICS_RR(IEEE_UNORDERED_RR)
  end interface ieee_unordered
  PRIVATE_RR(IEEE_UNORDERED)
#undef IEEE_UNORDERED_RR

#define IEEE_VALUE_R(XKIND) \
  elemental real(XKIND) function ieee_value_a##XKIND(x, class); \
    import ieee_class_type; \
    real(XKIND), intent(in) :: x; \
    type(ieee_class_type), intent(in) :: class; \
  end function ieee_value_a##XKIND;
  interface ieee_value
    SPECIFICS_R(IEEE_VALUE_R)
  end interface ieee_value
  PRIVATE_R(IEEE_VALUE)
#undef IEEE_VALUE_R

end module ieee_arithmetic