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-exception 6! 7!===------------------------------------------------------------------------===! 8 9! Fortran 2018 Clause 17 10 11module ieee_arithmetic 12 ! 17.1: "The module IEEE_ARITHMETIC behaves as if it contained a 13 ! USE statement for IEEE_EXCEPTIONS; everything that is public in 14 ! IEEE_EXCEPTIONS is public in IEEE_ARITHMETIC." 15 use __Fortran_ieee_exceptions 16 17 use __Fortran_builtins, only: & 18 ieee_is_nan => __builtin_ieee_is_nan, & 19 ieee_is_negative => __builtin_ieee_is_negative, & 20 ieee_is_normal => __builtin_ieee_is_normal, & 21 ieee_next_after => __builtin_ieee_next_after, & 22 ieee_next_down => __builtin_ieee_next_down, & 23 ieee_next_up => __builtin_ieee_next_up, & 24 ieee_scalb => scale, & 25 ieee_selected_real_kind => __builtin_ieee_selected_real_kind, & 26 ieee_support_datatype => __builtin_ieee_support_datatype, & 27 ieee_support_denormal => __builtin_ieee_support_denormal, & 28 ieee_support_divide => __builtin_ieee_support_divide, & 29 ieee_support_inf => __builtin_ieee_support_inf, & 30 ieee_support_io => __builtin_ieee_support_io, & 31 ieee_support_nan => __builtin_ieee_support_nan, & 32 ieee_support_sqrt => __builtin_ieee_support_sqrt, & 33 ieee_support_standard => __builtin_ieee_support_standard, & 34 ieee_support_subnormal => __builtin_ieee_support_subnormal, & 35 ieee_support_underflow_control => __builtin_ieee_support_underflow_control 36 37 implicit none 38 39 type :: ieee_class_type 40 private 41 integer(kind=1) :: which = 0 42 end type ieee_class_type 43 44 type(ieee_class_type), parameter :: & 45 ieee_signaling_nan = ieee_class_type(1), & 46 ieee_quiet_nan = ieee_class_type(2), & 47 ieee_negative_inf = ieee_class_type(3), & 48 ieee_negative_normal = ieee_class_type(4), & 49 ieee_negative_denormal = ieee_class_type(5), & 50 ieee_negative_zero = ieee_class_type(6), & 51 ieee_positive_zero = ieee_class_type(7), & 52 ieee_positive_subnormal = ieee_class_type(8), & 53 ieee_positive_normal = ieee_class_type(9), & 54 ieee_positive_inf = ieee_class_type(10), & 55 ieee_other_value = ieee_class_type(11) 56 57 type(ieee_class_type), parameter :: & 58 ieee_negative_subnormal = ieee_negative_denormal, & 59 ieee_positive_denormal = ieee_negative_subnormal 60 61 type :: ieee_round_type 62 private 63 integer(kind=1) :: mode = 0 64 end type ieee_round_type 65 66 type(ieee_round_type), parameter :: & 67 ieee_nearest = ieee_round_type(1), & 68 ieee_to_zero = ieee_round_type(2), & 69 ieee_up = ieee_round_type(3), & 70 ieee_down = ieee_round_type(4), & 71 ieee_away = ieee_round_type(5), & 72 ieee_other = ieee_round_type(6) 73 74 interface operator(==) 75 elemental logical function ieee_class_eq(x, y) 76 import ieee_class_type 77 type(ieee_class_type), intent(in) :: x, y 78 end function ieee_class_eq 79 elemental logical function ieee_round_eq(x, y) 80 import ieee_round_type 81 type(ieee_round_type), intent(in) :: x, y 82 end function ieee_round_eq 83 end interface operator(==) 84 interface operator(/=) 85 elemental logical function ieee_class_ne(x, y) 86 import ieee_class_type 87 type(ieee_class_type), intent(in) :: x, y 88 end function ieee_class_ne 89 elemental logical function ieee_round_ne(x, y) 90 import ieee_round_type 91 type(ieee_round_type), intent(in) :: x, y 92 end function ieee_round_ne 93 end interface operator(/=) 94 private :: ieee_class_eq, ieee_round_eq, ieee_class_ne, ieee_round_ne 95 96! Define specifics with 1 or 2 INTEGER, LOGICAL, or REAL arguments for 97! generic G. 98#define SPECIFICS_I(G) \ 99 G(1) G(2) G(4) G(8) G(16) 100#define SPECIFICS_L(G) \ 101 G(1) G(2) G(4) G(8) 102#define SPECIFICS_R(G) \ 103 G(2) G(3) G(4) G(8) G(10) G(16) 104#define SPECIFICS_II(G) \ 105 G(1,1) G(1,2) G(1,4) G(1,8) G(1,16) \ 106 G(2,1) G(2,2) G(2,4) G(2,8) G(2,16) \ 107 G(4,1) G(4,2) G(4,4) G(4,8) G(4,16) \ 108 G(8,1) G(8,2) G(8,4) G(8,8) G(8,16) \ 109 G(16,1) G(16,2) G(16,4) G(16,8) G(16,16) 110#define SPECIFICS_RI(G) \ 111 G(2,1) G(2,2) G(2,4) G(2,8) G(2,16) \ 112 G(3,1) G(3,2) G(3,4) G(3,8) G(3,16) \ 113 G(4,1) G(4,2) G(4,4) G(4,8) G(4,16) \ 114 G(8,1) G(8,2) G(8,4) G(8,8) G(8,16) \ 115 G(10,1) G(10,2) G(10,4) G(10,8) G(10,16) \ 116 G(16,1) G(16,2) G(16,4) G(16,8) G(16,16) 117#define SPECIFICS_RR(G) \ 118 G(2,2) G(2,3) G(2,4) G(2,8) G(2,10) G(2,16) \ 119 G(3,2) G(3,3) G(3,4) G(3,8) G(3,10) G(3,16) \ 120 G(4,2) G(4,3) G(4,4) G(4,8) G(4,10) G(4,16) \ 121 G(8,2) G(8,3) G(8,4) G(8,8) G(8,10) G(8,16) \ 122 G(10,2) G(10,3) G(10,4) G(10,8) G(10,10) G(10,16) \ 123 G(16,2) G(16,3) G(16,4) G(16,8) G(16,10) G(16,16) 124 125! Set PRIVATE accessibility for specifics with 1 or 2 INTEGER, LOGICAL, or REAL 126! arguments for generic G. 127#define PRIVATE_I(G) private :: \ 128 G##_i1, G##_i2, G##_i4, G##_i8, G##_i16 129#define PRIVATE_L(G) private :: \ 130 G##_l1, G##_l2, G##_l4, G##_l8 131#define PRIVATE_R(G) private :: \ 132 G##_a2, G##_a3, G##_a4, G##_a8, G##_a10, G##_a16 133#define PRIVATE_II(G) private :: \ 134 G##_i1_i1, G##_i1_i2, G##_i1_i4, G##_i1_i8, G##_i1_i16, \ 135 G##_i2_i1, G##_i2_i2, G##_i2_i4, G##_i2_i8, G##_i2_i16, \ 136 G##_i4_i1, G##_i4_i2, G##_i4_i4, G##_i4_i8, G##_i4_i16, \ 137 G##_i8_i1, G##_i8_i2, G##_i8_i4, G##_i8_i8, G##_i8_i16, \ 138 G##_i16_i1, G##_i16_i2, G##_i16_i4, G##_i16_i8, G##_i16_i16 139#define PRIVATE_RI(G) private :: \ 140 G##_a2_i1, G##_a2_i2, G##_a2_i4, G##_a2_i8, G##_a2_i16, \ 141 G##_a3_i1, G##_a3_i2, G##_a3_i4, G##_a3_i8, G##_a3_i16, \ 142 G##_a4_i1, G##_a4_i2, G##_a4_i4, G##_a4_i8, G##_a4_i16, \ 143 G##_a8_i1, G##_a8_i2, G##_a8_i4, G##_a8_i8, G##_a8_i16, \ 144 G##_a10_i1, G##_a10_i2, G##_a10_i4, G##_a10_i8, G##_a10_i16, \ 145 G##_a16_i1, G##_a16_i2, G##_a16_i4, G##_a16_i8, G##_a16_i16 146#define PRIVATE_RR(G) private :: \ 147 G##_a2_a2, G##_a2_a3, G##_a2_a4, G##_a2_a8, G##_a2_a10, G##_a2_a16, \ 148 G##_a3_a2, G##_a3_a3, G##_a3_a4, G##_a3_a8, G##_a3_a10, G##_a3_a16, \ 149 G##_a4_a2, G##_a4_a3, G##_a4_a4, G##_a4_a8, G##_a4_a10, G##_a4_a16, \ 150 G##_a8_a2, G##_a8_a3, G##_a8_a4, G##_a8_a8, G##_a8_a10, G##_a8_a16, \ 151 G##_a10_a2, G##_a10_a3, G##_a10_a4, G##_a10_a8, G##_a10_a10, G##_a10_a16, \ 152 G##_a16_a2, G##_a16_a3, G##_a16_a4, G##_a16_a8, G##_a16_a10, G##_a16_a16 153 154#define IEEE_CLASS_R(XKIND) \ 155 elemental type(ieee_class_type) function ieee_class_a##XKIND(x); \ 156 import ieee_class_type; \ 157 real(XKIND), intent(in) :: x; \ 158 end function ieee_class_a##XKIND; 159 interface ieee_class 160 SPECIFICS_R(IEEE_CLASS_R) 161 end interface ieee_class 162 PRIVATE_R(IEEE_CLASS) 163#undef IEEE_CLASS_R 164 165#define IEEE_COPY_SIGN_RR(XKIND, YKIND) \ 166 elemental real(XKIND) function ieee_copy_sign_a##XKIND##_a##YKIND(x, y); \ 167 real(XKIND), intent(in) :: x; \ 168 real(YKIND), intent(in) :: y; \ 169 end function ieee_copy_sign_a##XKIND##_a##YKIND; 170 interface ieee_copy_sign 171 SPECIFICS_RR(IEEE_COPY_SIGN_RR) 172 end interface ieee_copy_sign 173 PRIVATE_RR(IEEE_COPY_SIGN) 174#undef IEEE_COPY_SIGN_RR 175 176#define IEEE_FMA_R(AKIND) \ 177 elemental real(AKIND) function ieee_fma_a##AKIND(a, b, c); \ 178 real(AKIND), intent(in) :: a, b, c; \ 179 end function ieee_fma_a##AKIND; 180 interface ieee_fma 181 SPECIFICS_R(IEEE_FMA_R) 182 end interface ieee_fma 183 PRIVATE_R(IEEE_FMA) 184#undef IEEE_FMA_R 185 186#define IEEE_GET_ROUNDING_MODE_I(RKIND) \ 187 subroutine ieee_get_rounding_mode_i##RKIND(round_value, radix); \ 188 import ieee_round_type; \ 189 type(ieee_round_type), intent(out) :: round_value; \ 190 integer(RKIND), intent(in) :: radix; \ 191 end subroutine ieee_get_rounding_mode_i##RKIND; 192 interface ieee_get_rounding_mode 193 subroutine ieee_get_rounding_mode(round_value) 194 import ieee_round_type 195 type(ieee_round_type), intent(out) :: round_value 196 end subroutine ieee_get_rounding_mode 197 SPECIFICS_I(IEEE_GET_ROUNDING_MODE_I) 198 end interface ieee_get_rounding_mode 199 PRIVATE_I(IEEE_GET_ROUNDING_MODE) 200#undef IEEE_GET_ROUNDING_MODE_I 201 202#define IEEE_GET_UNDERFLOW_MODE_L(GKIND) \ 203 subroutine ieee_get_underflow_mode_l##GKIND(gradual); \ 204 logical(GKIND), intent(out) :: gradual; \ 205 end subroutine ieee_get_underflow_mode_l##GKIND; 206 interface ieee_get_underflow_mode 207 SPECIFICS_L(IEEE_GET_UNDERFLOW_MODE_L) 208 end interface ieee_get_underflow_mode 209 PRIVATE_L(IEEE_GET_UNDERFLOW_MODE) 210#undef IEEE_GET_UNDERFLOW_MODE_L 211 212! When kind argument is present, kind(result) is value(kind), not kind(kind). 213! That is not known here, so return integer(16). 214#define IEEE_INT_R(AKIND) \ 215 elemental integer function ieee_int_a##AKIND(a, round); \ 216 import ieee_round_type; \ 217 real(AKIND), intent(in) :: a; \ 218 type(ieee_round_type), intent(in) :: round; \ 219 end function ieee_int_a##AKIND; 220#define IEEE_INT_RI(AKIND, KKIND) \ 221 elemental integer(16) function ieee_int_a##AKIND##_i##KKIND(a, round, kind); \ 222 import ieee_round_type; \ 223 real(AKIND), intent(in) :: a; \ 224 type(ieee_round_type), intent(in) :: round; \ 225 integer(KKIND), intent(in) :: kind; \ 226 end function ieee_int_a##AKIND##_i##KKIND; 227 interface ieee_int 228 SPECIFICS_R(IEEE_INT_R) 229 SPECIFICS_RI(IEEE_INT_RI) 230 end interface ieee_int 231 PRIVATE_R(IEEE_INT) 232 PRIVATE_RI(IEEE_INT) 233#undef IEEE_INT_R 234#undef IEEE_INT_RI 235 236#define IEEE_IS_FINITE_R(XKIND) \ 237 elemental logical function ieee_is_finite_a##XKIND(x); \ 238 real(XKIND), intent(in) :: x; \ 239 end function ieee_is_finite_a##XKIND; 240 interface ieee_is_finite 241 SPECIFICS_R(IEEE_IS_FINITE_R) 242 end interface ieee_is_finite 243 PRIVATE_R(IEEE_IS_FINITE) 244#undef IEEE_IS_FINITE_R 245 246#define IEEE_LOGB_R(XKIND) \ 247 elemental real(XKIND) function ieee_logb_a##XKIND(x); \ 248 real(XKIND), intent(in) :: x; \ 249 end function ieee_logb_a##XKIND; 250 interface ieee_logb 251 SPECIFICS_R(IEEE_LOGB_R) 252 end interface ieee_logb 253 PRIVATE_R(IEEE_LOGB) 254#undef IEEE_LOGB_R 255 256#define IEEE_MAX_NUM_R(XKIND) \ 257 elemental real(XKIND) function ieee_max_num_a##XKIND(x, y); \ 258 real(XKIND), intent(in) :: x, y; \ 259 end function ieee_max_num_a##XKIND; 260 interface ieee_max_num 261 SPECIFICS_R(IEEE_MAX_NUM_R) 262 end interface ieee_max_num 263 PRIVATE_R(IEEE_MAX_NUM) 264#undef IEEE_MAX_NUM_R 265 266#define IEEE_MAX_NUM_MAG_R(XKIND) \ 267 elemental real(XKIND) function ieee_max_num_mag_a##XKIND(x, y); \ 268 real(XKIND), intent(in) :: x, y; \ 269 end function ieee_max_num_mag_a##XKIND; 270 interface ieee_max_num_mag 271 SPECIFICS_R(IEEE_MAX_NUM_MAG_R) 272 end interface ieee_max_num_mag 273 PRIVATE_R(IEEE_MAX_NUM_MAG) 274#undef IEEE_MAX_NUM_MAG_R 275 276#define IEEE_MIN_NUM_R(XKIND) \ 277 elemental real(XKIND) function ieee_min_num_a##XKIND(x, y); \ 278 real(XKIND), intent(in) :: x, y; \ 279 end function ieee_min_num_a##XKIND; 280 interface ieee_min_num 281 SPECIFICS_R(IEEE_MIN_NUM_R) 282 end interface ieee_min_num 283 PRIVATE_R(IEEE_MIN_NUM) 284#undef IEEE_MIN_NUM_R 285 286#define IEEE_MIN_NUM_MAG_R(XKIND) \ 287 elemental real(XKIND) function ieee_min_num_mag_a##XKIND(x, y); \ 288 real(XKIND), intent(in) :: x, y; \ 289 end function ieee_min_num_mag_a##XKIND; 290 interface ieee_min_num_mag 291 SPECIFICS_R(IEEE_MIN_NUM_MAG_R) 292 end interface ieee_min_num_mag 293 PRIVATE_R(IEEE_MIN_NUM_MAG) 294#undef IEEE_MIN_NUM_MAG_R 295 296#define IEEE_QUIET_EQ_R(AKIND) \ 297 elemental logical function ieee_quiet_eq_a##AKIND(a, b); \ 298 real(AKIND), intent(in) :: a, b; \ 299 end function ieee_quiet_eq_a##AKIND; 300 interface ieee_quiet_eq 301 SPECIFICS_R(IEEE_QUIET_EQ_R) 302 end interface ieee_quiet_eq 303 PRIVATE_R(IEEE_QUIET_EQ) 304#undef IEEE_QUIET_EQ_R 305 306#define IEEE_QUIET_GE_R(AKIND) \ 307 elemental logical function ieee_quiet_ge_a##AKIND(a, b); \ 308 real(AKIND), intent(in) :: a, b; \ 309 end function ieee_quiet_ge_a##AKIND; 310 interface ieee_quiet_ge 311 SPECIFICS_R(IEEE_QUIET_GE_R) 312 end interface ieee_quiet_ge 313 PRIVATE_R(IEEE_QUIET_GE) 314#undef IEEE_QUIET_GE_R 315 316#define IEEE_QUIET_GT_R(AKIND) \ 317 elemental logical function ieee_quiet_gt_a##AKIND(a, b); \ 318 real(AKIND), intent(in) :: a, b; \ 319 end function ieee_quiet_gt_a##AKIND; 320 interface ieee_quiet_gt 321 SPECIFICS_R(IEEE_QUIET_GT_R) 322 end interface ieee_quiet_gt 323 PRIVATE_R(IEEE_QUIET_GT) 324#undef IEEE_QUIET_GT_R 325 326#define IEEE_QUIET_LE_R(AKIND) \ 327 elemental logical function ieee_quiet_le_a##AKIND(a, b); \ 328 real(AKIND), intent(in) :: a, b; \ 329 end function ieee_quiet_le_a##AKIND; 330 interface ieee_quiet_le 331 SPECIFICS_R(IEEE_QUIET_LE_R) 332 end interface ieee_quiet_le 333 PRIVATE_R(IEEE_QUIET_LE) 334#undef IEEE_QUIET_LE_R 335 336#define IEEE_QUIET_LT_R(AKIND) \ 337 elemental logical function ieee_quiet_lt_a##AKIND(a, b); \ 338 real(AKIND), intent(in) :: a, b; \ 339 end function ieee_quiet_lt_a##AKIND; 340 interface ieee_quiet_lt 341 SPECIFICS_R(IEEE_QUIET_LT_R) 342 end interface ieee_quiet_lt 343 PRIVATE_R(IEEE_QUIET_LT) 344#undef IEEE_QUIET_LT_R 345 346#define IEEE_QUIET_NE_R(AKIND) \ 347 elemental logical function ieee_quiet_ne_a##AKIND(a, b); \ 348 real(AKIND), intent(in) :: a, b; \ 349 end function ieee_quiet_ne_a##AKIND; 350 interface ieee_quiet_ne 351 SPECIFICS_R(IEEE_QUIET_NE_R) 352 end interface ieee_quiet_ne 353 PRIVATE_R(IEEE_QUIET_NE) 354#undef IEEE_QUIET_NE_R 355 356! When kind argument is present, kind(result) is value(kind), not kind(kind). 357! That is not known here, so return real(16). 358#define IEEE_REAL_I(AKIND) \ 359 elemental real function ieee_real_i##AKIND(a); \ 360 integer(AKIND), intent(in) :: a; \ 361 end function ieee_real_i##AKIND; 362#define IEEE_REAL_R(AKIND) \ 363 elemental real function ieee_real_a##AKIND(a); \ 364 real(AKIND), intent(in) :: a; \ 365 end function ieee_real_a##AKIND; 366#define IEEE_REAL_II(AKIND, KKIND) \ 367 elemental real(16) function ieee_real_i##AKIND##_i##KKIND(a, kind); \ 368 integer(AKIND), intent(in) :: a; \ 369 integer(KKIND), intent(in) :: kind; \ 370 end function ieee_real_i##AKIND##_i##KKIND; 371#define IEEE_REAL_RI(AKIND, KKIND) \ 372 elemental real(16) function ieee_real_a##AKIND##_i##KKIND(a, kind); \ 373 real(AKIND), intent(in) :: a; \ 374 integer(KKIND), intent(in) :: kind; \ 375 end function ieee_real_a##AKIND##_i##KKIND; 376 interface ieee_real 377 SPECIFICS_I(IEEE_REAL_I) 378 SPECIFICS_R(IEEE_REAL_R) 379 SPECIFICS_II(IEEE_REAL_II) 380 SPECIFICS_RI(IEEE_REAL_RI) 381 end interface ieee_real 382 PRIVATE_I(IEEE_REAL) 383 PRIVATE_R(IEEE_REAL) 384 PRIVATE_II(IEEE_REAL) 385 PRIVATE_RI(IEEE_REAL) 386#undef IEEE_REAL_I 387#undef IEEE_REAL_R 388#undef IEEE_REAL_II 389#undef IEEE_REAL_RI 390 391#define IEEE_REM_RR(XKIND, YKIND) \ 392 elemental real(XKIND) function ieee_rem_a##XKIND##_a##YKIND(x, y); \ 393 real(XKIND), intent(in) :: x; \ 394 real(YKIND), intent(in) :: y; \ 395 end function ieee_rem_a##XKIND##_a##YKIND; 396 interface ieee_rem 397 SPECIFICS_RR(IEEE_REM_RR) 398 end interface ieee_rem 399 PRIVATE_RR(IEEE_REM) 400#undef IEEE_REM_RR 401 402#define IEEE_RINT_R(XKIND) \ 403 elemental real(XKIND) function ieee_rint_a##XKIND(x, round); \ 404 import ieee_round_type; \ 405 real(XKIND), intent(in) :: x; \ 406 type(ieee_round_type), optional, intent(in) :: round; \ 407 end function ieee_rint_a##XKIND; 408 interface ieee_rint 409 SPECIFICS_R(IEEE_RINT_R) 410 end interface ieee_rint 411 PRIVATE_R(IEEE_RINT) 412#undef IEEE_RINT_R 413 414#define IEEE_SET_ROUNDING_MODE_I(RKIND) \ 415 subroutine ieee_set_rounding_mode_i##RKIND(round_value, radix); \ 416 import ieee_round_type; \ 417 type(ieee_round_type), intent(in) :: round_value; \ 418 integer(RKIND), intent(in) :: radix; \ 419 end subroutine ieee_set_rounding_mode_i##RKIND; 420 interface ieee_set_rounding_mode 421 subroutine ieee_set_rounding_mode(round_value) 422 import ieee_round_type 423 type(ieee_round_type), intent(in) :: round_value 424 end subroutine ieee_set_rounding_mode 425 SPECIFICS_I(IEEE_SET_ROUNDING_MODE_I) 426 end interface ieee_set_rounding_mode 427 PRIVATE_I(IEEE_SET_ROUNDING_MODE) 428#undef IEEE_SET_ROUNDING_MODE_I 429 430#define IEEE_SET_UNDERFLOW_MODE_L(GKIND) \ 431 subroutine ieee_set_underflow_mode_l##GKIND(gradual); \ 432 logical(GKIND), intent(in) :: gradual; \ 433 end subroutine ieee_set_underflow_mode_l##GKIND; 434 interface ieee_set_underflow_mode 435 SPECIFICS_L(IEEE_SET_UNDERFLOW_MODE_L) 436 end interface ieee_set_underflow_mode 437 PRIVATE_L(IEEE_SET_UNDERFLOW_MODE) 438#undef IEEE_SET_UNDERFLOW_MODE_L 439 440#define IEEE_SIGNALING_EQ_R(AKIND) \ 441 elemental logical function ieee_signaling_eq_a##AKIND(a, b); \ 442 real(AKIND), intent(in) :: a, b; \ 443 end function ieee_signaling_eq_a##AKIND; 444 interface ieee_signaling_eq 445 SPECIFICS_R(IEEE_SIGNALING_EQ_R) 446 end interface ieee_signaling_eq 447 PRIVATE_R(IEEE_SIGNALING_EQ) 448#undef IEEE_SIGNALING_EQ_R 449 450#define IEEE_SIGNALING_GE_R(AKIND) \ 451 elemental logical function ieee_signaling_ge_a##AKIND(a, b); \ 452 real(AKIND), intent(in) :: a, b; \ 453 end function ieee_signaling_ge_a##AKIND; 454 interface ieee_signaling_ge 455 SPECIFICS_R(IEEE_SIGNALING_GE_R) 456 end interface ieee_signaling_ge 457 PRIVATE_R(IEEE_SIGNALING_GE) 458#undef IEEE_SIGNALING_GE_R 459 460#define IEEE_SIGNALING_GT_R(AKIND) \ 461 elemental logical function ieee_signaling_gt_a##AKIND(a, b); \ 462 real(AKIND), intent(in) :: a, b; \ 463 end function ieee_signaling_gt_a##AKIND; 464 interface ieee_signaling_gt 465 SPECIFICS_R(IEEE_SIGNALING_GT_R) 466 end interface ieee_signaling_gt 467 PRIVATE_R(IEEE_SIGNALING_GT) 468#undef IEEE_SIGNALING_GT_R 469 470#define IEEE_SIGNALING_LE_R(AKIND) \ 471 elemental logical function ieee_signaling_le_a##AKIND(a, b); \ 472 real(AKIND), intent(in) :: a, b; \ 473 end function ieee_signaling_le_a##AKIND; 474 interface ieee_signaling_le 475 SPECIFICS_R(IEEE_SIGNALING_LE_R) 476 end interface ieee_signaling_le 477 PRIVATE_R(IEEE_SIGNALING_LE) 478#undef IEEE_SIGNALING_LE_R 479 480#define IEEE_SIGNALING_LT_R(AKIND) \ 481 elemental logical function ieee_signaling_lt_a##AKIND(a, b); \ 482 real(AKIND), intent(in) :: a, b; \ 483 end function ieee_signaling_lt_a##AKIND; 484 interface ieee_signaling_lt 485 SPECIFICS_R(IEEE_SIGNALING_LT_R) 486 end interface ieee_signaling_lt 487 PRIVATE_R(IEEE_SIGNALING_LT) 488#undef IEEE_SIGNALING_LT_R 489 490#define IEEE_SIGNALING_NE_R(AKIND) \ 491 elemental logical function ieee_signaling_ne_a##AKIND(a, b); \ 492 real(AKIND), intent(in) :: a, b; \ 493 end function ieee_signaling_ne_a##AKIND; 494 interface ieee_signaling_ne 495 SPECIFICS_R(IEEE_SIGNALING_NE_R) 496 end interface ieee_signaling_ne 497 PRIVATE_R(IEEE_SIGNALING_NE) 498#undef IEEE_SIGNALING_NE_R 499 500#define IEEE_SIGNBIT_R(XKIND) \ 501 elemental logical function ieee_signbit_a##XKIND(x); \ 502 real(XKIND), intent(in) :: x; \ 503 end function ieee_signbit_a##XKIND; 504 interface ieee_signbit 505 SPECIFICS_R(IEEE_SIGNBIT_R) 506 end interface ieee_signbit 507 PRIVATE_R(IEEE_SIGNBIT) 508#undef IEEE_SIGNBIT_R 509 510#define IEEE_SUPPORT_ROUNDING_R(XKIND) \ 511 pure logical function ieee_support_rounding_a##XKIND(round_value, x); \ 512 import ieee_round_type; \ 513 type(ieee_round_type), intent(in) :: round_value; \ 514 real(XKIND), intent(in) :: x(..); \ 515 end function ieee_support_rounding_a##XKIND; 516 interface ieee_support_rounding 517 pure logical function ieee_support_rounding(round_value) 518 import ieee_round_type 519 type(ieee_round_type), intent(in) :: round_value 520 end function ieee_support_rounding 521 SPECIFICS_R(IEEE_SUPPORT_ROUNDING_R) 522 end interface ieee_support_rounding 523 PRIVATE_R(IEEE_SUPPORT_ROUNDING) 524#undef IEEE_SUPPORT_ROUNDING_R 525 526#define IEEE_UNORDERED_RR(XKIND, YKIND) \ 527 elemental logical function ieee_unordered_a##XKIND##_a##YKIND(x, y); \ 528 real(XKIND), intent(in) :: x; \ 529 real(YKIND), intent(in) :: y; \ 530 end function ieee_unordered_a##XKIND##_a##YKIND; 531 interface ieee_unordered 532 SPECIFICS_RR(IEEE_UNORDERED_RR) 533 end interface ieee_unordered 534 PRIVATE_RR(IEEE_UNORDERED) 535#undef IEEE_UNORDERED_RR 536 537#define IEEE_VALUE_R(XKIND) \ 538 elemental real(XKIND) function ieee_value_a##XKIND(x, class); \ 539 import ieee_class_type; \ 540 real(XKIND), intent(in) :: x; \ 541 type(ieee_class_type), intent(in) :: class; \ 542 end function ieee_value_a##XKIND; 543 interface ieee_value 544 SPECIFICS_R(IEEE_VALUE_R) 545 end interface ieee_value 546 PRIVATE_R(IEEE_VALUE) 547#undef IEEE_VALUE_R 548 549end module ieee_arithmetic 550