fc1c481cf4
…INCLUDE lines The compiler current treats an INCLUDE line as essentially a synonym for a preprocessing #include directive. The causes macros that have been defined at the point where the INCLUDE line is processed to be replaced within the text of the included file. This behavior is surprising to users who expect an INCLUDE line to be expanded into its contents *after* preprocessing has been applied to the original source file, with no further macro expansion. Change INCLUDE line processing to use a fresh instance of Preprocessor containing no macro definitions except _CUDA in CUDA Fortran compilations and, if the original file was being preprocessed, the standard definitions of __FILE__, __LINE__, and so forth.
666 lines
22 KiB
Fortran
666 lines
22 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_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_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_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_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.
|
|
#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)
|
|
#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
|
|
#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)
|
|
#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)
|
|
#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
|
|
|
|
! 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
|
|
public :: 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
|
|
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
|
|
|
|
! 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)
|
|
#if FLANG_SUPPORT_R16
|
|
SPECIFICS_II(IEEE_REAL_II)
|
|
SPECIFICS_RI(IEEE_REAL_RI)
|
|
#endif
|
|
end interface ieee_real
|
|
public :: 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
|
|
public :: 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
|
|
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
|