mirror of
https://github.com/llvm/llvm-project.git
synced 2025-04-17 03:26:48 +00:00
643 lines
21 KiB
Fortran
643 lines
21 KiB
Fortran
!===-- 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
|
|
|
|
#include '../include/flang/Runtime/magic-numbers.h'
|
|
|
|
module ieee_arithmetic
|
|
! F18 Clause 17.1p1:
|
|
! 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_away => __builtin_ieee_away, &
|
|
ieee_down => __builtin_ieee_down, &
|
|
ieee_fma => __builtin_fma, &
|
|
ieee_int => __builtin_ieee_int, &
|
|
ieee_is_nan => __builtin_ieee_is_nan, &
|
|
ieee_is_negative => __builtin_ieee_is_negative, &
|
|
ieee_is_normal => __builtin_ieee_is_normal, &
|
|
ieee_nearest => __builtin_ieee_nearest, &
|
|
ieee_next_after => __builtin_ieee_next_after, &
|
|
ieee_next_down => __builtin_ieee_next_down, &
|
|
ieee_next_up => __builtin_ieee_next_up, &
|
|
ieee_other => __builtin_ieee_other, &
|
|
ieee_real => __builtin_ieee_real, &
|
|
ieee_round_type => __builtin_ieee_round_type, &
|
|
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_rounding => __builtin_ieee_support_rounding, &
|
|
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, &
|
|
ieee_to_zero => __builtin_ieee_to_zero, &
|
|
ieee_up => __builtin_ieee_up
|
|
|
|
|
|
implicit none
|
|
|
|
! Set PRIVATE by default to explicitly only export what is meant
|
|
! to be exported by this MODULE.
|
|
private
|
|
|
|
! Explicitly export the symbols from __fortran_builtins
|
|
public :: ieee_away
|
|
public :: ieee_down
|
|
public :: ieee_fma
|
|
public :: ieee_int
|
|
public :: ieee_is_nan
|
|
public :: ieee_is_negative
|
|
public :: ieee_is_normal
|
|
public :: ieee_nearest
|
|
public :: ieee_other
|
|
public :: ieee_next_after
|
|
public :: ieee_next_down
|
|
public :: ieee_next_up
|
|
public :: ieee_real
|
|
public :: ieee_round_type
|
|
public :: ieee_scalb
|
|
public :: ieee_selected_real_kind
|
|
public :: ieee_support_datatype
|
|
public :: ieee_support_denormal
|
|
public :: ieee_support_divide
|
|
public :: ieee_support_inf
|
|
public :: ieee_support_io
|
|
public :: ieee_support_nan
|
|
public :: ieee_support_rounding
|
|
public :: ieee_support_sqrt
|
|
public :: ieee_support_standard
|
|
public :: ieee_support_subnormal
|
|
public :: ieee_support_underflow_control
|
|
public :: ieee_to_zero
|
|
public :: ieee_up
|
|
|
|
! Explicitly export the symbols from __fortran_ieee_exceptions
|
|
public :: ieee_flag_type
|
|
public :: ieee_invalid
|
|
public :: ieee_overflow
|
|
public :: ieee_divide_by_zero
|
|
public :: ieee_underflow
|
|
public :: ieee_inexact
|
|
public :: ieee_denorm
|
|
public :: ieee_usual
|
|
public :: ieee_all
|
|
public :: ieee_modes_type
|
|
public :: ieee_status_type
|
|
public :: ieee_get_flag
|
|
public :: ieee_get_halting_mode
|
|
public :: ieee_get_modes
|
|
public :: ieee_get_status
|
|
public :: ieee_set_flag
|
|
public :: ieee_set_halting_mode
|
|
public :: ieee_set_modes
|
|
public :: ieee_set_status
|
|
public :: ieee_support_flag
|
|
public :: ieee_support_halting
|
|
|
|
type, public :: ieee_class_type
|
|
private
|
|
integer(kind=1) :: which = 0
|
|
end type ieee_class_type
|
|
|
|
type(ieee_class_type), parameter, public :: &
|
|
ieee_signaling_nan = ieee_class_type(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN), &
|
|
ieee_quiet_nan = ieee_class_type(_FORTRAN_RUNTIME_IEEE_QUIET_NAN), &
|
|
ieee_negative_inf = ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_INF), &
|
|
ieee_negative_normal = &
|
|
ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL), &
|
|
ieee_negative_subnormal = &
|
|
ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL), &
|
|
ieee_negative_zero = ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO), &
|
|
ieee_positive_zero = ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO), &
|
|
ieee_positive_subnormal = &
|
|
ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL), &
|
|
ieee_positive_normal = &
|
|
ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL), &
|
|
ieee_positive_inf = ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_INF), &
|
|
ieee_other_value = ieee_class_type(_FORTRAN_RUNTIME_IEEE_OTHER_VALUE)
|
|
|
|
type(ieee_class_type), parameter, public :: &
|
|
ieee_negative_denormal = ieee_negative_subnormal, &
|
|
ieee_positive_denormal = ieee_positive_subnormal
|
|
|
|
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(==)
|
|
public :: 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(/=)
|
|
public :: operator(/=)
|
|
|
|
! Define specifics with 1 or 2 INTEGER, LOGICAL, or REAL arguments for
|
|
! generic G.
|
|
!
|
|
! The result type of most function specifics is either a fixed type or
|
|
! the type of the first argument. The result type of a SPECIFICS_rRR
|
|
! function call is the highest precision argument type.
|
|
|
|
#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 FLANG_SUPPORT_R16
|
|
#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
|
|
#else
|
|
#if __x86_64__
|
|
#define SPECIFICS_R(G) \
|
|
G(2) G(3) G(4) G(8) G(10)
|
|
#else
|
|
#define SPECIFICS_R(G) \
|
|
G(2) G(3) G(4) G(8)
|
|
#endif
|
|
#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 FLANG_SUPPORT_R16
|
|
#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
|
|
#else
|
|
#if __x86_64__
|
|
#define SPECIFICS_RI(G) \
|
|
G(2,1) G(2,2) G(2,4) G(2,8) \
|
|
G(3,1) G(3,2) G(3,4) G(3,8) \
|
|
G(4,1) G(4,2) G(4,4) G(4,8) \
|
|
G(8,1) G(8,2) G(8,4) G(8,8) \
|
|
G(10,1) G(10,2) G(10,4) G(10,8)
|
|
#else
|
|
#define SPECIFICS_RI(G) \
|
|
G(2,1) G(2,2) G(2,4) G(2,8) \
|
|
G(3,1) G(3,2) G(3,4) G(3,8) \
|
|
G(4,1) G(4,2) G(4,4) G(4,8) \
|
|
G(8,1) G(8,2) G(8,4) G(8,8)
|
|
#endif
|
|
#endif
|
|
|
|
#if FLANG_SUPPORT_R16
|
|
#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)
|
|
#define SPECIFICS_rRR(G) \
|
|
G(2,2,2) G(2,2,3) G(4,2,4) G(8,2,8) G(10,2,10) G(16,2,16) \
|
|
G(2,3,2) G(3,3,3) G(4,3,4) G(8,3,8) G(10,3,10) G(16,3,16) \
|
|
G(4,4,2) G(4,4,3) G(4,4,4) G(8,4,8) G(10,4,10) G(16,4,16) \
|
|
G(8,8,2) G(8,8,3) G(8,8,4) G(8,8,8) G(10,8,10) G(16,8,16) \
|
|
G(10,10,2) G(10,10,3) G(10,10,4) G(10,10,8) G(10,10,10) G(16,10,16) \
|
|
G(16,16,2) G(16,16,3) G(16,16,4) G(16,16,8) G(16,16,10) G(16,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)
|
|
#define SPECIFICS_rRR(G) \
|
|
G(2,2,2) G(2,2,3) G(4,2,4) G(8,2,8) G(16,2,16) \
|
|
G(2,3,2) G(3,3,3) G(4,3,4) G(8,3,8) G(16,3,16) \
|
|
G(4,4,2) G(4,4,3) G(4,4,4) G(8,4,8) G(16,4,16) \
|
|
G(8,8,2) G(8,8,3) G(8,8,4) G(8,8,8) G(16,8,16) \
|
|
G(16,16,2) G(16,16,3) G(16,16,4) G(16,16,8) G(16,16,16)
|
|
#endif
|
|
#else
|
|
#if __x86_64__
|
|
#define SPECIFICS_RR(G) \
|
|
G(2,2) G(2,3) G(2,4) G(2,8) G(2,10) \
|
|
G(3,2) G(3,3) G(3,4) G(3,8) G(3,10) \
|
|
G(4,2) G(4,3) G(4,4) G(4,8) G(4,10) \
|
|
G(8,2) G(8,3) G(8,4) G(8,8) G(8,10) \
|
|
G(10,2) G(10,3) G(10,4) G(10,8) G(10,10)
|
|
#define SPECIFICS_rRR(G) \
|
|
G(2,2,2) G(2,2,3) G(4,2,4) G(8,2,8) G(10,2,10) \
|
|
G(2,3,2) G(3,3,3) G(4,3,4) G(8,3,8) G(10,3,10) \
|
|
G(4,4,2) G(4,4,3) G(4,4,4) G(8,4,8) G(10,4,10) \
|
|
G(8,8,2) G(8,8,3) G(8,8,4) G(8,8,8) G(10,8,10) \
|
|
G(10,10,2) G(10,10,3) G(10,10,4) G(10,10,8) G(10,10,10)
|
|
#else
|
|
#define SPECIFICS_RR(G) \
|
|
G(2,2) G(2,3) G(2,4) G(2,8) \
|
|
G(3,2) G(3,3) G(3,4) G(3,8) \
|
|
G(4,2) G(4,3) G(4,4) G(4,8) \
|
|
G(8,2) G(8,3) G(8,4) G(8,8)
|
|
#define SPECIFICS_rRR(G) \
|
|
G(2,2,2) G(2,2,3) G(4,2,4) G(8,2,8) \
|
|
G(2,3,2) G(3,3,3) G(4,3,4) G(8,3,8) \
|
|
G(4,4,2) G(4,4,3) G(4,4,4) G(8,4,8) \
|
|
G(8,8,2) G(8,8,3) G(8,8,4) G(8,8,8)
|
|
#endif
|
|
#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
|
|
public :: 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
|
|
public :: 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
|
|
public :: 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
|
|
public :: ieee_get_underflow_mode
|
|
#undef IEEE_GET_UNDERFLOW_MODE_L
|
|
|
|
#define IEEE_IS_FINITE_R(XKIND) \
|
|
elemental logical function ieee_is_finite_a##XKIND(x); \
|
|
real(XKIND), intent(in) :: x; \
|
|
!dir$ ignore_tkr(d) x; \
|
|
end function ieee_is_finite_a##XKIND;
|
|
interface ieee_is_finite
|
|
SPECIFICS_R(IEEE_IS_FINITE_R)
|
|
end interface ieee_is_finite
|
|
public :: 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
|
|
public :: ieee_logb
|
|
#undef IEEE_LOGB_R
|
|
|
|
#define IEEE_MAX_R(XKIND) \
|
|
elemental real(XKIND) function ieee_max_a##XKIND(x, y); \
|
|
real(XKIND), intent(in) :: x, y; \
|
|
end function ieee_max_a##XKIND;
|
|
interface ieee_max
|
|
SPECIFICS_R(IEEE_MAX_R)
|
|
end interface ieee_max
|
|
public :: ieee_max
|
|
#undef IEEE_MAX_R
|
|
|
|
#define IEEE_MAX_MAG_R(XKIND) \
|
|
elemental real(XKIND) function ieee_max_mag_a##XKIND(x, y); \
|
|
real(XKIND), intent(in) :: x, y; \
|
|
end function ieee_max_mag_a##XKIND;
|
|
interface ieee_max_mag
|
|
SPECIFICS_R(IEEE_MAX_MAG_R)
|
|
end interface ieee_max_mag
|
|
public :: ieee_max_mag
|
|
#undef IEEE_MAX_MAG_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
|
|
public :: 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
|
|
public :: ieee_max_num_mag
|
|
#undef IEEE_MAX_NUM_MAG_R
|
|
|
|
#define IEEE_MIN_R(XKIND) \
|
|
elemental real(XKIND) function ieee_min_a##XKIND(x, y); \
|
|
real(XKIND), intent(in) :: x, y; \
|
|
end function ieee_min_a##XKIND;
|
|
interface ieee_min
|
|
SPECIFICS_R(IEEE_MIN_R)
|
|
end interface ieee_min
|
|
public :: ieee_min
|
|
#undef IEEE_MIN_R
|
|
|
|
#define IEEE_MIN_MAG_R(XKIND) \
|
|
elemental real(XKIND) function ieee_min_mag_a##XKIND(x, y); \
|
|
real(XKIND), intent(in) :: x, y; \
|
|
end function ieee_min_mag_a##XKIND;
|
|
interface ieee_min_mag
|
|
SPECIFICS_R(IEEE_MIN_MAG_R)
|
|
end interface ieee_min_mag
|
|
public :: ieee_min_mag
|
|
#undef IEEE_MIN_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
|
|
public :: 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
|
|
public ::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
|
|
public :: 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
|
|
public :: 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
|
|
public :: 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
|
|
public :: 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
|
|
public :: 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
|
|
public :: ieee_quiet_ne
|
|
#undef IEEE_QUIET_NE_R
|
|
|
|
#define IEEE_REM_rRR(RKIND, XKIND, YKIND) \
|
|
elemental real(RKIND) 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_rRR(IEEE_REM_rRR)
|
|
end interface ieee_rem
|
|
public :: ieee_rem
|
|
#undef IEEE_REM_rRR
|
|
|
|
#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
|
|
public :: 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
|
|
public :: 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
|
|
public :: 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
|
|
public :: 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
|
|
public :: 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
|
|
public :: 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
|
|
public :: 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
|
|
public :: 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
|
|
public :: 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
|
|
public :: ieee_signbit
|
|
#undef IEEE_SIGNBIT_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
|
|
public :: 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
|
|
public :: ieee_value
|
|
#undef IEEE_VALUE_R
|
|
|
|
end module ieee_arithmetic
|