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_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
 641 end module ieee_arithmetic