643 lines · plain
1!===-- module/ieee_arithmetic.f90 ------------------------------------------===!2!3! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.4! See https://llvm.org/LICENSE.txt for license information.5! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception6!7!===------------------------------------------------------------------------===!8 9! Fortran 2018 Clause 1710 11#include '../include/flang/Runtime/magic-numbers.h'12 13module ieee_arithmetic14 ! F18 Clause 17.1p1:15 ! The module IEEE_ARITHMETIC behaves as if it contained a USE statement for16 ! IEEE_EXCEPTIONS; everything that is public in IEEE_EXCEPTIONS is public in17 ! IEEE_ARITHMETIC.18 use __fortran_ieee_exceptions19 20 use __fortran_builtins, only: &21 ieee_away => __builtin_ieee_away, &22 ieee_down => __builtin_ieee_down, &23 ieee_fma => __builtin_fma, &24 ieee_int => __builtin_ieee_int, &25 ieee_is_nan => __builtin_ieee_is_nan, &26 ieee_is_negative => __builtin_ieee_is_negative, &27 ieee_is_normal => __builtin_ieee_is_normal, &28 ieee_nearest => __builtin_ieee_nearest, &29 ieee_next_after => __builtin_ieee_next_after, &30 ieee_next_down => __builtin_ieee_next_down, &31 ieee_next_up => __builtin_ieee_next_up, &32 ieee_other => __builtin_ieee_other, &33 ieee_real => __builtin_ieee_real, &34 ieee_round_type => __builtin_ieee_round_type, &35 ieee_scalb => scale, &36 ieee_selected_real_kind => __builtin_ieee_selected_real_kind, &37 ieee_support_datatype => __builtin_ieee_support_datatype, &38 ieee_support_denormal => __builtin_ieee_support_denormal, &39 ieee_support_divide => __builtin_ieee_support_divide, &40 ieee_support_inf => __builtin_ieee_support_inf, &41 ieee_support_io => __builtin_ieee_support_io, &42 ieee_support_nan => __builtin_ieee_support_nan, &43 ieee_support_rounding => __builtin_ieee_support_rounding, &44 ieee_support_sqrt => __builtin_ieee_support_sqrt, &45 ieee_support_standard => __builtin_ieee_support_standard, &46 ieee_support_subnormal => __builtin_ieee_support_subnormal, &47 ieee_support_underflow_control => __builtin_ieee_support_underflow_control, &48 ieee_to_zero => __builtin_ieee_to_zero, &49 ieee_up => __builtin_ieee_up50 51 52 implicit none53 54 ! Set PRIVATE by default to explicitly only export what is meant55 ! to be exported by this MODULE.56 private57 58 ! Explicitly export the symbols from __fortran_builtins59 public :: ieee_away60 public :: ieee_down61 public :: ieee_fma62 public :: ieee_int63 public :: ieee_is_nan64 public :: ieee_is_negative65 public :: ieee_is_normal66 public :: ieee_nearest67 public :: ieee_other68 public :: ieee_next_after69 public :: ieee_next_down70 public :: ieee_next_up71 public :: ieee_real72 public :: ieee_round_type73 public :: ieee_scalb74 public :: ieee_selected_real_kind75 public :: ieee_support_datatype76 public :: ieee_support_denormal77 public :: ieee_support_divide78 public :: ieee_support_inf79 public :: ieee_support_io80 public :: ieee_support_nan81 public :: ieee_support_rounding82 public :: ieee_support_sqrt83 public :: ieee_support_standard84 public :: ieee_support_subnormal85 public :: ieee_support_underflow_control86 public :: ieee_to_zero87 public :: ieee_up88 89 ! Explicitly export the symbols from __fortran_ieee_exceptions90 public :: ieee_flag_type91 public :: ieee_invalid92 public :: ieee_overflow93 public :: ieee_divide_by_zero94 public :: ieee_underflow95 public :: ieee_inexact96 public :: ieee_denorm97 public :: ieee_usual98 public :: ieee_all99 public :: ieee_modes_type100 public :: ieee_status_type101 public :: ieee_get_flag102 public :: ieee_get_halting_mode103 public :: ieee_get_modes104 public :: ieee_get_status105 public :: ieee_set_flag106 public :: ieee_set_halting_mode107 public :: ieee_set_modes108 public :: ieee_set_status109 public :: ieee_support_flag110 public :: ieee_support_halting111 112 type, public :: ieee_class_type113 private114 integer(kind=1) :: which = 0115 end type ieee_class_type116 117 type(ieee_class_type), parameter, public :: &118 ieee_signaling_nan = ieee_class_type(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN), &119 ieee_quiet_nan = ieee_class_type(_FORTRAN_RUNTIME_IEEE_QUIET_NAN), &120 ieee_negative_inf = ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_INF), &121 ieee_negative_normal = &122 ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL), &123 ieee_negative_subnormal = &124 ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL), &125 ieee_negative_zero = ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO), &126 ieee_positive_zero = ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO), &127 ieee_positive_subnormal = &128 ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL), &129 ieee_positive_normal = &130 ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL), &131 ieee_positive_inf = ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_INF), &132 ieee_other_value = ieee_class_type(_FORTRAN_RUNTIME_IEEE_OTHER_VALUE)133 134 type(ieee_class_type), parameter, public :: &135 ieee_negative_denormal = ieee_negative_subnormal, &136 ieee_positive_denormal = ieee_positive_subnormal137 138 interface operator(==)139 elemental logical function ieee_class_eq(x, y)140 import ieee_class_type141 type(ieee_class_type), intent(in) :: x, y142 end function ieee_class_eq143 elemental logical function ieee_round_eq(x, y)144 import ieee_round_type145 type(ieee_round_type), intent(in) :: x, y146 end function ieee_round_eq147 end interface operator(==)148 public :: operator(==)149 150 interface operator(/=)151 elemental logical function ieee_class_ne(x, y)152 import ieee_class_type153 type(ieee_class_type), intent(in) :: x, y154 end function ieee_class_ne155 elemental logical function ieee_round_ne(x, y)156 import ieee_round_type157 type(ieee_round_type), intent(in) :: x, y158 end function ieee_round_ne159 end interface operator(/=)160 public :: operator(/=)161 162! Define specifics with 1 or 2 INTEGER, LOGICAL, or REAL arguments for163! generic G.164!165! The result type of most function specifics is either a fixed type or166! the type of the first argument. The result type of a SPECIFICS_rRR167! function call is the highest precision argument type.168 169#define SPECIFICS_I(G) \170 G(1) G(2) G(4) G(8) G(16)171#define SPECIFICS_L(G) \172 G(1) G(2) G(4) G(8)173 174#if FLANG_SUPPORT_R16175#if __x86_64__176#define SPECIFICS_R(G) \177 G(2) G(3) G(4) G(8) G(10) G(16)178#else179#define SPECIFICS_R(G) \180 G(2) G(3) G(4) G(8) G(16)181#endif182#else183#if __x86_64__184#define SPECIFICS_R(G) \185 G(2) G(3) G(4) G(8) G(10)186#else187#define SPECIFICS_R(G) \188 G(2) G(3) G(4) G(8)189#endif190#endif191 192#define SPECIFICS_II(G) \193 G(1,1) G(1,2) G(1,4) G(1,8) G(1,16) \194 G(2,1) G(2,2) G(2,4) G(2,8) G(2,16) \195 G(4,1) G(4,2) G(4,4) G(4,8) G(4,16) \196 G(8,1) G(8,2) G(8,4) G(8,8) G(8,16) \197 G(16,1) G(16,2) G(16,4) G(16,8) G(16,16)198 199#if FLANG_SUPPORT_R16200#if __x86_64__201#define SPECIFICS_RI(G) \202 G(2,1) G(2,2) G(2,4) G(2,8) G(2,16) \203 G(3,1) G(3,2) G(3,4) G(3,8) G(3,16) \204 G(4,1) G(4,2) G(4,4) G(4,8) G(4,16) \205 G(8,1) G(8,2) G(8,4) G(8,8) G(8,16) \206 G(10,1) G(10,2) G(10,4) G(10,8) G(10,16) \207 G(16,1) G(16,2) G(16,4) G(16,8) G(16,16)208#else209#define SPECIFICS_RI(G) \210 G(2,1) G(2,2) G(2,4) G(2,8) G(2,16) \211 G(3,1) G(3,2) G(3,4) G(3,8) G(3,16) \212 G(4,1) G(4,2) G(4,4) G(4,8) G(4,16) \213 G(8,1) G(8,2) G(8,4) G(8,8) G(8,16) \214 G(16,1) G(16,2) G(16,4) G(16,8) G(16,16)215#endif216#else217#if __x86_64__218#define SPECIFICS_RI(G) \219 G(2,1) G(2,2) G(2,4) G(2,8) \220 G(3,1) G(3,2) G(3,4) G(3,8) \221 G(4,1) G(4,2) G(4,4) G(4,8) \222 G(8,1) G(8,2) G(8,4) G(8,8) \223 G(10,1) G(10,2) G(10,4) G(10,8)224#else225#define SPECIFICS_RI(G) \226 G(2,1) G(2,2) G(2,4) G(2,8) \227 G(3,1) G(3,2) G(3,4) G(3,8) \228 G(4,1) G(4,2) G(4,4) G(4,8) \229 G(8,1) G(8,2) G(8,4) G(8,8)230#endif231#endif232 233#if FLANG_SUPPORT_R16234#if __x86_64__235#define SPECIFICS_RR(G) \236 G(2,2) G(2,3) G(2,4) G(2,8) G(2,10) G(2,16) \237 G(3,2) G(3,3) G(3,4) G(3,8) G(3,10) G(3,16) \238 G(4,2) G(4,3) G(4,4) G(4,8) G(4,10) G(4,16) \239 G(8,2) G(8,3) G(8,4) G(8,8) G(8,10) G(8,16) \240 G(10,2) G(10,3) G(10,4) G(10,8) G(10,10) G(10,16) \241 G(16,2) G(16,3) G(16,4) G(16,8) G(16,10) G(16,16)242#define SPECIFICS_rRR(G) \243 G(2,2,2) G(2,2,3) G(4,2,4) G(8,2,8) G(10,2,10) G(16,2,16) \244 G(2,3,2) G(3,3,3) G(4,3,4) G(8,3,8) G(10,3,10) G(16,3,16) \245 G(4,4,2) G(4,4,3) G(4,4,4) G(8,4,8) G(10,4,10) G(16,4,16) \246 G(8,8,2) G(8,8,3) G(8,8,4) G(8,8,8) G(10,8,10) G(16,8,16) \247 G(10,10,2) G(10,10,3) G(10,10,4) G(10,10,8) G(10,10,10) G(16,10,16) \248 G(16,16,2) G(16,16,3) G(16,16,4) G(16,16,8) G(16,16,10) G(16,16,16)249#else250#define SPECIFICS_RR(G) \251 G(2,2) G(2,3) G(2,4) G(2,8) G(2,16) \252 G(3,2) G(3,3) G(3,4) G(3,8) G(3,16) \253 G(4,2) G(4,3) G(4,4) G(4,8) G(4,16) \254 G(8,2) G(8,3) G(8,4) G(8,8) G(8,16) \255 G(16,2) G(16,3) G(16,4) G(16,8) G(16,16)256#define SPECIFICS_rRR(G) \257 G(2,2,2) G(2,2,3) G(4,2,4) G(8,2,8) G(16,2,16) \258 G(2,3,2) G(3,3,3) G(4,3,4) G(8,3,8) G(16,3,16) \259 G(4,4,2) G(4,4,3) G(4,4,4) G(8,4,8) G(16,4,16) \260 G(8,8,2) G(8,8,3) G(8,8,4) G(8,8,8) G(16,8,16) \261 G(16,16,2) G(16,16,3) G(16,16,4) G(16,16,8) G(16,16,16)262#endif263#else264#if __x86_64__265#define SPECIFICS_RR(G) \266 G(2,2) G(2,3) G(2,4) G(2,8) G(2,10) \267 G(3,2) G(3,3) G(3,4) G(3,8) G(3,10) \268 G(4,2) G(4,3) G(4,4) G(4,8) G(4,10) \269 G(8,2) G(8,3) G(8,4) G(8,8) G(8,10) \270 G(10,2) G(10,3) G(10,4) G(10,8) G(10,10)271#define SPECIFICS_rRR(G) \272 G(2,2,2) G(2,2,3) G(4,2,4) G(8,2,8) G(10,2,10) \273 G(2,3,2) G(3,3,3) G(4,3,4) G(8,3,8) G(10,3,10) \274 G(4,4,2) G(4,4,3) G(4,4,4) G(8,4,8) G(10,4,10) \275 G(8,8,2) G(8,8,3) G(8,8,4) G(8,8,8) G(10,8,10) \276 G(10,10,2) G(10,10,3) G(10,10,4) G(10,10,8) G(10,10,10)277#else278#define SPECIFICS_RR(G) \279 G(2,2) G(2,3) G(2,4) G(2,8) \280 G(3,2) G(3,3) G(3,4) G(3,8) \281 G(4,2) G(4,3) G(4,4) G(4,8) \282 G(8,2) G(8,3) G(8,4) G(8,8)283#define SPECIFICS_rRR(G) \284 G(2,2,2) G(2,2,3) G(4,2,4) G(8,2,8) \285 G(2,3,2) G(3,3,3) G(4,3,4) G(8,3,8) \286 G(4,4,2) G(4,4,3) G(4,4,4) G(8,4,8) \287 G(8,8,2) G(8,8,3) G(8,8,4) G(8,8,8)288#endif289#endif290 291#define IEEE_CLASS_R(XKIND) \292 elemental type(ieee_class_type) function ieee_class_a##XKIND(x); \293 import ieee_class_type; \294 real(XKIND), intent(in) :: x; \295 end function ieee_class_a##XKIND;296 interface ieee_class297 SPECIFICS_R(IEEE_CLASS_R)298 end interface ieee_class299 public :: ieee_class300#undef IEEE_CLASS_R301 302#define IEEE_COPY_SIGN_RR(XKIND, YKIND) \303 elemental real(XKIND) function ieee_copy_sign_a##XKIND##_a##YKIND(x, y); \304 real(XKIND), intent(in) :: x; \305 real(YKIND), intent(in) :: y; \306 end function ieee_copy_sign_a##XKIND##_a##YKIND;307 interface ieee_copy_sign308 SPECIFICS_RR(IEEE_COPY_SIGN_RR)309 end interface ieee_copy_sign310 public :: ieee_copy_sign311#undef IEEE_COPY_SIGN_RR312 313#define IEEE_GET_ROUNDING_MODE_I(RKIND) \314 subroutine ieee_get_rounding_mode_i##RKIND(round_value, radix); \315 import ieee_round_type; \316 type(ieee_round_type), intent(out) :: round_value; \317 integer(RKIND), intent(in) :: radix; \318 end subroutine ieee_get_rounding_mode_i##RKIND;319 interface ieee_get_rounding_mode320 subroutine ieee_get_rounding_mode_0(round_value)321 import ieee_round_type322 type(ieee_round_type), intent(out) :: round_value323 end subroutine ieee_get_rounding_mode_0324 SPECIFICS_I(IEEE_GET_ROUNDING_MODE_I)325 end interface ieee_get_rounding_mode326 public :: ieee_get_rounding_mode327#undef IEEE_GET_ROUNDING_MODE_I328 329#define IEEE_GET_UNDERFLOW_MODE_L(GKIND) \330 subroutine ieee_get_underflow_mode_l##GKIND(gradual); \331 logical(GKIND), intent(out) :: gradual; \332 end subroutine ieee_get_underflow_mode_l##GKIND;333 interface ieee_get_underflow_mode334 SPECIFICS_L(IEEE_GET_UNDERFLOW_MODE_L)335 end interface ieee_get_underflow_mode336 public :: ieee_get_underflow_mode337#undef IEEE_GET_UNDERFLOW_MODE_L338 339#define IEEE_IS_FINITE_R(XKIND) \340 elemental logical function ieee_is_finite_a##XKIND(x); \341 real(XKIND), intent(in) :: x; \342 !dir$ ignore_tkr(d) x; \343 end function ieee_is_finite_a##XKIND;344 interface ieee_is_finite345 SPECIFICS_R(IEEE_IS_FINITE_R)346 end interface ieee_is_finite347 public :: ieee_is_finite348#undef IEEE_IS_FINITE_R349 350#define IEEE_LOGB_R(XKIND) \351 elemental real(XKIND) function ieee_logb_a##XKIND(x); \352 real(XKIND), intent(in) :: x; \353 end function ieee_logb_a##XKIND;354 interface ieee_logb355 SPECIFICS_R(IEEE_LOGB_R)356 end interface ieee_logb357 public :: ieee_logb358#undef IEEE_LOGB_R359 360#define IEEE_MAX_R(XKIND) \361 elemental real(XKIND) function ieee_max_a##XKIND(x, y); \362 real(XKIND), intent(in) :: x, y; \363 end function ieee_max_a##XKIND;364 interface ieee_max365 SPECIFICS_R(IEEE_MAX_R)366 end interface ieee_max367 public :: ieee_max368#undef IEEE_MAX_R369 370#define IEEE_MAX_MAG_R(XKIND) \371 elemental real(XKIND) function ieee_max_mag_a##XKIND(x, y); \372 real(XKIND), intent(in) :: x, y; \373 end function ieee_max_mag_a##XKIND;374 interface ieee_max_mag375 SPECIFICS_R(IEEE_MAX_MAG_R)376 end interface ieee_max_mag377 public :: ieee_max_mag378#undef IEEE_MAX_MAG_R379 380#define IEEE_MAX_NUM_R(XKIND) \381 elemental real(XKIND) function ieee_max_num_a##XKIND(x, y); \382 real(XKIND), intent(in) :: x, y; \383 end function ieee_max_num_a##XKIND;384 interface ieee_max_num385 SPECIFICS_R(IEEE_MAX_NUM_R)386 end interface ieee_max_num387 public :: ieee_max_num388#undef IEEE_MAX_NUM_R389 390#define IEEE_MAX_NUM_MAG_R(XKIND) \391 elemental real(XKIND) function ieee_max_num_mag_a##XKIND(x, y); \392 real(XKIND), intent(in) :: x, y; \393 end function ieee_max_num_mag_a##XKIND;394 interface ieee_max_num_mag395 SPECIFICS_R(IEEE_MAX_NUM_MAG_R)396 end interface ieee_max_num_mag397 public :: ieee_max_num_mag398#undef IEEE_MAX_NUM_MAG_R399 400#define IEEE_MIN_R(XKIND) \401 elemental real(XKIND) function ieee_min_a##XKIND(x, y); \402 real(XKIND), intent(in) :: x, y; \403 end function ieee_min_a##XKIND;404 interface ieee_min405 SPECIFICS_R(IEEE_MIN_R)406 end interface ieee_min407 public :: ieee_min408#undef IEEE_MIN_R409 410#define IEEE_MIN_MAG_R(XKIND) \411 elemental real(XKIND) function ieee_min_mag_a##XKIND(x, y); \412 real(XKIND), intent(in) :: x, y; \413 end function ieee_min_mag_a##XKIND;414 interface ieee_min_mag415 SPECIFICS_R(IEEE_MIN_MAG_R)416 end interface ieee_min_mag417 public :: ieee_min_mag418#undef IEEE_MIN_MAG_R419 420#define IEEE_MIN_NUM_R(XKIND) \421 elemental real(XKIND) function ieee_min_num_a##XKIND(x, y); \422 real(XKIND), intent(in) :: x, y; \423 end function ieee_min_num_a##XKIND;424 interface ieee_min_num425 SPECIFICS_R(IEEE_MIN_NUM_R)426 end interface ieee_min_num427 public :: ieee_min_num428#undef IEEE_MIN_NUM_R429 430#define IEEE_MIN_NUM_MAG_R(XKIND) \431 elemental real(XKIND) function ieee_min_num_mag_a##XKIND(x, y); \432 real(XKIND), intent(in) :: x, y; \433 end function ieee_min_num_mag_a##XKIND;434 interface ieee_min_num_mag435 SPECIFICS_R(IEEE_MIN_NUM_MAG_R)436 end interface ieee_min_num_mag437 public ::ieee_min_num_mag438#undef IEEE_MIN_NUM_MAG_R439 440#define IEEE_QUIET_EQ_R(AKIND) \441 elemental logical function ieee_quiet_eq_a##AKIND(a, b); \442 real(AKIND), intent(in) :: a, b; \443 end function ieee_quiet_eq_a##AKIND;444 interface ieee_quiet_eq445 SPECIFICS_R(IEEE_QUIET_EQ_R)446 end interface ieee_quiet_eq447 public :: ieee_quiet_eq448#undef IEEE_QUIET_EQ_R449 450#define IEEE_QUIET_GE_R(AKIND) \451 elemental logical function ieee_quiet_ge_a##AKIND(a, b); \452 real(AKIND), intent(in) :: a, b; \453 end function ieee_quiet_ge_a##AKIND;454 interface ieee_quiet_ge455 SPECIFICS_R(IEEE_QUIET_GE_R)456 end interface ieee_quiet_ge457 public :: ieee_quiet_ge458#undef IEEE_QUIET_GE_R459 460#define IEEE_QUIET_GT_R(AKIND) \461 elemental logical function ieee_quiet_gt_a##AKIND(a, b); \462 real(AKIND), intent(in) :: a, b; \463 end function ieee_quiet_gt_a##AKIND;464 interface ieee_quiet_gt465 SPECIFICS_R(IEEE_QUIET_GT_R)466 end interface ieee_quiet_gt467 public :: ieee_quiet_gt468#undef IEEE_QUIET_GT_R469 470#define IEEE_QUIET_LE_R(AKIND) \471 elemental logical function ieee_quiet_le_a##AKIND(a, b); \472 real(AKIND), intent(in) :: a, b; \473 end function ieee_quiet_le_a##AKIND;474 interface ieee_quiet_le475 SPECIFICS_R(IEEE_QUIET_LE_R)476 end interface ieee_quiet_le477 public :: ieee_quiet_le478#undef IEEE_QUIET_LE_R479 480#define IEEE_QUIET_LT_R(AKIND) \481 elemental logical function ieee_quiet_lt_a##AKIND(a, b); \482 real(AKIND), intent(in) :: a, b; \483 end function ieee_quiet_lt_a##AKIND;484 interface ieee_quiet_lt485 SPECIFICS_R(IEEE_QUIET_LT_R)486 end interface ieee_quiet_lt487 public :: ieee_quiet_lt488#undef IEEE_QUIET_LT_R489 490#define IEEE_QUIET_NE_R(AKIND) \491 elemental logical function ieee_quiet_ne_a##AKIND(a, b); \492 real(AKIND), intent(in) :: a, b; \493 end function ieee_quiet_ne_a##AKIND;494 interface ieee_quiet_ne495 SPECIFICS_R(IEEE_QUIET_NE_R)496 end interface ieee_quiet_ne497 public :: ieee_quiet_ne498#undef IEEE_QUIET_NE_R499 500#define IEEE_REM_rRR(RKIND, XKIND, YKIND) \501 elemental real(RKIND) function ieee_rem_a##XKIND##_a##YKIND(x, y); \502 real(XKIND), intent(in) :: x; \503 real(YKIND), intent(in) :: y; \504 end function ieee_rem_a##XKIND##_a##YKIND;505 interface ieee_rem506 SPECIFICS_rRR(IEEE_REM_rRR)507 end interface ieee_rem508 public :: ieee_rem509#undef IEEE_REM_rRR510 511#define IEEE_RINT_R(XKIND) \512 elemental real(XKIND) function ieee_rint_a##XKIND(x, round); \513 import ieee_round_type; \514 real(XKIND), intent(in) :: x; \515 type(ieee_round_type), optional, intent(in) :: round; \516 end function ieee_rint_a##XKIND;517 interface ieee_rint518 SPECIFICS_R(IEEE_RINT_R)519 end interface ieee_rint520 public :: ieee_rint521#undef IEEE_RINT_R522 523#define IEEE_SET_ROUNDING_MODE_I(RKIND) \524 subroutine ieee_set_rounding_mode_i##RKIND(round_value, radix); \525 import ieee_round_type; \526 type(ieee_round_type), intent(in) :: round_value; \527 integer(RKIND), intent(in) :: radix; \528 end subroutine ieee_set_rounding_mode_i##RKIND;529 interface ieee_set_rounding_mode530 subroutine ieee_set_rounding_mode_0(round_value)531 import ieee_round_type532 type(ieee_round_type), intent(in) :: round_value533 end subroutine ieee_set_rounding_mode_0534 SPECIFICS_I(IEEE_SET_ROUNDING_MODE_I)535 end interface ieee_set_rounding_mode536 public :: ieee_set_rounding_mode537#undef IEEE_SET_ROUNDING_MODE_I538 539#define IEEE_SET_UNDERFLOW_MODE_L(GKIND) \540 subroutine ieee_set_underflow_mode_l##GKIND(gradual); \541 logical(GKIND), intent(in) :: gradual; \542 end subroutine ieee_set_underflow_mode_l##GKIND;543 interface ieee_set_underflow_mode544 SPECIFICS_L(IEEE_SET_UNDERFLOW_MODE_L)545 end interface ieee_set_underflow_mode546 public :: ieee_set_underflow_mode547#undef IEEE_SET_UNDERFLOW_MODE_L548 549#define IEEE_SIGNALING_EQ_R(AKIND) \550 elemental logical function ieee_signaling_eq_a##AKIND(a, b); \551 real(AKIND), intent(in) :: a, b; \552 end function ieee_signaling_eq_a##AKIND;553 interface ieee_signaling_eq554 SPECIFICS_R(IEEE_SIGNALING_EQ_R)555 end interface ieee_signaling_eq556 public :: ieee_signaling_eq557#undef IEEE_SIGNALING_EQ_R558 559#define IEEE_SIGNALING_GE_R(AKIND) \560 elemental logical function ieee_signaling_ge_a##AKIND(a, b); \561 real(AKIND), intent(in) :: a, b; \562 end function ieee_signaling_ge_a##AKIND;563 interface ieee_signaling_ge564 SPECIFICS_R(IEEE_SIGNALING_GE_R)565 end interface ieee_signaling_ge566 public :: ieee_signaling_ge567#undef IEEE_SIGNALING_GE_R568 569#define IEEE_SIGNALING_GT_R(AKIND) \570 elemental logical function ieee_signaling_gt_a##AKIND(a, b); \571 real(AKIND), intent(in) :: a, b; \572 end function ieee_signaling_gt_a##AKIND;573 interface ieee_signaling_gt574 SPECIFICS_R(IEEE_SIGNALING_GT_R)575 end interface ieee_signaling_gt576 public :: ieee_signaling_gt577#undef IEEE_SIGNALING_GT_R578 579#define IEEE_SIGNALING_LE_R(AKIND) \580 elemental logical function ieee_signaling_le_a##AKIND(a, b); \581 real(AKIND), intent(in) :: a, b; \582 end function ieee_signaling_le_a##AKIND;583 interface ieee_signaling_le584 SPECIFICS_R(IEEE_SIGNALING_LE_R)585 end interface ieee_signaling_le586 public :: ieee_signaling_le587#undef IEEE_SIGNALING_LE_R588 589#define IEEE_SIGNALING_LT_R(AKIND) \590 elemental logical function ieee_signaling_lt_a##AKIND(a, b); \591 real(AKIND), intent(in) :: a, b; \592 end function ieee_signaling_lt_a##AKIND;593 interface ieee_signaling_lt594 SPECIFICS_R(IEEE_SIGNALING_LT_R)595 end interface ieee_signaling_lt596 public :: ieee_signaling_lt597#undef IEEE_SIGNALING_LT_R598 599#define IEEE_SIGNALING_NE_R(AKIND) \600 elemental logical function ieee_signaling_ne_a##AKIND(a, b); \601 real(AKIND), intent(in) :: a, b; \602 end function ieee_signaling_ne_a##AKIND;603 interface ieee_signaling_ne604 SPECIFICS_R(IEEE_SIGNALING_NE_R)605 end interface ieee_signaling_ne606 public :: ieee_signaling_ne607#undef IEEE_SIGNALING_NE_R608 609#define IEEE_SIGNBIT_R(XKIND) \610 elemental logical function ieee_signbit_a##XKIND(x); \611 real(XKIND), intent(in) :: x; \612 end function ieee_signbit_a##XKIND;613 interface ieee_signbit614 SPECIFICS_R(IEEE_SIGNBIT_R)615 end interface ieee_signbit616 public :: ieee_signbit617#undef IEEE_SIGNBIT_R618 619#define IEEE_UNORDERED_RR(XKIND, YKIND) \620 elemental logical function ieee_unordered_a##XKIND##_a##YKIND(x, y); \621 real(XKIND), intent(in) :: x; \622 real(YKIND), intent(in) :: y; \623 end function ieee_unordered_a##XKIND##_a##YKIND;624 interface ieee_unordered625 SPECIFICS_RR(IEEE_UNORDERED_RR)626 end interface ieee_unordered627 public :: ieee_unordered628#undef IEEE_UNORDERED_RR629 630#define IEEE_VALUE_R(XKIND) \631 elemental real(XKIND) function ieee_value_a##XKIND(x, class); \632 import ieee_class_type; \633 real(XKIND), intent(in) :: x; \634 type(ieee_class_type), intent(in) :: class; \635 end function ieee_value_a##XKIND;636 interface ieee_value637 SPECIFICS_R(IEEE_VALUE_R)638 end interface ieee_value639 public :: ieee_value640#undef IEEE_VALUE_R641 642end module ieee_arithmetic643