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 11#include '../include/flang/Runtime/magic-numbers.h' 12 13module ieee_arithmetic 14 ! F18 Clause 17.1p1: 15 ! The module IEEE_ARITHMETIC behaves as if it contained a USE statement for 16 ! IEEE_EXCEPTIONS; everything that is public in IEEE_EXCEPTIONS is public in 17 ! IEEE_ARITHMETIC. 18 use __fortran_ieee_exceptions 19 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_up 50 51 52 implicit none 53 54 ! Set PRIVATE by default to explicitly only export what is meant 55 ! to be exported by this MODULE. 56 private 57 58 ! Explicitly export the symbols from __fortran_builtins 59 public :: ieee_away 60 public :: ieee_down 61 public :: ieee_fma 62 public :: ieee_int 63 public :: ieee_is_nan 64 public :: ieee_is_negative 65 public :: ieee_is_normal 66 public :: ieee_nearest 67 public :: ieee_other 68 public :: ieee_next_after 69 public :: ieee_next_down 70 public :: ieee_next_up 71 public :: ieee_real 72 public :: ieee_round_type 73 public :: ieee_scalb 74 public :: ieee_selected_real_kind 75 public :: ieee_support_datatype 76 public :: ieee_support_denormal 77 public :: ieee_support_divide 78 public :: ieee_support_inf 79 public :: ieee_support_io 80 public :: ieee_support_nan 81 public :: ieee_support_rounding 82 public :: ieee_support_sqrt 83 public :: ieee_support_standard 84 public :: ieee_support_subnormal 85 public :: ieee_support_underflow_control 86 public :: ieee_to_zero 87 public :: ieee_up 88 89 ! Explicitly export the symbols from __fortran_ieee_exceptions 90 public :: ieee_flag_type 91 public :: ieee_invalid 92 public :: ieee_overflow 93 public :: ieee_divide_by_zero 94 public :: ieee_underflow 95 public :: ieee_inexact 96 public :: ieee_denorm 97 public :: ieee_usual 98 public :: ieee_all 99 public :: ieee_modes_type 100 public :: ieee_status_type 101 public :: ieee_get_flag 102 public :: ieee_get_halting_mode 103 public :: ieee_get_modes 104 public :: ieee_get_status 105 public :: ieee_set_flag 106 public :: ieee_set_halting_mode 107 public :: ieee_set_modes 108 public :: ieee_set_status 109 public :: ieee_support_flag 110 public :: ieee_support_halting 111 112 type, public :: ieee_class_type 113 private 114 integer(kind=1) :: which = 0 115 end type ieee_class_type 116 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_subnormal 137 138 interface operator(==) 139 elemental logical function ieee_class_eq(x, y) 140 import ieee_class_type 141 type(ieee_class_type), intent(in) :: x, y 142 end function ieee_class_eq 143 elemental logical function ieee_round_eq(x, y) 144 import ieee_round_type 145 type(ieee_round_type), intent(in) :: x, y 146 end function ieee_round_eq 147 end interface operator(==) 148 public :: operator(==) 149 150 interface operator(/=) 151 elemental logical function ieee_class_ne(x, y) 152 import ieee_class_type 153 type(ieee_class_type), intent(in) :: x, y 154 end function ieee_class_ne 155 elemental logical function ieee_round_ne(x, y) 156 import ieee_round_type 157 type(ieee_round_type), intent(in) :: x, y 158 end function ieee_round_ne 159 end interface operator(/=) 160 public :: operator(/=) 161 162! Define specifics with 1 or 2 INTEGER, LOGICAL, or REAL arguments for 163! generic G. 164! 165! The result type of most function specifics is either a fixed type or 166! the type of the first argument. The result type of a SPECIFICS_rRR 167! 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_R16 175#if __x86_64__ 176#define SPECIFICS_R(G) \ 177 G(2) G(3) G(4) G(8) G(10) G(16) 178#else 179#define SPECIFICS_R(G) \ 180 G(2) G(3) G(4) G(8) G(16) 181#endif 182#else 183#if __x86_64__ 184#define SPECIFICS_R(G) \ 185 G(2) G(3) G(4) G(8) G(10) 186#else 187#define SPECIFICS_R(G) \ 188 G(2) G(3) G(4) G(8) 189#endif 190#endif 191 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_R16 200#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#else 209#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#endif 216#else 217#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#else 225#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#endif 231#endif 232 233#if FLANG_SUPPORT_R16 234#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#else 250#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#endif 263#else 264#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#else 278#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#endif 289#endif 290 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_class 297 SPECIFICS_R(IEEE_CLASS_R) 298 end interface ieee_class 299 public :: ieee_class 300#undef IEEE_CLASS_R 301 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_sign 308 SPECIFICS_RR(IEEE_COPY_SIGN_RR) 309 end interface ieee_copy_sign 310 public :: ieee_copy_sign 311#undef IEEE_COPY_SIGN_RR 312 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_mode 320 subroutine ieee_get_rounding_mode_0(round_value) 321 import ieee_round_type 322 type(ieee_round_type), intent(out) :: round_value 323 end subroutine ieee_get_rounding_mode_0 324 SPECIFICS_I(IEEE_GET_ROUNDING_MODE_I) 325 end interface ieee_get_rounding_mode 326 public :: ieee_get_rounding_mode 327#undef IEEE_GET_ROUNDING_MODE_I 328 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_mode 334 SPECIFICS_L(IEEE_GET_UNDERFLOW_MODE_L) 335 end interface ieee_get_underflow_mode 336 public :: ieee_get_underflow_mode 337#undef IEEE_GET_UNDERFLOW_MODE_L 338 339#define IEEE_IS_FINITE_R(XKIND) \ 340 elemental logical function ieee_is_finite_a##XKIND(x); \ 341 real(XKIND), intent(in) :: x; \ 342 end function ieee_is_finite_a##XKIND; 343 interface ieee_is_finite 344 SPECIFICS_R(IEEE_IS_FINITE_R) 345 end interface ieee_is_finite 346 public :: ieee_is_finite 347#undef IEEE_IS_FINITE_R 348 349#define IEEE_LOGB_R(XKIND) \ 350 elemental real(XKIND) function ieee_logb_a##XKIND(x); \ 351 real(XKIND), intent(in) :: x; \ 352 end function ieee_logb_a##XKIND; 353 interface ieee_logb 354 SPECIFICS_R(IEEE_LOGB_R) 355 end interface ieee_logb 356 public :: ieee_logb 357#undef IEEE_LOGB_R 358 359#define IEEE_MAX_R(XKIND) \ 360 elemental real(XKIND) function ieee_max_a##XKIND(x, y); \ 361 real(XKIND), intent(in) :: x, y; \ 362 end function ieee_max_a##XKIND; 363 interface ieee_max 364 SPECIFICS_R(IEEE_MAX_R) 365 end interface ieee_max 366 public :: ieee_max 367#undef IEEE_MAX_R 368 369#define IEEE_MAX_MAG_R(XKIND) \ 370 elemental real(XKIND) function ieee_max_mag_a##XKIND(x, y); \ 371 real(XKIND), intent(in) :: x, y; \ 372 end function ieee_max_mag_a##XKIND; 373 interface ieee_max_mag 374 SPECIFICS_R(IEEE_MAX_MAG_R) 375 end interface ieee_max_mag 376 public :: ieee_max_mag 377#undef IEEE_MAX_MAG_R 378 379#define IEEE_MAX_NUM_R(XKIND) \ 380 elemental real(XKIND) function ieee_max_num_a##XKIND(x, y); \ 381 real(XKIND), intent(in) :: x, y; \ 382 end function ieee_max_num_a##XKIND; 383 interface ieee_max_num 384 SPECIFICS_R(IEEE_MAX_NUM_R) 385 end interface ieee_max_num 386 public :: ieee_max_num 387#undef IEEE_MAX_NUM_R 388 389#define IEEE_MAX_NUM_MAG_R(XKIND) \ 390 elemental real(XKIND) function ieee_max_num_mag_a##XKIND(x, y); \ 391 real(XKIND), intent(in) :: x, y; \ 392 end function ieee_max_num_mag_a##XKIND; 393 interface ieee_max_num_mag 394 SPECIFICS_R(IEEE_MAX_NUM_MAG_R) 395 end interface ieee_max_num_mag 396 public :: ieee_max_num_mag 397#undef IEEE_MAX_NUM_MAG_R 398 399#define IEEE_MIN_R(XKIND) \ 400 elemental real(XKIND) function ieee_min_a##XKIND(x, y); \ 401 real(XKIND), intent(in) :: x, y; \ 402 end function ieee_min_a##XKIND; 403 interface ieee_min 404 SPECIFICS_R(IEEE_MIN_R) 405 end interface ieee_min 406 public :: ieee_min 407#undef IEEE_MIN_R 408 409#define IEEE_MIN_MAG_R(XKIND) \ 410 elemental real(XKIND) function ieee_min_mag_a##XKIND(x, y); \ 411 real(XKIND), intent(in) :: x, y; \ 412 end function ieee_min_mag_a##XKIND; 413 interface ieee_min_mag 414 SPECIFICS_R(IEEE_MIN_MAG_R) 415 end interface ieee_min_mag 416 public :: ieee_min_mag 417#undef IEEE_MIN_MAG_R 418 419#define IEEE_MIN_NUM_R(XKIND) \ 420 elemental real(XKIND) function ieee_min_num_a##XKIND(x, y); \ 421 real(XKIND), intent(in) :: x, y; \ 422 end function ieee_min_num_a##XKIND; 423 interface ieee_min_num 424 SPECIFICS_R(IEEE_MIN_NUM_R) 425 end interface ieee_min_num 426 public :: ieee_min_num 427#undef IEEE_MIN_NUM_R 428 429#define IEEE_MIN_NUM_MAG_R(XKIND) \ 430 elemental real(XKIND) function ieee_min_num_mag_a##XKIND(x, y); \ 431 real(XKIND), intent(in) :: x, y; \ 432 end function ieee_min_num_mag_a##XKIND; 433 interface ieee_min_num_mag 434 SPECIFICS_R(IEEE_MIN_NUM_MAG_R) 435 end interface ieee_min_num_mag 436 public ::ieee_min_num_mag 437#undef IEEE_MIN_NUM_MAG_R 438 439#define IEEE_QUIET_EQ_R(AKIND) \ 440 elemental logical function ieee_quiet_eq_a##AKIND(a, b); \ 441 real(AKIND), intent(in) :: a, b; \ 442 end function ieee_quiet_eq_a##AKIND; 443 interface ieee_quiet_eq 444 SPECIFICS_R(IEEE_QUIET_EQ_R) 445 end interface ieee_quiet_eq 446 public :: ieee_quiet_eq 447#undef IEEE_QUIET_EQ_R 448 449#define IEEE_QUIET_GE_R(AKIND) \ 450 elemental logical function ieee_quiet_ge_a##AKIND(a, b); \ 451 real(AKIND), intent(in) :: a, b; \ 452 end function ieee_quiet_ge_a##AKIND; 453 interface ieee_quiet_ge 454 SPECIFICS_R(IEEE_QUIET_GE_R) 455 end interface ieee_quiet_ge 456 public :: ieee_quiet_ge 457#undef IEEE_QUIET_GE_R 458 459#define IEEE_QUIET_GT_R(AKIND) \ 460 elemental logical function ieee_quiet_gt_a##AKIND(a, b); \ 461 real(AKIND), intent(in) :: a, b; \ 462 end function ieee_quiet_gt_a##AKIND; 463 interface ieee_quiet_gt 464 SPECIFICS_R(IEEE_QUIET_GT_R) 465 end interface ieee_quiet_gt 466 public :: ieee_quiet_gt 467#undef IEEE_QUIET_GT_R 468 469#define IEEE_QUIET_LE_R(AKIND) \ 470 elemental logical function ieee_quiet_le_a##AKIND(a, b); \ 471 real(AKIND), intent(in) :: a, b; \ 472 end function ieee_quiet_le_a##AKIND; 473 interface ieee_quiet_le 474 SPECIFICS_R(IEEE_QUIET_LE_R) 475 end interface ieee_quiet_le 476 public :: ieee_quiet_le 477#undef IEEE_QUIET_LE_R 478 479#define IEEE_QUIET_LT_R(AKIND) \ 480 elemental logical function ieee_quiet_lt_a##AKIND(a, b); \ 481 real(AKIND), intent(in) :: a, b; \ 482 end function ieee_quiet_lt_a##AKIND; 483 interface ieee_quiet_lt 484 SPECIFICS_R(IEEE_QUIET_LT_R) 485 end interface ieee_quiet_lt 486 public :: ieee_quiet_lt 487#undef IEEE_QUIET_LT_R 488 489#define IEEE_QUIET_NE_R(AKIND) \ 490 elemental logical function ieee_quiet_ne_a##AKIND(a, b); \ 491 real(AKIND), intent(in) :: a, b; \ 492 end function ieee_quiet_ne_a##AKIND; 493 interface ieee_quiet_ne 494 SPECIFICS_R(IEEE_QUIET_NE_R) 495 end interface ieee_quiet_ne 496 public :: ieee_quiet_ne 497#undef IEEE_QUIET_NE_R 498 499#define IEEE_REM_rRR(RKIND, XKIND, YKIND) \ 500 elemental real(RKIND) function ieee_rem_a##XKIND##_a##YKIND(x, y); \ 501 real(XKIND), intent(in) :: x; \ 502 real(YKIND), intent(in) :: y; \ 503 end function ieee_rem_a##XKIND##_a##YKIND; 504 interface ieee_rem 505 SPECIFICS_rRR(IEEE_REM_rRR) 506 end interface ieee_rem 507 public :: ieee_rem 508#undef IEEE_REM_rRR 509 510#define IEEE_RINT_R(XKIND) \ 511 elemental real(XKIND) function ieee_rint_a##XKIND(x, round); \ 512 import ieee_round_type; \ 513 real(XKIND), intent(in) :: x; \ 514 type(ieee_round_type), optional, intent(in) :: round; \ 515 end function ieee_rint_a##XKIND; 516 interface ieee_rint 517 SPECIFICS_R(IEEE_RINT_R) 518 end interface ieee_rint 519 public :: ieee_rint 520#undef IEEE_RINT_R 521 522#define IEEE_SET_ROUNDING_MODE_I(RKIND) \ 523 subroutine ieee_set_rounding_mode_i##RKIND(round_value, radix); \ 524 import ieee_round_type; \ 525 type(ieee_round_type), intent(in) :: round_value; \ 526 integer(RKIND), intent(in) :: radix; \ 527 end subroutine ieee_set_rounding_mode_i##RKIND; 528 interface ieee_set_rounding_mode 529 subroutine ieee_set_rounding_mode_0(round_value) 530 import ieee_round_type 531 type(ieee_round_type), intent(in) :: round_value 532 end subroutine ieee_set_rounding_mode_0 533 SPECIFICS_I(IEEE_SET_ROUNDING_MODE_I) 534 end interface ieee_set_rounding_mode 535 public :: ieee_set_rounding_mode 536#undef IEEE_SET_ROUNDING_MODE_I 537 538#define IEEE_SET_UNDERFLOW_MODE_L(GKIND) \ 539 subroutine ieee_set_underflow_mode_l##GKIND(gradual); \ 540 logical(GKIND), intent(in) :: gradual; \ 541 end subroutine ieee_set_underflow_mode_l##GKIND; 542 interface ieee_set_underflow_mode 543 SPECIFICS_L(IEEE_SET_UNDERFLOW_MODE_L) 544 end interface ieee_set_underflow_mode 545 public :: ieee_set_underflow_mode 546#undef IEEE_SET_UNDERFLOW_MODE_L 547 548#define IEEE_SIGNALING_EQ_R(AKIND) \ 549 elemental logical function ieee_signaling_eq_a##AKIND(a, b); \ 550 real(AKIND), intent(in) :: a, b; \ 551 end function ieee_signaling_eq_a##AKIND; 552 interface ieee_signaling_eq 553 SPECIFICS_R(IEEE_SIGNALING_EQ_R) 554 end interface ieee_signaling_eq 555 public :: ieee_signaling_eq 556#undef IEEE_SIGNALING_EQ_R 557 558#define IEEE_SIGNALING_GE_R(AKIND) \ 559 elemental logical function ieee_signaling_ge_a##AKIND(a, b); \ 560 real(AKIND), intent(in) :: a, b; \ 561 end function ieee_signaling_ge_a##AKIND; 562 interface ieee_signaling_ge 563 SPECIFICS_R(IEEE_SIGNALING_GE_R) 564 end interface ieee_signaling_ge 565 public :: ieee_signaling_ge 566#undef IEEE_SIGNALING_GE_R 567 568#define IEEE_SIGNALING_GT_R(AKIND) \ 569 elemental logical function ieee_signaling_gt_a##AKIND(a, b); \ 570 real(AKIND), intent(in) :: a, b; \ 571 end function ieee_signaling_gt_a##AKIND; 572 interface ieee_signaling_gt 573 SPECIFICS_R(IEEE_SIGNALING_GT_R) 574 end interface ieee_signaling_gt 575 public :: ieee_signaling_gt 576#undef IEEE_SIGNALING_GT_R 577 578#define IEEE_SIGNALING_LE_R(AKIND) \ 579 elemental logical function ieee_signaling_le_a##AKIND(a, b); \ 580 real(AKIND), intent(in) :: a, b; \ 581 end function ieee_signaling_le_a##AKIND; 582 interface ieee_signaling_le 583 SPECIFICS_R(IEEE_SIGNALING_LE_R) 584 end interface ieee_signaling_le 585 public :: ieee_signaling_le 586#undef IEEE_SIGNALING_LE_R 587 588#define IEEE_SIGNALING_LT_R(AKIND) \ 589 elemental logical function ieee_signaling_lt_a##AKIND(a, b); \ 590 real(AKIND), intent(in) :: a, b; \ 591 end function ieee_signaling_lt_a##AKIND; 592 interface ieee_signaling_lt 593 SPECIFICS_R(IEEE_SIGNALING_LT_R) 594 end interface ieee_signaling_lt 595 public :: ieee_signaling_lt 596#undef IEEE_SIGNALING_LT_R 597 598#define IEEE_SIGNALING_NE_R(AKIND) \ 599 elemental logical function ieee_signaling_ne_a##AKIND(a, b); \ 600 real(AKIND), intent(in) :: a, b; \ 601 end function ieee_signaling_ne_a##AKIND; 602 interface ieee_signaling_ne 603 SPECIFICS_R(IEEE_SIGNALING_NE_R) 604 end interface ieee_signaling_ne 605 public :: ieee_signaling_ne 606#undef IEEE_SIGNALING_NE_R 607 608#define IEEE_SIGNBIT_R(XKIND) \ 609 elemental logical function ieee_signbit_a##XKIND(x); \ 610 real(XKIND), intent(in) :: x; \ 611 end function ieee_signbit_a##XKIND; 612 interface ieee_signbit 613 SPECIFICS_R(IEEE_SIGNBIT_R) 614 end interface ieee_signbit 615 public :: ieee_signbit 616#undef IEEE_SIGNBIT_R 617 618#define IEEE_UNORDERED_RR(XKIND, YKIND) \ 619 elemental logical function ieee_unordered_a##XKIND##_a##YKIND(x, y); \ 620 real(XKIND), intent(in) :: x; \ 621 real(YKIND), intent(in) :: y; \ 622 end function ieee_unordered_a##XKIND##_a##YKIND; 623 interface ieee_unordered 624 SPECIFICS_RR(IEEE_UNORDERED_RR) 625 end interface ieee_unordered 626 public :: ieee_unordered 627#undef IEEE_UNORDERED_RR 628 629#define IEEE_VALUE_R(XKIND) \ 630 elemental real(XKIND) function ieee_value_a##XKIND(x, class); \ 631 import ieee_class_type; \ 632 real(XKIND), intent(in) :: x; \ 633 type(ieee_class_type), intent(in) :: class; \ 634 end function ieee_value_a##XKIND; 635 interface ieee_value 636 SPECIFICS_R(IEEE_VALUE_R) 637 end interface ieee_value 638 public :: ieee_value 639#undef IEEE_VALUE_R 640 641end module ieee_arithmetic 642