flang/module/ieee_arithmetic.f90

   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
  13 module 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_is_nan => __builtin_ieee_is_nan, &
  25     ieee_is_negative => __builtin_ieee_is_negative, &
  26     ieee_is_normal => __builtin_ieee_is_normal, &
  27     ieee_nearest => __builtin_ieee_nearest, &
  28     ieee_next_after => __builtin_ieee_next_after, &
  29     ieee_next_down => __builtin_ieee_next_down, &
  30     ieee_next_up => __builtin_ieee_next_up, &
  31     ieee_other => __builtin_ieee_other, &
  32     ieee_round_type => __builtin_ieee_round_type, &
  33     ieee_scalb => scale, &
  34     ieee_selected_real_kind => __builtin_ieee_selected_real_kind, &
  35     ieee_support_datatype => __builtin_ieee_support_datatype, &
  36     ieee_support_denormal => __builtin_ieee_support_denormal, &
  37     ieee_support_divide => __builtin_ieee_support_divide, &
  38     ieee_support_inf => __builtin_ieee_support_inf, &
  39     ieee_support_io => __builtin_ieee_support_io, &
  40     ieee_support_nan => __builtin_ieee_support_nan, &
  41     ieee_support_rounding => __builtin_ieee_support_rounding, &
  42     ieee_support_sqrt => __builtin_ieee_support_sqrt, &
  43     ieee_support_standard => __builtin_ieee_support_standard, &
  44     ieee_support_subnormal => __builtin_ieee_support_subnormal, &
  45     ieee_support_underflow_control => __builtin_ieee_support_underflow_control, &
  46     ieee_to_zero => __builtin_ieee_to_zero, &
  47     ieee_up => __builtin_ieee_up
  48
  49
  50   implicit none
  51
  52   ! Set PRIVATE by default to explicitly only export what is meant
  53   ! to be exported by this MODULE.
  54   private
  55
  56   ! Explicitly export the symbols from __fortran_builtins
  57   public :: ieee_away
  58   public :: ieee_down
  59   public :: ieee_fma
  60   public :: ieee_is_nan
  61   public :: ieee_is_negative
  62   public :: ieee_is_normal
  63   public :: ieee_nearest
  64   public :: ieee_other
  65   public :: ieee_next_after
  66   public :: ieee_next_down
  67   public :: ieee_next_up
  68   public :: ieee_round_type
  69   public :: ieee_scalb
  70   public :: ieee_selected_real_kind
  71   public :: ieee_support_datatype
  72   public :: ieee_support_denormal
  73   public :: ieee_support_divide
  74   public :: ieee_support_inf
  75   public :: ieee_support_io
  76   public :: ieee_support_nan
  77   public :: ieee_support_rounding
  78   public :: ieee_support_sqrt
  79   public :: ieee_support_standard
  80   public :: ieee_support_subnormal
  81   public :: ieee_support_underflow_control
  82   public :: ieee_to_zero
  83   public :: ieee_up
  84
  85   ! Explicitly export the symbols from __fortran_ieee_exceptions
  86   public :: ieee_flag_type
  87   public :: ieee_invalid
  88   public :: ieee_overflow
  89   public :: ieee_divide_by_zero
  90   public :: ieee_underflow
  91   public :: ieee_inexact
  92   public :: ieee_denorm
  93   public :: ieee_usual
  94   public :: ieee_all
  95   public :: ieee_modes_type
  96   public :: ieee_status_type
  97   public :: ieee_get_flag
  98   public :: ieee_get_halting_mode
  99   public :: ieee_get_modes
 100   public :: ieee_get_status
 101   public :: ieee_set_flag
 102   public :: ieee_set_halting_mode
 103   public :: ieee_set_modes
 104   public :: ieee_set_status
 105   public :: ieee_support_flag
 106   public :: ieee_support_halting
 107
 108   type, public :: ieee_class_type
 109     private
 110     integer(kind=1) :: which = 0
 111   end type ieee_class_type
 112
 113   type(ieee_class_type), parameter, public :: &
 114     ieee_signaling_nan = ieee_class_type(_FORTRAN_RUNTIME_IEEE_SIGNALING_NAN), &
 115     ieee_quiet_nan = ieee_class_type(_FORTRAN_RUNTIME_IEEE_QUIET_NAN), &
 116     ieee_negative_inf = ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_INF), &
 117     ieee_negative_normal = &
 118         ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL), &
 119     ieee_negative_subnormal = &
 120         ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL), &
 121     ieee_negative_zero = ieee_class_type(_FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO), &
 122     ieee_positive_zero = ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO), &
 123     ieee_positive_subnormal = &
 124          ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL), &
 125     ieee_positive_normal = &
 126         ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL), &
 127     ieee_positive_inf = ieee_class_type(_FORTRAN_RUNTIME_IEEE_POSITIVE_INF), &
 128     ieee_other_value = ieee_class_type(_FORTRAN_RUNTIME_IEEE_OTHER_VALUE)
 129
 130   type(ieee_class_type), parameter, public :: &
 131     ieee_negative_denormal = ieee_negative_subnormal, &
 132     ieee_positive_denormal = ieee_positive_subnormal
 133
 134   interface operator(==)
 135     elemental logical function ieee_class_eq(x, y)
 136       import ieee_class_type
 137       type(ieee_class_type), intent(in) :: x, y
 138     end function ieee_class_eq
 139     elemental logical function ieee_round_eq(x, y)
 140       import ieee_round_type
 141       type(ieee_round_type), intent(in) :: x, y
 142     end function ieee_round_eq
 143   end interface operator(==)
 144   public :: operator(==)
 145
 146   interface operator(/=)
 147     elemental logical function ieee_class_ne(x, y)
 148       import ieee_class_type
 149       type(ieee_class_type), intent(in) :: x, y
 150     end function ieee_class_ne
 151     elemental logical function ieee_round_ne(x, y)
 152       import ieee_round_type
 153       type(ieee_round_type), intent(in) :: x, y
 154     end function ieee_round_ne
 155   end interface operator(/=)
 156   public :: operator(/=)
 157
 158 ! Define specifics with 1 or 2 INTEGER, LOGICAL, or REAL arguments for
 159 ! generic G.
 160 #define SPECIFICS_I(G) \
 161   G(1) G(2) G(4) G(8) G(16)
 162 #define SPECIFICS_L(G) \
 163   G(1) G(2) G(4) G(8)
 164 #if __x86_64__
 165 #define SPECIFICS_R(G) \
 166   G(2) G(3) G(4) G(8) G(10) G(16)
 167 #else
 168 #define SPECIFICS_R(G) \
 169   G(2) G(3) G(4) G(8) G(16)
 170 #endif
 171 #define SPECIFICS_II(G) \
 172   G(1,1) G(1,2) G(1,4) G(1,8) G(1,16) \
 173   G(2,1) G(2,2) G(2,4) G(2,8) G(2,16) \
 174   G(4,1) G(4,2) G(4,4) G(4,8) G(4,16) \
 175   G(8,1) G(8,2) G(8,4) G(8,8) G(8,16) \
 176   G(16,1) G(16,2) G(16,4) G(16,8) G(16,16)
 177 #if __x86_64__
 178 #define SPECIFICS_RI(G) \
 179   G(2,1) G(2,2) G(2,4) G(2,8) G(2,16) \
 180   G(3,1) G(3,2) G(3,4) G(3,8) G(3,16) \
 181   G(4,1) G(4,2) G(4,4) G(4,8) G(4,16) \
 182   G(8,1) G(8,2) G(8,4) G(8,8) G(8,16) \
 183   G(10,1) G(10,2) G(10,4) G(10,8) G(10,16) \
 184   G(16,1) G(16,2) G(16,4) G(16,8) G(16,16)
 185 #else
 186 #define SPECIFICS_RI(G) \
 187   G(2,1) G(2,2) G(2,4) G(2,8) G(2,16) \
 188   G(3,1) G(3,2) G(3,4) G(3,8) G(3,16) \
 189   G(4,1) G(4,2) G(4,4) G(4,8) G(4,16) \
 190   G(8,1) G(8,2) G(8,4) G(8,8) G(8,16) \
 191   G(16,1) G(16,2) G(16,4) G(16,8) G(16,16)
 192 #endif
 193
 194 #if __x86_64__
 195 #define SPECIFICS_RR(G) \
 196   G(2,2) G(2,3) G(2,4) G(2,8) G(2,10) G(2,16) \
 197   G(3,2) G(3,3) G(3,4) G(3,8) G(3,10) G(3,16) \
 198   G(4,2) G(4,3) G(4,4) G(4,8) G(4,10) G(4,16) \
 199   G(8,2) G(8,3) G(8,4) G(8,8) G(8,10) G(8,16) \
 200   G(10,2) G(10,3) G(10,4) G(10,8) G(10,10) G(10,16) \
 201   G(16,2) G(16,3) G(16,4) G(16,8) G(16,10) G(16,16)
 202 #else
 203 #define SPECIFICS_RR(G) \
 204   G(2,2) G(2,3) G(2,4) G(2,8) G(2,16) \
 205   G(3,2) G(3,3) G(3,4) G(3,8) G(3,16) \
 206   G(4,2) G(4,3) G(4,4) G(4,8) G(4,16) \
 207   G(8,2) G(8,3) G(8,4) G(8,8) G(8,16) \
 208   G(16,2) G(16,3) G(16,4) G(16,8) G(16,16)
 209 #endif
 210
 211 #define IEEE_CLASS_R(XKIND) \
 212   elemental type(ieee_class_type) function ieee_class_a##XKIND(x); \
 213     import ieee_class_type; \
 214     real(XKIND), intent(in) :: x; \
 215   end function ieee_class_a##XKIND;
 216   interface ieee_class
 217     SPECIFICS_R(IEEE_CLASS_R)
 218   end interface ieee_class
 219   public :: ieee_class
 220 #undef IEEE_CLASS_R
 221
 222 #define IEEE_COPY_SIGN_RR(XKIND, YKIND) \
 223   elemental real(XKIND) function ieee_copy_sign_a##XKIND##_a##YKIND(x, y); \
 224     real(XKIND), intent(in) :: x; \
 225     real(YKIND), intent(in) :: y; \
 226   end function ieee_copy_sign_a##XKIND##_a##YKIND;
 227   interface ieee_copy_sign
 228     SPECIFICS_RR(IEEE_COPY_SIGN_RR)
 229   end interface ieee_copy_sign
 230   public :: ieee_copy_sign
 231 #undef IEEE_COPY_SIGN_RR
 232
 233 #define IEEE_GET_ROUNDING_MODE_I(RKIND) \
 234   subroutine ieee_get_rounding_mode_i##RKIND(round_value, radix); \
 235     import ieee_round_type; \
 236     type(ieee_round_type), intent(out) :: round_value; \
 237     integer(RKIND), intent(in) :: radix; \
 238   end subroutine ieee_get_rounding_mode_i##RKIND;
 239   interface ieee_get_rounding_mode
 240     subroutine ieee_get_rounding_mode_0(round_value)
 241       import ieee_round_type
 242       type(ieee_round_type), intent(out) :: round_value
 243     end subroutine ieee_get_rounding_mode_0
 244     SPECIFICS_I(IEEE_GET_ROUNDING_MODE_I)
 245   end interface ieee_get_rounding_mode
 246   public :: ieee_get_rounding_mode
 247 #undef IEEE_GET_ROUNDING_MODE_I
 248
 249 #define IEEE_GET_UNDERFLOW_MODE_L(GKIND) \
 250   subroutine ieee_get_underflow_mode_l##GKIND(gradual); \
 251     logical(GKIND), intent(out) :: gradual; \
 252   end subroutine ieee_get_underflow_mode_l##GKIND;
 253   interface ieee_get_underflow_mode
 254     SPECIFICS_L(IEEE_GET_UNDERFLOW_MODE_L)
 255   end interface ieee_get_underflow_mode
 256   public ::  ieee_get_underflow_mode
 257 #undef IEEE_GET_UNDERFLOW_MODE_L
 258
 259 ! When kind argument is present, kind(result) is value(kind), not kind(kind).
 260 ! That is not known here, so return integer(16).
 261 #define IEEE_INT_R(AKIND) \
 262   elemental integer function ieee_int_a##AKIND(a, round); \
 263     import ieee_round_type; \
 264     real(AKIND), intent(in) :: a; \
 265     type(ieee_round_type), intent(in) :: round; \
 266   end function ieee_int_a##AKIND;
 267 #define IEEE_INT_RI(AKIND, KKIND) \
 268   elemental integer(16) function ieee_int_a##AKIND##_i##KKIND(a, round, kind); \
 269     import ieee_round_type; \
 270     real(AKIND), intent(in) :: a; \
 271     type(ieee_round_type), intent(in) :: round; \
 272     integer(KKIND), intent(in) :: kind; \
 273   end function ieee_int_a##AKIND##_i##KKIND;
 274   interface ieee_int
 275     SPECIFICS_R(IEEE_INT_R)
 276     SPECIFICS_RI(IEEE_INT_RI)
 277   end interface ieee_int
 278   public :: ieee_int
 279 #undef IEEE_INT_R
 280 #undef IEEE_INT_RI
 281
 282 #define IEEE_IS_FINITE_R(XKIND) \
 283   elemental logical function ieee_is_finite_a##XKIND(x); \
 284     real(XKIND), intent(in) :: x; \
 285   end function ieee_is_finite_a##XKIND;
 286   interface ieee_is_finite
 287     SPECIFICS_R(IEEE_IS_FINITE_R)
 288   end interface ieee_is_finite
 289   public :: ieee_is_finite
 290 #undef IEEE_IS_FINITE_R
 291
 292 #define IEEE_LOGB_R(XKIND) \
 293   elemental real(XKIND) function ieee_logb_a##XKIND(x); \
 294     real(XKIND), intent(in) :: x; \
 295   end function ieee_logb_a##XKIND;
 296   interface ieee_logb
 297     SPECIFICS_R(IEEE_LOGB_R)
 298   end interface ieee_logb
 299   public :: ieee_logb
 300 #undef IEEE_LOGB_R
 301
 302 #define IEEE_MAX_R(XKIND) \
 303   elemental real(XKIND) function ieee_max_a##XKIND(x, y); \
 304     real(XKIND), intent(in) :: x, y; \
 305   end function ieee_max_a##XKIND;
 306   interface ieee_max
 307     SPECIFICS_R(IEEE_MAX_R)
 308   end interface ieee_max
 309   public :: ieee_max
 310 #undef IEEE_MAX_R
 311
 312 #define IEEE_MAX_MAG_R(XKIND) \
 313   elemental real(XKIND) function ieee_max_mag_a##XKIND(x, y); \
 314     real(XKIND), intent(in) :: x, y; \
 315   end function ieee_max_mag_a##XKIND;
 316   interface ieee_max_mag
 317     SPECIFICS_R(IEEE_MAX_MAG_R)
 318   end interface ieee_max_mag
 319   public :: ieee_max_mag
 320 #undef IEEE_MAX_MAG_R
 321
 322 #define IEEE_MAX_NUM_R(XKIND) \
 323   elemental real(XKIND) function ieee_max_num_a##XKIND(x, y); \
 324     real(XKIND), intent(in) :: x, y; \
 325   end function ieee_max_num_a##XKIND;
 326   interface ieee_max_num
 327     SPECIFICS_R(IEEE_MAX_NUM_R)
 328   end interface ieee_max_num
 329   public :: ieee_max_num
 330 #undef IEEE_MAX_NUM_R
 331
 332 #define IEEE_MAX_NUM_MAG_R(XKIND) \
 333   elemental real(XKIND) function ieee_max_num_mag_a##XKIND(x, y); \
 334     real(XKIND), intent(in) :: x, y; \
 335   end function ieee_max_num_mag_a##XKIND;
 336   interface ieee_max_num_mag
 337     SPECIFICS_R(IEEE_MAX_NUM_MAG_R)
 338   end interface ieee_max_num_mag
 339   public :: ieee_max_num_mag
 340 #undef IEEE_MAX_NUM_MAG_R
 341
 342 #define IEEE_MIN_R(XKIND) \
 343   elemental real(XKIND) function ieee_min_a##XKIND(x, y); \
 344     real(XKIND), intent(in) :: x, y; \
 345   end function ieee_min_a##XKIND;
 346   interface ieee_min
 347     SPECIFICS_R(IEEE_MIN_R)
 348   end interface ieee_min
 349   public :: ieee_min
 350 #undef IEEE_MIN_R
 351
 352 #define IEEE_MIN_MAG_R(XKIND) \
 353   elemental real(XKIND) function ieee_min_mag_a##XKIND(x, y); \
 354     real(XKIND), intent(in) :: x, y; \
 355   end function ieee_min_mag_a##XKIND;
 356   interface ieee_min_mag
 357     SPECIFICS_R(IEEE_MIN_MAG_R)
 358   end interface ieee_min_mag
 359   public :: ieee_min_mag
 360 #undef IEEE_MIN_MAG_R
 361
 362 #define IEEE_MIN_NUM_R(XKIND) \
 363   elemental real(XKIND) function ieee_min_num_a##XKIND(x, y); \
 364     real(XKIND), intent(in) :: x, y; \
 365   end function ieee_min_num_a##XKIND;
 366   interface ieee_min_num
 367     SPECIFICS_R(IEEE_MIN_NUM_R)
 368   end interface ieee_min_num
 369   public :: ieee_min_num
 370 #undef IEEE_MIN_NUM_R
 371
 372 #define IEEE_MIN_NUM_MAG_R(XKIND) \
 373   elemental real(XKIND) function ieee_min_num_mag_a##XKIND(x, y); \
 374     real(XKIND), intent(in) :: x, y; \
 375   end function ieee_min_num_mag_a##XKIND;
 376   interface ieee_min_num_mag
 377     SPECIFICS_R(IEEE_MIN_NUM_MAG_R)
 378   end interface ieee_min_num_mag
 379   public ::ieee_min_num_mag
 380 #undef IEEE_MIN_NUM_MAG_R
 381
 382 #define IEEE_QUIET_EQ_R(AKIND) \
 383   elemental logical function ieee_quiet_eq_a##AKIND(a, b); \
 384     real(AKIND), intent(in) :: a, b; \
 385   end function ieee_quiet_eq_a##AKIND;
 386   interface ieee_quiet_eq
 387     SPECIFICS_R(IEEE_QUIET_EQ_R)
 388   end interface ieee_quiet_eq
 389   public :: ieee_quiet_eq
 390 #undef IEEE_QUIET_EQ_R
 391
 392 #define IEEE_QUIET_GE_R(AKIND) \
 393   elemental logical function ieee_quiet_ge_a##AKIND(a, b); \
 394     real(AKIND), intent(in) :: a, b; \
 395   end function ieee_quiet_ge_a##AKIND;
 396   interface ieee_quiet_ge
 397     SPECIFICS_R(IEEE_QUIET_GE_R)
 398   end interface ieee_quiet_ge
 399   public :: ieee_quiet_ge
 400 #undef IEEE_QUIET_GE_R
 401
 402 #define IEEE_QUIET_GT_R(AKIND) \
 403   elemental logical function ieee_quiet_gt_a##AKIND(a, b); \
 404     real(AKIND), intent(in) :: a, b; \
 405   end function ieee_quiet_gt_a##AKIND;
 406   interface ieee_quiet_gt
 407     SPECIFICS_R(IEEE_QUIET_GT_R)
 408   end interface ieee_quiet_gt
 409   public :: ieee_quiet_gt
 410 #undef IEEE_QUIET_GT_R
 411
 412 #define IEEE_QUIET_LE_R(AKIND) \
 413   elemental logical function ieee_quiet_le_a##AKIND(a, b); \
 414     real(AKIND), intent(in) :: a, b; \
 415   end function ieee_quiet_le_a##AKIND;
 416   interface ieee_quiet_le
 417     SPECIFICS_R(IEEE_QUIET_LE_R)
 418   end interface ieee_quiet_le
 419   public :: ieee_quiet_le
 420 #undef IEEE_QUIET_LE_R
 421
 422 #define IEEE_QUIET_LT_R(AKIND) \
 423   elemental logical function ieee_quiet_lt_a##AKIND(a, b); \
 424     real(AKIND), intent(in) :: a, b; \
 425   end function ieee_quiet_lt_a##AKIND;
 426   interface ieee_quiet_lt
 427     SPECIFICS_R(IEEE_QUIET_LT_R)
 428   end interface ieee_quiet_lt
 429   public :: ieee_quiet_lt
 430 #undef IEEE_QUIET_LT_R
 431
 432 #define IEEE_QUIET_NE_R(AKIND) \
 433   elemental logical function ieee_quiet_ne_a##AKIND(a, b); \
 434     real(AKIND), intent(in) :: a, b; \
 435   end function ieee_quiet_ne_a##AKIND;
 436   interface ieee_quiet_ne
 437     SPECIFICS_R(IEEE_QUIET_NE_R)
 438   end interface ieee_quiet_ne
 439   public :: ieee_quiet_ne
 440 #undef IEEE_QUIET_NE_R
 441
 442 ! When kind argument is present, kind(result) is value(kind), not kind(kind).
 443 ! That is not known here, so return real(16).
 444 #define IEEE_REAL_I(AKIND) \
 445   elemental real function ieee_real_i##AKIND(a); \
 446     integer(AKIND), intent(in) :: a; \
 447   end function ieee_real_i##AKIND;
 448 #define IEEE_REAL_R(AKIND) \
 449   elemental real function ieee_real_a##AKIND(a); \
 450     real(AKIND), intent(in) :: a; \
 451   end function ieee_real_a##AKIND;
 452 #define IEEE_REAL_II(AKIND, KKIND) \
 453   elemental real(16) function ieee_real_i##AKIND##_i##KKIND(a, kind); \
 454     integer(AKIND), intent(in) :: a; \
 455     integer(KKIND), intent(in) :: kind; \
 456   end function ieee_real_i##AKIND##_i##KKIND;
 457 #define IEEE_REAL_RI(AKIND, KKIND) \
 458   elemental real(16) function ieee_real_a##AKIND##_i##KKIND(a, kind); \
 459     real(AKIND), intent(in) :: a; \
 460     integer(KKIND), intent(in) :: kind; \
 461   end function ieee_real_a##AKIND##_i##KKIND;
 462   interface ieee_real
 463     SPECIFICS_I(IEEE_REAL_I)
 464     SPECIFICS_R(IEEE_REAL_R)
 465     SPECIFICS_II(IEEE_REAL_II)
 466     SPECIFICS_RI(IEEE_REAL_RI)
 467   end interface ieee_real
 468   public :: ieee_real
 469 #undef IEEE_REAL_I
 470 #undef IEEE_REAL_R
 471 #undef IEEE_REAL_II
 472 #undef IEEE_REAL_RI
 473
 474 #define IEEE_REM_RR(XKIND, YKIND) \
 475   elemental real(XKIND) function ieee_rem_a##XKIND##_a##YKIND(x, y); \
 476     real(XKIND), intent(in) :: x; \
 477     real(YKIND), intent(in) :: y; \
 478   end function ieee_rem_a##XKIND##_a##YKIND;
 479   interface ieee_rem
 480     SPECIFICS_RR(IEEE_REM_RR)
 481   end interface ieee_rem
 482   public :: ieee_rem
 483 #undef IEEE_REM_RR
 484
 485 #define IEEE_RINT_R(XKIND) \
 486   elemental real(XKIND) function ieee_rint_a##XKIND(x, round); \
 487     import ieee_round_type; \
 488     real(XKIND), intent(in) :: x; \
 489     type(ieee_round_type), optional, intent(in) :: round; \
 490   end function ieee_rint_a##XKIND;
 491   interface ieee_rint
 492     SPECIFICS_R(IEEE_RINT_R)
 493   end interface ieee_rint
 494   public :: ieee_rint
 495 #undef IEEE_RINT_R
 496
 497 #define IEEE_SET_ROUNDING_MODE_I(RKIND) \
 498   subroutine ieee_set_rounding_mode_i##RKIND(round_value, radix); \
 499     import ieee_round_type; \
 500     type(ieee_round_type), intent(in) :: round_value; \
 501     integer(RKIND), intent(in) :: radix; \
 502   end subroutine ieee_set_rounding_mode_i##RKIND;
 503   interface ieee_set_rounding_mode
 504     subroutine ieee_set_rounding_mode_0(round_value)
 505       import ieee_round_type
 506       type(ieee_round_type), intent(in) :: round_value
 507     end subroutine ieee_set_rounding_mode_0
 508     SPECIFICS_I(IEEE_SET_ROUNDING_MODE_I)
 509   end interface ieee_set_rounding_mode
 510   public :: ieee_set_rounding_mode
 511 #undef IEEE_SET_ROUNDING_MODE_I
 512
 513 #define IEEE_SET_UNDERFLOW_MODE_L(GKIND) \
 514   subroutine ieee_set_underflow_mode_l##GKIND(gradual); \
 515     logical(GKIND), intent(in) :: gradual; \
 516   end subroutine ieee_set_underflow_mode_l##GKIND;
 517   interface ieee_set_underflow_mode
 518     SPECIFICS_L(IEEE_SET_UNDERFLOW_MODE_L)
 519   end interface ieee_set_underflow_mode
 520   public :: ieee_set_underflow_mode
 521 #undef IEEE_SET_UNDERFLOW_MODE_L
 522
 523 #define IEEE_SIGNALING_EQ_R(AKIND) \
 524   elemental logical function ieee_signaling_eq_a##AKIND(a, b); \
 525     real(AKIND), intent(in) :: a, b; \
 526   end function ieee_signaling_eq_a##AKIND;
 527   interface ieee_signaling_eq
 528     SPECIFICS_R(IEEE_SIGNALING_EQ_R)
 529   end interface ieee_signaling_eq
 530   public :: ieee_signaling_eq
 531 #undef IEEE_SIGNALING_EQ_R
 532
 533 #define IEEE_SIGNALING_GE_R(AKIND) \
 534   elemental logical function ieee_signaling_ge_a##AKIND(a, b); \
 535     real(AKIND), intent(in) :: a, b; \
 536   end function ieee_signaling_ge_a##AKIND;
 537   interface ieee_signaling_ge
 538     SPECIFICS_R(IEEE_SIGNALING_GE_R)
 539   end interface ieee_signaling_ge
 540   public :: ieee_signaling_ge
 541 #undef IEEE_SIGNALING_GE_R
 542
 543 #define IEEE_SIGNALING_GT_R(AKIND) \
 544   elemental logical function ieee_signaling_gt_a##AKIND(a, b); \
 545     real(AKIND), intent(in) :: a, b; \
 546   end function ieee_signaling_gt_a##AKIND;
 547   interface ieee_signaling_gt
 548     SPECIFICS_R(IEEE_SIGNALING_GT_R)
 549   end interface ieee_signaling_gt
 550   public :: ieee_signaling_gt
 551 #undef IEEE_SIGNALING_GT_R
 552
 553 #define IEEE_SIGNALING_LE_R(AKIND) \
 554   elemental logical function ieee_signaling_le_a##AKIND(a, b); \
 555     real(AKIND), intent(in) :: a, b; \
 556   end function ieee_signaling_le_a##AKIND;
 557   interface ieee_signaling_le
 558     SPECIFICS_R(IEEE_SIGNALING_LE_R)
 559   end interface ieee_signaling_le
 560   public :: ieee_signaling_le
 561 #undef IEEE_SIGNALING_LE_R
 562
 563 #define IEEE_SIGNALING_LT_R(AKIND) \
 564   elemental logical function ieee_signaling_lt_a##AKIND(a, b); \
 565     real(AKIND), intent(in) :: a, b; \
 566   end function ieee_signaling_lt_a##AKIND;
 567   interface ieee_signaling_lt
 568     SPECIFICS_R(IEEE_SIGNALING_LT_R)
 569   end interface ieee_signaling_lt
 570   public :: ieee_signaling_lt
 571 #undef IEEE_SIGNALING_LT_R
 572
 573 #define IEEE_SIGNALING_NE_R(AKIND) \
 574   elemental logical function ieee_signaling_ne_a##AKIND(a, b); \
 575     real(AKIND), intent(in) :: a, b; \
 576   end function ieee_signaling_ne_a##AKIND;
 577   interface ieee_signaling_ne
 578     SPECIFICS_R(IEEE_SIGNALING_NE_R)
 579   end interface ieee_signaling_ne
 580   public :: ieee_signaling_ne
 581 #undef IEEE_SIGNALING_NE_R
 582
 583 #define IEEE_SIGNBIT_R(XKIND) \
 584   elemental logical function ieee_signbit_a##XKIND(x); \
 585     real(XKIND), intent(in) :: x; \
 586   end function ieee_signbit_a##XKIND;
 587   interface ieee_signbit
 588     SPECIFICS_R(IEEE_SIGNBIT_R)
 589   end interface ieee_signbit
 590   public :: ieee_signbit
 591 #undef IEEE_SIGNBIT_R
 592
 593 #define IEEE_UNORDERED_RR(XKIND, YKIND) \
 594   elemental logical function ieee_unordered_a##XKIND##_a##YKIND(x, y); \
 595     real(XKIND), intent(in) :: x; \
 596     real(YKIND), intent(in) :: y; \
 597   end function ieee_unordered_a##XKIND##_a##YKIND;
 598   interface ieee_unordered
 599     SPECIFICS_RR(IEEE_UNORDERED_RR)
 600   end interface ieee_unordered
 601   public :: ieee_unordered
 602 #undef IEEE_UNORDERED_RR
 603
 604 #define IEEE_VALUE_R(XKIND) \
 605   elemental real(XKIND) function ieee_value_a##XKIND(x, class); \
 606     import ieee_class_type; \
 607     real(XKIND), intent(in) :: x; \
 608     type(ieee_class_type), intent(in) :: class; \
 609   end function ieee_value_a##XKIND;
 610   interface ieee_value
 611     SPECIFICS_R(IEEE_VALUE_R)
 612   end interface ieee_value
 613   public :: ieee_value
 614 #undef IEEE_VALUE_R
 615
 616 end module ieee_arithmetic