libgfortran/ieee/ieee_arithmetic.F90

   1 !    Implementation of the IEEE_ARITHMETIC standard intrinsic module
   2 !    Copyright (C) 2013-2018 Free Software Foundation, Inc.
   3 !    Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
   4 !
   5 ! This file is part of the GNU Fortran runtime library (libgfortran).
   6 !
   7 ! Libgfortran is free software; you can redistribute it and/or
   8 ! modify it under the terms of the GNU General Public
   9 ! License as published by the Free Software Foundation; either
  10 ! version 3 of the License, or (at your option) any later version.
  11 !
  12 ! Libgfortran is distributed in the hope that it will be useful,
  13 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ! GNU General Public License for more details.
  16 !
  17 ! Under Section 7 of GPL version 3, you are granted additional
  18 ! permissions described in the GCC Runtime Library Exception, version
  19 ! 3.1, as published by the Free Software Foundation.
  20 !
  21 ! You should have received a copy of the GNU General Public License and
  22 ! a copy of the GCC Runtime Library Exception along with this program;
  23 ! see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  24 ! <http://www.gnu.org/licenses/>.  */
  25
  26 #include "config.h"
  27 #include "kinds.inc"
  28 #include "c99_protos.inc"
  29 #include "fpu-target.inc"
  30
  31 module IEEE_ARITHMETIC
  32
  33   use IEEE_EXCEPTIONS
  34   implicit none
  35   private
  36
  37   ! Every public symbol from IEEE_EXCEPTIONS must be made public here
  38   public :: IEEE_FLAG_TYPE, IEEE_INVALID, IEEE_OVERFLOW, &
  39     IEEE_DIVIDE_BY_ZERO, IEEE_UNDERFLOW, IEEE_INEXACT, IEEE_USUAL, &
  40     IEEE_ALL, IEEE_STATUS_TYPE, IEEE_GET_FLAG, IEEE_GET_HALTING_MODE, &
  41     IEEE_GET_STATUS, IEEE_SET_FLAG, IEEE_SET_HALTING_MODE, &
  42     IEEE_SET_STATUS, IEEE_SUPPORT_FLAG, IEEE_SUPPORT_HALTING
  43
  44   ! Derived types and named constants
  45
  46   type, public :: IEEE_CLASS_TYPE
  47     private
  48     integer :: hidden
  49   end type
  50
  51   type(IEEE_CLASS_TYPE), parameter, public :: &
  52     IEEE_OTHER_VALUE       = IEEE_CLASS_TYPE(0), &
  53     IEEE_SIGNALING_NAN     = IEEE_CLASS_TYPE(1), &
  54     IEEE_QUIET_NAN         = IEEE_CLASS_TYPE(2), &
  55     IEEE_NEGATIVE_INF      = IEEE_CLASS_TYPE(3), &
  56     IEEE_NEGATIVE_NORMAL   = IEEE_CLASS_TYPE(4), &
  57     IEEE_NEGATIVE_DENORMAL = IEEE_CLASS_TYPE(5), &
  58     IEEE_NEGATIVE_ZERO     = IEEE_CLASS_TYPE(6), &
  59     IEEE_POSITIVE_ZERO     = IEEE_CLASS_TYPE(7), &
  60     IEEE_POSITIVE_DENORMAL = IEEE_CLASS_TYPE(8), &
  61     IEEE_POSITIVE_NORMAL   = IEEE_CLASS_TYPE(9), &
  62     IEEE_POSITIVE_INF      = IEEE_CLASS_TYPE(10)
  63
  64   type, public :: IEEE_ROUND_TYPE
  65     private
  66     integer :: hidden
  67   end type
  68
  69   type(IEEE_ROUND_TYPE), parameter, public :: &
  70     IEEE_NEAREST           = IEEE_ROUND_TYPE(GFC_FPE_TONEAREST), &
  71     IEEE_TO_ZERO           = IEEE_ROUND_TYPE(GFC_FPE_TOWARDZERO), &
  72     IEEE_UP                = IEEE_ROUND_TYPE(GFC_FPE_UPWARD), &
  73     IEEE_DOWN              = IEEE_ROUND_TYPE(GFC_FPE_DOWNWARD), &
  74     IEEE_OTHER             = IEEE_ROUND_TYPE(0)
  75
  76
  77   ! Equality operators on the derived types
  78   interface operator (==)
  79     module procedure IEEE_CLASS_TYPE_EQ, IEEE_ROUND_TYPE_EQ
  80   end interface
  81   public :: operator(==)
  82
  83   interface operator (/=)
  84     module procedure IEEE_CLASS_TYPE_NE, IEEE_ROUND_TYPE_NE
  85   end interface
  86   public :: operator (/=)
  87
  88
  89   ! IEEE_IS_FINITE
  90
  91   interface
  92     elemental logical function _gfortran_ieee_is_finite_4(X)
  93       real(kind=4), intent(in) :: X
  94     end function
  95     elemental logical function _gfortran_ieee_is_finite_8(X)
  96       real(kind=8), intent(in) :: X
  97     end function
  98 #ifdef HAVE_GFC_REAL_10
  99     elemental logical function _gfortran_ieee_is_finite_10(X)
 100       real(kind=10), intent(in) :: X
 101     end function
 102 #endif
 103 #ifdef HAVE_GFC_REAL_16
 104     elemental logical function _gfortran_ieee_is_finite_16(X)
 105       real(kind=16), intent(in) :: X
 106     end function
 107 #endif
 108   end interface
 109
 110   interface IEEE_IS_FINITE
 111     procedure &
 112 #ifdef HAVE_GFC_REAL_16
 113       _gfortran_ieee_is_finite_16, &
 114 #endif
 115 #ifdef HAVE_GFC_REAL_10
 116       _gfortran_ieee_is_finite_10, &
 117 #endif
 118       _gfortran_ieee_is_finite_8, _gfortran_ieee_is_finite_4
 119   end interface
 120   public :: IEEE_IS_FINITE
 121
 122   ! IEEE_IS_NAN
 123
 124   interface
 125     elemental logical function _gfortran_ieee_is_nan_4(X)
 126       real(kind=4), intent(in) :: X
 127     end function
 128     elemental logical function _gfortran_ieee_is_nan_8(X)
 129       real(kind=8), intent(in) :: X
 130     end function
 131 #ifdef HAVE_GFC_REAL_10
 132     elemental logical function _gfortran_ieee_is_nan_10(X)
 133       real(kind=10), intent(in) :: X
 134     end function
 135 #endif
 136 #ifdef HAVE_GFC_REAL_16
 137     elemental logical function _gfortran_ieee_is_nan_16(X)
 138       real(kind=16), intent(in) :: X
 139     end function
 140 #endif
 141   end interface
 142
 143   interface IEEE_IS_NAN
 144     procedure &
 145 #ifdef HAVE_GFC_REAL_16
 146       _gfortran_ieee_is_nan_16, &
 147 #endif
 148 #ifdef HAVE_GFC_REAL_10
 149       _gfortran_ieee_is_nan_10, &
 150 #endif
 151       _gfortran_ieee_is_nan_8, _gfortran_ieee_is_nan_4
 152   end interface
 153   public :: IEEE_IS_NAN
 154
 155   ! IEEE_IS_NEGATIVE
 156
 157   interface
 158     elemental logical function _gfortran_ieee_is_negative_4(X)
 159       real(kind=4), intent(in) :: X
 160     end function
 161     elemental logical function _gfortran_ieee_is_negative_8(X)
 162       real(kind=8), intent(in) :: X
 163     end function
 164 #ifdef HAVE_GFC_REAL_10
 165     elemental logical function _gfortran_ieee_is_negative_10(X)
 166       real(kind=10), intent(in) :: X
 167     end function
 168 #endif
 169 #ifdef HAVE_GFC_REAL_16
 170     elemental logical function _gfortran_ieee_is_negative_16(X)
 171       real(kind=16), intent(in) :: X
 172     end function
 173 #endif
 174   end interface
 175
 176   interface IEEE_IS_NEGATIVE
 177     procedure &
 178 #ifdef HAVE_GFC_REAL_16
 179       _gfortran_ieee_is_negative_16, &
 180 #endif
 181 #ifdef HAVE_GFC_REAL_10
 182       _gfortran_ieee_is_negative_10, &
 183 #endif
 184       _gfortran_ieee_is_negative_8, _gfortran_ieee_is_negative_4
 185   end interface
 186   public :: IEEE_IS_NEGATIVE
 187
 188   ! IEEE_IS_NORMAL
 189
 190   interface
 191     elemental logical function _gfortran_ieee_is_normal_4(X)
 192       real(kind=4), intent(in) :: X
 193     end function
 194     elemental logical function _gfortran_ieee_is_normal_8(X)
 195       real(kind=8), intent(in) :: X
 196     end function
 197 #ifdef HAVE_GFC_REAL_10
 198     elemental logical function _gfortran_ieee_is_normal_10(X)
 199       real(kind=10), intent(in) :: X
 200     end function
 201 #endif
 202 #ifdef HAVE_GFC_REAL_16
 203     elemental logical function _gfortran_ieee_is_normal_16(X)
 204       real(kind=16), intent(in) :: X
 205     end function
 206 #endif
 207   end interface
 208
 209   interface IEEE_IS_NORMAL
 210     procedure &
 211 #ifdef HAVE_GFC_REAL_16
 212       _gfortran_ieee_is_normal_16, &
 213 #endif
 214 #ifdef HAVE_GFC_REAL_10
 215       _gfortran_ieee_is_normal_10, &
 216 #endif
 217       _gfortran_ieee_is_normal_8, _gfortran_ieee_is_normal_4
 218   end interface
 219   public :: IEEE_IS_NORMAL
 220
 221   ! IEEE_COPY_SIGN
 222
 223 #define COPYSIGN_MACRO(A,B) \
 224   elemental real(kind = A) function \
 225     _gfortran_ieee_copy_sign_/**/A/**/_/**/B (X,Y) ; \
 226       real(kind = A), intent(in) :: X ; \
 227       real(kind = B), intent(in) :: Y ; \
 228   end function
 229
 230   interface
 231 COPYSIGN_MACRO(4,4)
 232 COPYSIGN_MACRO(4,8)
 233 #ifdef HAVE_GFC_REAL_10
 234 COPYSIGN_MACRO(4,10)
 235 #endif
 236 #ifdef HAVE_GFC_REAL_16
 237 COPYSIGN_MACRO(4,16)
 238 #endif
 239 COPYSIGN_MACRO(8,4)
 240 COPYSIGN_MACRO(8,8)
 241 #ifdef HAVE_GFC_REAL_10
 242 COPYSIGN_MACRO(8,10)
 243 #endif
 244 #ifdef HAVE_GFC_REAL_16
 245 COPYSIGN_MACRO(8,16)
 246 #endif
 247 #ifdef HAVE_GFC_REAL_10
 248 COPYSIGN_MACRO(10,4)
 249 COPYSIGN_MACRO(10,8)
 250 COPYSIGN_MACRO(10,10)
 251 #ifdef HAVE_GFC_REAL_16
 252 COPYSIGN_MACRO(10,16)
 253 #endif
 254 #endif
 255 #ifdef HAVE_GFC_REAL_16
 256 COPYSIGN_MACRO(16,4)
 257 COPYSIGN_MACRO(16,8)
 258 #ifdef HAVE_GFC_REAL_10
 259 COPYSIGN_MACRO(16,10)
 260 #endif
 261 COPYSIGN_MACRO(16,16)
 262 #endif
 263   end interface
 264
 265   interface IEEE_COPY_SIGN
 266     procedure &
 267 #ifdef HAVE_GFC_REAL_16
 268               _gfortran_ieee_copy_sign_16_16, &
 269 #ifdef HAVE_GFC_REAL_10
 270               _gfortran_ieee_copy_sign_16_10, &
 271 #endif
 272               _gfortran_ieee_copy_sign_16_8, &
 273               _gfortran_ieee_copy_sign_16_4, &
 274 #endif
 275 #ifdef HAVE_GFC_REAL_10
 276 #ifdef HAVE_GFC_REAL_16
 277               _gfortran_ieee_copy_sign_10_16, &
 278 #endif
 279               _gfortran_ieee_copy_sign_10_10, &
 280               _gfortran_ieee_copy_sign_10_8, &
 281               _gfortran_ieee_copy_sign_10_4, &
 282 #endif
 283 #ifdef HAVE_GFC_REAL_16
 284               _gfortran_ieee_copy_sign_8_16, &
 285 #endif
 286 #ifdef HAVE_GFC_REAL_10
 287               _gfortran_ieee_copy_sign_8_10, &
 288 #endif
 289               _gfortran_ieee_copy_sign_8_8, &
 290               _gfortran_ieee_copy_sign_8_4, &
 291 #ifdef HAVE_GFC_REAL_16
 292               _gfortran_ieee_copy_sign_4_16, &
 293 #endif
 294 #ifdef HAVE_GFC_REAL_10
 295               _gfortran_ieee_copy_sign_4_10, &
 296 #endif
 297               _gfortran_ieee_copy_sign_4_8, &
 298               _gfortran_ieee_copy_sign_4_4
 299   end interface
 300   public :: IEEE_COPY_SIGN
 301
 302   ! IEEE_UNORDERED
 303
 304 #define UNORDERED_MACRO(A,B) \
 305   elemental logical function \
 306     _gfortran_ieee_unordered_/**/A/**/_/**/B (X,Y) ; \
 307       real(kind = A), intent(in) :: X ; \
 308       real(kind = B), intent(in) :: Y ; \
 309   end function
 310
 311   interface
 312 UNORDERED_MACRO(4,4)
 313 UNORDERED_MACRO(4,8)
 314 #ifdef HAVE_GFC_REAL_10
 315 UNORDERED_MACRO(4,10)
 316 #endif
 317 #ifdef HAVE_GFC_REAL_16
 318 UNORDERED_MACRO(4,16)
 319 #endif
 320 UNORDERED_MACRO(8,4)
 321 UNORDERED_MACRO(8,8)
 322 #ifdef HAVE_GFC_REAL_10
 323 UNORDERED_MACRO(8,10)
 324 #endif
 325 #ifdef HAVE_GFC_REAL_16
 326 UNORDERED_MACRO(8,16)
 327 #endif
 328 #ifdef HAVE_GFC_REAL_10
 329 UNORDERED_MACRO(10,4)
 330 UNORDERED_MACRO(10,8)
 331 UNORDERED_MACRO(10,10)
 332 #ifdef HAVE_GFC_REAL_16
 333 UNORDERED_MACRO(10,16)
 334 #endif
 335 #endif
 336 #ifdef HAVE_GFC_REAL_16
 337 UNORDERED_MACRO(16,4)
 338 UNORDERED_MACRO(16,8)
 339 #ifdef HAVE_GFC_REAL_10
 340 UNORDERED_MACRO(16,10)
 341 #endif
 342 UNORDERED_MACRO(16,16)
 343 #endif
 344   end interface
 345
 346   interface IEEE_UNORDERED
 347     procedure &
 348 #ifdef HAVE_GFC_REAL_16
 349               _gfortran_ieee_unordered_16_16, &
 350 #ifdef HAVE_GFC_REAL_10
 351               _gfortran_ieee_unordered_16_10, &
 352 #endif
 353               _gfortran_ieee_unordered_16_8, &
 354               _gfortran_ieee_unordered_16_4, &
 355 #endif
 356 #ifdef HAVE_GFC_REAL_10
 357 #ifdef HAVE_GFC_REAL_16
 358               _gfortran_ieee_unordered_10_16, &
 359 #endif
 360               _gfortran_ieee_unordered_10_10, &
 361               _gfortran_ieee_unordered_10_8, &
 362               _gfortran_ieee_unordered_10_4, &
 363 #endif
 364 #ifdef HAVE_GFC_REAL_16
 365               _gfortran_ieee_unordered_8_16, &
 366 #endif
 367 #ifdef HAVE_GFC_REAL_10
 368               _gfortran_ieee_unordered_8_10, &
 369 #endif
 370               _gfortran_ieee_unordered_8_8, &
 371               _gfortran_ieee_unordered_8_4, &
 372 #ifdef HAVE_GFC_REAL_16
 373               _gfortran_ieee_unordered_4_16, &
 374 #endif
 375 #ifdef HAVE_GFC_REAL_10
 376               _gfortran_ieee_unordered_4_10, &
 377 #endif
 378               _gfortran_ieee_unordered_4_8, &
 379               _gfortran_ieee_unordered_4_4
 380   end interface
 381   public :: IEEE_UNORDERED
 382
 383   ! IEEE_LOGB
 384
 385   interface
 386     elemental real(kind=4) function _gfortran_ieee_logb_4 (X)
 387       real(kind=4), intent(in) :: X
 388     end function
 389     elemental real(kind=8) function _gfortran_ieee_logb_8 (X)
 390       real(kind=8), intent(in) :: X
 391     end function
 392 #ifdef HAVE_GFC_REAL_10
 393     elemental real(kind=10) function _gfortran_ieee_logb_10 (X)
 394       real(kind=10), intent(in) :: X
 395     end function
 396 #endif
 397 #ifdef HAVE_GFC_REAL_16
 398     elemental real(kind=16) function _gfortran_ieee_logb_16 (X)
 399       real(kind=16), intent(in) :: X
 400     end function
 401 #endif
 402   end interface
 403
 404   interface IEEE_LOGB
 405     procedure &
 406 #ifdef HAVE_GFC_REAL_16
 407       _gfortran_ieee_logb_16, &
 408 #endif
 409 #ifdef HAVE_GFC_REAL_10
 410       _gfortran_ieee_logb_10, &
 411 #endif
 412       _gfortran_ieee_logb_8, &
 413       _gfortran_ieee_logb_4
 414   end interface
 415   public :: IEEE_LOGB
 416
 417   ! IEEE_NEXT_AFTER
 418
 419 #define NEXT_AFTER_MACRO(A,B) \
 420   elemental real(kind = A) function \
 421     _gfortran_ieee_next_after_/**/A/**/_/**/B (X,Y) ; \
 422       real(kind = A), intent(in) :: X ; \
 423       real(kind = B), intent(in) :: Y ; \
 424   end function
 425
 426   interface
 427 NEXT_AFTER_MACRO(4,4)
 428 NEXT_AFTER_MACRO(4,8)
 429 #ifdef HAVE_GFC_REAL_10
 430 NEXT_AFTER_MACRO(4,10)
 431 #endif
 432 #ifdef HAVE_GFC_REAL_16
 433 NEXT_AFTER_MACRO(4,16)
 434 #endif
 435 NEXT_AFTER_MACRO(8,4)
 436 NEXT_AFTER_MACRO(8,8)
 437 #ifdef HAVE_GFC_REAL_10
 438 NEXT_AFTER_MACRO(8,10)
 439 #endif
 440 #ifdef HAVE_GFC_REAL_16
 441 NEXT_AFTER_MACRO(8,16)
 442 #endif
 443 #ifdef HAVE_GFC_REAL_10
 444 NEXT_AFTER_MACRO(10,4)
 445 NEXT_AFTER_MACRO(10,8)
 446 NEXT_AFTER_MACRO(10,10)
 447 #ifdef HAVE_GFC_REAL_16
 448 NEXT_AFTER_MACRO(10,16)
 449 #endif
 450 #endif
 451 #ifdef HAVE_GFC_REAL_16
 452 NEXT_AFTER_MACRO(16,4)
 453 NEXT_AFTER_MACRO(16,8)
 454 #ifdef HAVE_GFC_REAL_10
 455 NEXT_AFTER_MACRO(16,10)
 456 #endif
 457 NEXT_AFTER_MACRO(16,16)
 458 #endif
 459   end interface
 460
 461   interface IEEE_NEXT_AFTER
 462     procedure &
 463 #ifdef HAVE_GFC_REAL_16
 464       _gfortran_ieee_next_after_16_16, &
 465 #ifdef HAVE_GFC_REAL_10
 466       _gfortran_ieee_next_after_16_10, &
 467 #endif
 468       _gfortran_ieee_next_after_16_8, &
 469       _gfortran_ieee_next_after_16_4, &
 470 #endif
 471 #ifdef HAVE_GFC_REAL_10
 472 #ifdef HAVE_GFC_REAL_16
 473       _gfortran_ieee_next_after_10_16, &
 474 #endif
 475       _gfortran_ieee_next_after_10_10, &
 476       _gfortran_ieee_next_after_10_8, &
 477       _gfortran_ieee_next_after_10_4, &
 478 #endif
 479 #ifdef HAVE_GFC_REAL_16
 480       _gfortran_ieee_next_after_8_16, &
 481 #endif
 482 #ifdef HAVE_GFC_REAL_10
 483       _gfortran_ieee_next_after_8_10, &
 484 #endif
 485       _gfortran_ieee_next_after_8_8, &
 486       _gfortran_ieee_next_after_8_4, &
 487 #ifdef HAVE_GFC_REAL_16
 488       _gfortran_ieee_next_after_4_16, &
 489 #endif
 490 #ifdef HAVE_GFC_REAL_10
 491       _gfortran_ieee_next_after_4_10, &
 492 #endif
 493       _gfortran_ieee_next_after_4_8, &
 494       _gfortran_ieee_next_after_4_4
 495   end interface
 496   public :: IEEE_NEXT_AFTER
 497
 498   ! IEEE_REM
 499
 500 #define REM_MACRO(RES,A,B) \
 501   elemental real(kind = RES) function \
 502     _gfortran_ieee_rem_/**/A/**/_/**/B (X,Y) ; \
 503       real(kind = A), intent(in) :: X ; \
 504       real(kind = B), intent(in) :: Y ; \
 505   end function
 506
 507   interface
 508 REM_MACRO(4,4,4)
 509 REM_MACRO(8,4,8)
 510 #ifdef HAVE_GFC_REAL_10
 511 REM_MACRO(10,4,10)
 512 #endif
 513 #ifdef HAVE_GFC_REAL_16
 514 REM_MACRO(16,4,16)
 515 #endif
 516 REM_MACRO(8,8,4)
 517 REM_MACRO(8,8,8)
 518 #ifdef HAVE_GFC_REAL_10
 519 REM_MACRO(10,8,10)
 520 #endif
 521 #ifdef HAVE_GFC_REAL_16
 522 REM_MACRO(16,8,16)
 523 #endif
 524 #ifdef HAVE_GFC_REAL_10
 525 REM_MACRO(10,10,4)
 526 REM_MACRO(10,10,8)
 527 REM_MACRO(10,10,10)
 528 #ifdef HAVE_GFC_REAL_16
 529 REM_MACRO(16,10,16)
 530 #endif
 531 #endif
 532 #ifdef HAVE_GFC_REAL_16
 533 REM_MACRO(16,16,4)
 534 REM_MACRO(16,16,8)
 535 #ifdef HAVE_GFC_REAL_10
 536 REM_MACRO(16,16,10)
 537 #endif
 538 REM_MACRO(16,16,16)
 539 #endif
 540   end interface
 541
 542   interface IEEE_REM
 543     procedure &
 544 #ifdef HAVE_GFC_REAL_16
 545       _gfortran_ieee_rem_16_16, &
 546 #ifdef HAVE_GFC_REAL_10
 547       _gfortran_ieee_rem_16_10, &
 548 #endif
 549       _gfortran_ieee_rem_16_8, &
 550       _gfortran_ieee_rem_16_4, &
 551 #endif
 552 #ifdef HAVE_GFC_REAL_10
 553 #ifdef HAVE_GFC_REAL_16
 554       _gfortran_ieee_rem_10_16, &
 555 #endif
 556       _gfortran_ieee_rem_10_10, &
 557       _gfortran_ieee_rem_10_8, &
 558       _gfortran_ieee_rem_10_4, &
 559 #endif
 560 #ifdef HAVE_GFC_REAL_16
 561       _gfortran_ieee_rem_8_16, &
 562 #endif
 563 #ifdef HAVE_GFC_REAL_10
 564       _gfortran_ieee_rem_8_10, &
 565 #endif
 566       _gfortran_ieee_rem_8_8, &
 567       _gfortran_ieee_rem_8_4, &
 568 #ifdef HAVE_GFC_REAL_16
 569       _gfortran_ieee_rem_4_16, &
 570 #endif
 571 #ifdef HAVE_GFC_REAL_10
 572       _gfortran_ieee_rem_4_10, &
 573 #endif
 574       _gfortran_ieee_rem_4_8, &
 575       _gfortran_ieee_rem_4_4
 576   end interface
 577   public :: IEEE_REM
 578
 579   ! IEEE_RINT
 580
 581   interface
 582     elemental real(kind=4) function _gfortran_ieee_rint_4 (X)
 583       real(kind=4), intent(in) :: X
 584     end function
 585     elemental real(kind=8) function _gfortran_ieee_rint_8 (X)
 586       real(kind=8), intent(in) :: X
 587     end function
 588 #ifdef HAVE_GFC_REAL_10
 589     elemental real(kind=10) function _gfortran_ieee_rint_10 (X)
 590       real(kind=10), intent(in) :: X
 591     end function
 592 #endif
 593 #ifdef HAVE_GFC_REAL_16
 594     elemental real(kind=16) function _gfortran_ieee_rint_16 (X)
 595       real(kind=16), intent(in) :: X
 596     end function
 597 #endif
 598   end interface
 599
 600   interface IEEE_RINT
 601     procedure &
 602 #ifdef HAVE_GFC_REAL_16
 603       _gfortran_ieee_rint_16, &
 604 #endif
 605 #ifdef HAVE_GFC_REAL_10
 606       _gfortran_ieee_rint_10, &
 607 #endif
 608       _gfortran_ieee_rint_8, _gfortran_ieee_rint_4
 609   end interface
 610   public :: IEEE_RINT
 611
 612   ! IEEE_SCALB
 613
 614   interface
 615     elemental real(kind=4) function _gfortran_ieee_scalb_4 (X, I)
 616       real(kind=4), intent(in) :: X
 617       integer, intent(in) :: I
 618     end function
 619     elemental real(kind=8) function _gfortran_ieee_scalb_8 (X, I)
 620       real(kind=8), intent(in) :: X
 621       integer, intent(in) :: I
 622     end function
 623 #ifdef HAVE_GFC_REAL_10
 624     elemental real(kind=10) function _gfortran_ieee_scalb_10 (X, I)
 625       real(kind=10), intent(in) :: X
 626       integer, intent(in) :: I
 627     end function
 628 #endif
 629 #ifdef HAVE_GFC_REAL_16
 630     elemental real(kind=16) function _gfortran_ieee_scalb_16 (X, I)
 631       real(kind=16), intent(in) :: X
 632       integer, intent(in) :: I
 633     end function
 634 #endif
 635   end interface
 636
 637   interface IEEE_SCALB
 638     procedure &
 639 #ifdef HAVE_GFC_REAL_16
 640       _gfortran_ieee_scalb_16, &
 641 #endif
 642 #ifdef HAVE_GFC_REAL_10
 643       _gfortran_ieee_scalb_10, &
 644 #endif
 645       _gfortran_ieee_scalb_8, _gfortran_ieee_scalb_4
 646   end interface
 647   public :: IEEE_SCALB
 648
 649   ! IEEE_VALUE
 650
 651   interface IEEE_VALUE
 652     module procedure &
 653 #ifdef HAVE_GFC_REAL_16
 654       IEEE_VALUE_16, &
 655 #endif
 656 #ifdef HAVE_GFC_REAL_10
 657       IEEE_VALUE_10, &
 658 #endif
 659       IEEE_VALUE_8, IEEE_VALUE_4
 660   end interface
 661   public :: IEEE_VALUE
 662
 663   ! IEEE_CLASS
 664
 665   interface IEEE_CLASS
 666     module procedure &
 667 #ifdef HAVE_GFC_REAL_16
 668       IEEE_CLASS_16, &
 669 #endif
 670 #ifdef HAVE_GFC_REAL_10
 671       IEEE_CLASS_10, &
 672 #endif
 673       IEEE_CLASS_8, IEEE_CLASS_4
 674   end interface
 675   public :: IEEE_CLASS
 676
 677   ! Public declarations for contained procedures
 678   public :: IEEE_GET_ROUNDING_MODE, IEEE_SET_ROUNDING_MODE
 679   public :: IEEE_GET_UNDERFLOW_MODE, IEEE_SET_UNDERFLOW_MODE
 680   public :: IEEE_SELECTED_REAL_KIND
 681
 682   ! IEEE_SUPPORT_ROUNDING
 683
 684   interface IEEE_SUPPORT_ROUNDING
 685     module procedure IEEE_SUPPORT_ROUNDING_4, IEEE_SUPPORT_ROUNDING_8, &
 686 #ifdef HAVE_GFC_REAL_10
 687                      IEEE_SUPPORT_ROUNDING_10, &
 688 #endif
 689 #ifdef HAVE_GFC_REAL_16
 690                      IEEE_SUPPORT_ROUNDING_16, &
 691 #endif
 692                      IEEE_SUPPORT_ROUNDING_NOARG
 693   end interface
 694   public :: IEEE_SUPPORT_ROUNDING
 695
 696   ! Interface to the FPU-specific function
 697   interface
 698     pure integer function support_rounding_helper(flag) &
 699         bind(c, name="_gfortrani_support_fpu_rounding_mode")
 700       integer, intent(in), value :: flag
 701     end function
 702   end interface
 703
 704   ! IEEE_SUPPORT_UNDERFLOW_CONTROL
 705
 706   interface IEEE_SUPPORT_UNDERFLOW_CONTROL
 707     module procedure IEEE_SUPPORT_UNDERFLOW_CONTROL_4, &
 708                      IEEE_SUPPORT_UNDERFLOW_CONTROL_8, &
 709 #ifdef HAVE_GFC_REAL_10
 710                      IEEE_SUPPORT_UNDERFLOW_CONTROL_10, &
 711 #endif
 712 #ifdef HAVE_GFC_REAL_16
 713                      IEEE_SUPPORT_UNDERFLOW_CONTROL_16, &
 714 #endif
 715                      IEEE_SUPPORT_UNDERFLOW_CONTROL_NOARG
 716   end interface
 717   public :: IEEE_SUPPORT_UNDERFLOW_CONTROL
 718
 719   ! Interface to the FPU-specific function
 720   interface
 721     pure integer function support_underflow_control_helper(kind) &
 722         bind(c, name="_gfortrani_support_fpu_underflow_control")
 723       integer, intent(in), value :: kind
 724     end function
 725   end interface
 726
 727 ! IEEE_SUPPORT_* generic functions
 728
 729 #if defined(HAVE_GFC_REAL_10) && defined(HAVE_GFC_REAL_16)
 730 # define MACRO1(NAME) NAME/**/_4, NAME/**/_8, NAME/**/_10, NAME/**/_16, NAME/**/_NOARG
 731 #elif defined(HAVE_GFC_REAL_10)
 732 # define MACRO1(NAME) NAME/**/_4, NAME/**/_8, NAME/**/_10, NAME/**/_NOARG
 733 #elif defined(HAVE_GFC_REAL_16)
 734 # define MACRO1(NAME) NAME/**/_4, NAME/**/_8, NAME/**/_16, NAME/**/_NOARG
 735 #else
 736 # define MACRO1(NAME) NAME/**/_4, NAME/**/_8, NAME/**/_NOARG
 737 #endif
 738
 739 #define SUPPORTGENERIC(NAME) \
 740   interface NAME ; module procedure MACRO1(NAME) ; end interface ; \
 741   public :: NAME
 742
 743 SUPPORTGENERIC(IEEE_SUPPORT_DATATYPE)
 744 SUPPORTGENERIC(IEEE_SUPPORT_DENORMAL)
 745 SUPPORTGENERIC(IEEE_SUPPORT_DIVIDE)
 746 SUPPORTGENERIC(IEEE_SUPPORT_INF)
 747 SUPPORTGENERIC(IEEE_SUPPORT_IO)
 748 SUPPORTGENERIC(IEEE_SUPPORT_NAN)
 749 SUPPORTGENERIC(IEEE_SUPPORT_SQRT)
 750 SUPPORTGENERIC(IEEE_SUPPORT_STANDARD)
 751
 752 contains
 753
 754   ! Equality operators for IEEE_CLASS_TYPE and IEEE_ROUNDING_MODE
 755   elemental logical function IEEE_CLASS_TYPE_EQ (X, Y) result(res)
 756     implicit none
 757     type(IEEE_CLASS_TYPE), intent(in) :: X, Y
 758     res = (X%hidden == Y%hidden)
 759   end function
 760
 761   elemental logical function IEEE_CLASS_TYPE_NE (X, Y) result(res)
 762     implicit none
 763     type(IEEE_CLASS_TYPE), intent(in) :: X, Y
 764     res = (X%hidden /= Y%hidden)
 765   end function
 766
 767   elemental logical function IEEE_ROUND_TYPE_EQ (X, Y) result(res)
 768     implicit none
 769     type(IEEE_ROUND_TYPE), intent(in) :: X, Y
 770     res = (X%hidden == Y%hidden)
 771   end function
 772
 773   elemental logical function IEEE_ROUND_TYPE_NE (X, Y) result(res)
 774     implicit none
 775     type(IEEE_ROUND_TYPE), intent(in) :: X, Y
 776     res = (X%hidden /= Y%hidden)
 777   end function
 778
 779
 780   ! IEEE_SELECTED_REAL_KIND
 781
 782   integer function IEEE_SELECTED_REAL_KIND (P, R, RADIX) result(res)
 783     implicit none
 784     integer, intent(in), optional :: P, R, RADIX
 785
 786     ! Currently, if IEEE is supported and this module is built, it means
 787     ! all our floating-point types conform to IEEE. Hence, we simply call
 788     ! SELECTED_REAL_KIND.
 789
 790     res = SELECTED_REAL_KIND (P, R, RADIX)
 791
 792   end function
 793
 794
 795   ! IEEE_CLASS
 796
 797   elemental function IEEE_CLASS_4 (X) result(res)
 798     implicit none
 799     real(kind=4), intent(in) :: X
 800     type(IEEE_CLASS_TYPE) :: res
 801
 802     interface
 803       pure integer function _gfortrani_ieee_class_helper_4(val)
 804         real(kind=4), intent(in) :: val
 805       end function
 806     end interface
 807
 808     res = IEEE_CLASS_TYPE(_gfortrani_ieee_class_helper_4(X))
 809   end function
 810
 811   elemental function IEEE_CLASS_8 (X) result(res)
 812     implicit none
 813     real(kind=8), intent(in) :: X
 814     type(IEEE_CLASS_TYPE) :: res
 815
 816     interface
 817       pure integer function _gfortrani_ieee_class_helper_8(val)
 818         real(kind=8), intent(in) :: val
 819       end function
 820     end interface
 821
 822     res = IEEE_CLASS_TYPE(_gfortrani_ieee_class_helper_8(X))
 823   end function
 824
 825 #ifdef HAVE_GFC_REAL_10
 826   elemental function IEEE_CLASS_10 (X) result(res)
 827     implicit none
 828     real(kind=10), intent(in) :: X
 829     type(IEEE_CLASS_TYPE) :: res
 830
 831     interface
 832       pure integer function _gfortrani_ieee_class_helper_10(val)
 833         real(kind=10), intent(in) :: val
 834       end function
 835     end interface
 836
 837     res = IEEE_CLASS_TYPE(_gfortrani_ieee_class_helper_10(X))
 838   end function
 839 #endif
 840
 841 #ifdef HAVE_GFC_REAL_16
 842   elemental function IEEE_CLASS_16 (X) result(res)
 843     implicit none
 844     real(kind=16), intent(in) :: X
 845     type(IEEE_CLASS_TYPE) :: res
 846
 847     interface
 848       pure integer function _gfortrani_ieee_class_helper_16(val)
 849         real(kind=16), intent(in) :: val
 850       end function
 851     end interface
 852
 853     res = IEEE_CLASS_TYPE(_gfortrani_ieee_class_helper_16(X))
 854   end function
 855 #endif
 856
 857
 858   ! IEEE_VALUE
 859
 860   elemental real(kind=4) function IEEE_VALUE_4(X, CLASS) result(res)
 861
 862     real(kind=4), intent(in) :: X
 863     type(IEEE_CLASS_TYPE), intent(in) :: CLASS
 864
 865     select case (CLASS%hidden)
 866       case (1)     ! IEEE_SIGNALING_NAN
 867         res = -1
 868         res = sqrt(res)
 869       case (2)     ! IEEE_QUIET_NAN
 870         res = -1
 871         res = sqrt(res)
 872       case (3)     ! IEEE_NEGATIVE_INF
 873         res = huge(res)
 874         res = (-res) * res
 875       case (4)     ! IEEE_NEGATIVE_NORMAL
 876         res = -42
 877       case (5)     ! IEEE_NEGATIVE_DENORMAL
 878         res = -tiny(res)
 879         res = res / 2
 880       case (6)     ! IEEE_NEGATIVE_ZERO
 881         res = 0
 882         res = -res
 883       case (7)     ! IEEE_POSITIVE_ZERO
 884         res = 0
 885       case (8)     ! IEEE_POSITIVE_DENORMAL
 886         res = tiny(res)
 887         res = res / 2
 888       case (9)     ! IEEE_POSITIVE_NORMAL
 889         res = 42
 890       case (10)    ! IEEE_POSITIVE_INF
 891         res = huge(res)
 892         res = res * res
 893       case default ! IEEE_OTHER_VALUE, should not happen
 894         res = 0
 895      end select
 896   end function
 897
 898   elemental real(kind=8) function IEEE_VALUE_8(X, CLASS) result(res)
 899
 900     real(kind=8), intent(in) :: X
 901     type(IEEE_CLASS_TYPE), intent(in) :: CLASS
 902
 903     select case (CLASS%hidden)
 904       case (1)     ! IEEE_SIGNALING_NAN
 905         res = -1
 906         res = sqrt(res)
 907       case (2)     ! IEEE_QUIET_NAN
 908         res = -1
 909         res = sqrt(res)
 910       case (3)     ! IEEE_NEGATIVE_INF
 911         res = huge(res)
 912         res = (-res) * res
 913       case (4)     ! IEEE_NEGATIVE_NORMAL
 914         res = -42
 915       case (5)     ! IEEE_NEGATIVE_DENORMAL
 916         res = -tiny(res)
 917         res = res / 2
 918       case (6)     ! IEEE_NEGATIVE_ZERO
 919         res = 0
 920         res = -res
 921       case (7)     ! IEEE_POSITIVE_ZERO
 922         res = 0
 923       case (8)     ! IEEE_POSITIVE_DENORMAL
 924         res = tiny(res)
 925         res = res / 2
 926       case (9)     ! IEEE_POSITIVE_NORMAL
 927         res = 42
 928       case (10)    ! IEEE_POSITIVE_INF
 929         res = huge(res)
 930         res = res * res
 931       case default ! IEEE_OTHER_VALUE, should not happen
 932         res = 0
 933      end select
 934   end function
 935
 936 #ifdef HAVE_GFC_REAL_10
 937   elemental real(kind=10) function IEEE_VALUE_10(X, CLASS) result(res)
 938
 939     real(kind=10), intent(in) :: X
 940     type(IEEE_CLASS_TYPE), intent(in) :: CLASS
 941
 942     select case (CLASS%hidden)
 943       case (1)     ! IEEE_SIGNALING_NAN
 944         res = -1
 945         res = sqrt(res)
 946       case (2)     ! IEEE_QUIET_NAN
 947         res = -1
 948         res = sqrt(res)
 949       case (3)     ! IEEE_NEGATIVE_INF
 950         res = huge(res)
 951         res = (-res) * res
 952       case (4)     ! IEEE_NEGATIVE_NORMAL
 953         res = -42
 954       case (5)     ! IEEE_NEGATIVE_DENORMAL
 955         res = -tiny(res)
 956         res = res / 2
 957       case (6)     ! IEEE_NEGATIVE_ZERO
 958         res = 0
 959         res = -res
 960       case (7)     ! IEEE_POSITIVE_ZERO
 961         res = 0
 962       case (8)     ! IEEE_POSITIVE_DENORMAL
 963         res = tiny(res)
 964         res = res / 2
 965       case (9)     ! IEEE_POSITIVE_NORMAL
 966         res = 42
 967       case (10)    ! IEEE_POSITIVE_INF
 968         res = huge(res)
 969         res = res * res
 970       case default ! IEEE_OTHER_VALUE, should not happen
 971         res = 0
 972      end select
 973   end function
 974
 975 #endif
 976
 977 #ifdef HAVE_GFC_REAL_16
 978   elemental real(kind=16) function IEEE_VALUE_16(X, CLASS) result(res)
 979
 980     real(kind=16), intent(in) :: X
 981     type(IEEE_CLASS_TYPE), intent(in) :: CLASS
 982
 983     select case (CLASS%hidden)
 984       case (1)     ! IEEE_SIGNALING_NAN
 985         res = -1
 986         res = sqrt(res)
 987       case (2)     ! IEEE_QUIET_NAN
 988         res = -1
 989         res = sqrt(res)
 990       case (3)     ! IEEE_NEGATIVE_INF
 991         res = huge(res)
 992         res = (-res) * res
 993       case (4)     ! IEEE_NEGATIVE_NORMAL
 994         res = -42
 995       case (5)     ! IEEE_NEGATIVE_DENORMAL
 996         res = -tiny(res)
 997         res = res / 2
 998       case (6)     ! IEEE_NEGATIVE_ZERO
 999         res = 0
1000         res = -res
1001       case (7)     ! IEEE_POSITIVE_ZERO
1002         res = 0
1003       case (8)     ! IEEE_POSITIVE_DENORMAL
1004         res = tiny(res)
1005         res = res / 2
1006       case (9)     ! IEEE_POSITIVE_NORMAL
1007         res = 42
1008       case (10)    ! IEEE_POSITIVE_INF
1009         res = huge(res)
1010         res = res * res
1011       case default ! IEEE_OTHER_VALUE, should not happen
1012         res = 0
1013      end select
1014   end function
1015 #endif
1016
1017
1018   ! IEEE_GET_ROUNDING_MODE
1019
1020   subroutine IEEE_GET_ROUNDING_MODE (ROUND_VALUE)
1021     implicit none
1022     type(IEEE_ROUND_TYPE), intent(out) :: ROUND_VALUE
1023
1024     interface
1025       integer function helper() &
1026         bind(c, name="_gfortrani_get_fpu_rounding_mode")
1027       end function
1028     end interface
1029
1030     ROUND_VALUE = IEEE_ROUND_TYPE(helper())
1031   end subroutine
1032
1033
1034   ! IEEE_SET_ROUNDING_MODE
1035
1036   subroutine IEEE_SET_ROUNDING_MODE (ROUND_VALUE)
1037     implicit none
1038     type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
1039
1040     interface
1041       subroutine helper(val) &
1042           bind(c, name="_gfortrani_set_fpu_rounding_mode")
1043         integer, value :: val
1044       end subroutine
1045     end interface
1046
1047     call helper(ROUND_VALUE%hidden)
1048   end subroutine
1049
1050
1051   ! IEEE_GET_UNDERFLOW_MODE
1052
1053   subroutine IEEE_GET_UNDERFLOW_MODE (GRADUAL)
1054     implicit none
1055     logical, intent(out) :: GRADUAL
1056
1057     interface
1058       integer function helper() &
1059         bind(c, name="_gfortrani_get_fpu_underflow_mode")
1060       end function
1061     end interface
1062
1063     GRADUAL = (helper() /= 0)
1064   end subroutine
1065
1066
1067   ! IEEE_SET_UNDERFLOW_MODE
1068
1069   subroutine IEEE_SET_UNDERFLOW_MODE (GRADUAL)
1070     implicit none
1071     logical, intent(in) :: GRADUAL
1072
1073     interface
1074       subroutine helper(val) &
1075           bind(c, name="_gfortrani_set_fpu_underflow_mode")
1076         integer, value :: val
1077       end subroutine
1078     end interface
1079
1080     call helper(merge(1, 0, GRADUAL))
1081   end subroutine
1082
1083 ! IEEE_SUPPORT_ROUNDING
1084
1085   pure logical function IEEE_SUPPORT_ROUNDING_4 (ROUND_VALUE, X) result(res)
1086     implicit none
1087     real(kind=4), intent(in) :: X
1088     type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
1089     res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
1090   end function
1091
1092   pure logical function IEEE_SUPPORT_ROUNDING_8 (ROUND_VALUE, X) result(res)
1093     implicit none
1094     real(kind=8), intent(in) :: X
1095     type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
1096     res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
1097   end function
1098
1099 #ifdef HAVE_GFC_REAL_10
1100   pure logical function IEEE_SUPPORT_ROUNDING_10 (ROUND_VALUE, X) result(res)
1101     implicit none
1102     real(kind=10), intent(in) :: X
1103     type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
1104     res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
1105   end function
1106 #endif
1107
1108 #ifdef HAVE_GFC_REAL_16
1109   pure logical function IEEE_SUPPORT_ROUNDING_16 (ROUND_VALUE, X) result(res)
1110     implicit none
1111     real(kind=16), intent(in) :: X
1112     type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
1113     res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
1114   end function
1115 #endif
1116
1117   pure logical function IEEE_SUPPORT_ROUNDING_NOARG (ROUND_VALUE) result(res)
1118     implicit none
1119     type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
1120     res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
1121   end function
1122
1123 ! IEEE_SUPPORT_UNDERFLOW_CONTROL
1124
1125   pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_4 (X) result(res)
1126     implicit none
1127     real(kind=4), intent(in) :: X
1128     res = (support_underflow_control_helper(4) /= 0)
1129   end function
1130
1131   pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_8 (X) result(res)
1132     implicit none
1133     real(kind=8), intent(in) :: X
1134     res = (support_underflow_control_helper(8) /= 0)
1135   end function
1136
1137 #ifdef HAVE_GFC_REAL_10
1138   pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_10 (X) result(res)
1139     implicit none
1140     real(kind=10), intent(in) :: X
1141     res = (support_underflow_control_helper(10) /= 0)
1142   end function
1143 #endif
1144
1145 #ifdef HAVE_GFC_REAL_16
1146   pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_16 (X) result(res)
1147     implicit none
1148     real(kind=16), intent(in) :: X
1149     res = (support_underflow_control_helper(16) /= 0)
1150   end function
1151 #endif
1152
1153   pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_NOARG () result(res)
1154     implicit none
1155     res = (support_underflow_control_helper(4) /= 0 &
1156            .and. support_underflow_control_helper(8) /= 0 &
1157 #ifdef HAVE_GFC_REAL_10
1158            .and. support_underflow_control_helper(10) /= 0 &
1159 #endif
1160 #ifdef HAVE_GFC_REAL_16
1161            .and. support_underflow_control_helper(16) /= 0 &
1162 #endif
1163           )
1164   end function
1165
1166 ! IEEE_SUPPORT_* functions
1167
1168 #define SUPPORTMACRO(NAME, INTKIND, VALUE) \
1169   pure logical function NAME/**/_/**/INTKIND (X) result(res) ; \
1170     implicit none                                            ; \
1171     real(INTKIND), intent(in) :: X(..)                       ; \
1172     res = VALUE                                              ; \
1173   end function
1174
1175 #define SUPPORTMACRO_NOARG(NAME, VALUE) \
1176   pure logical function NAME/**/_NOARG () result(res) ; \
1177     implicit none                                     ; \
1178     res = VALUE                                       ; \
1179   end function
1180
1181 ! IEEE_SUPPORT_DATATYPE
1182
1183 SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,4,.true.)
1184 SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,8,.true.)
1185 #ifdef HAVE_GFC_REAL_10
1186 SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,10,.true.)
1187 #endif
1188 #ifdef HAVE_GFC_REAL_16
1189 SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,16,.true.)
1190 #endif
1191 SUPPORTMACRO_NOARG(IEEE_SUPPORT_DATATYPE,.true.)
1192
1193 ! IEEE_SUPPORT_DENORMAL
1194
1195 SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,4,.true.)
1196 SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,8,.true.)
1197 #ifdef HAVE_GFC_REAL_10
1198 SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,10,.true.)
1199 #endif
1200 #ifdef HAVE_GFC_REAL_16
1201 SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,16,.true.)
1202 #endif
1203 SUPPORTMACRO_NOARG(IEEE_SUPPORT_DENORMAL,.true.)
1204
1205 ! IEEE_SUPPORT_DIVIDE
1206
1207 SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,4,.true.)
1208 SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,8,.true.)
1209 #ifdef HAVE_GFC_REAL_10
1210 SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,10,.true.)
1211 #endif
1212 #ifdef HAVE_GFC_REAL_16
1213 SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,16,.true.)
1214 #endif
1215 SUPPORTMACRO_NOARG(IEEE_SUPPORT_DIVIDE,.true.)
1216
1217 ! IEEE_SUPPORT_INF
1218
1219 SUPPORTMACRO(IEEE_SUPPORT_INF,4,.true.)
1220 SUPPORTMACRO(IEEE_SUPPORT_INF,8,.true.)
1221 #ifdef HAVE_GFC_REAL_10
1222 SUPPORTMACRO(IEEE_SUPPORT_INF,10,.true.)
1223 #endif
1224 #ifdef HAVE_GFC_REAL_16
1225 SUPPORTMACRO(IEEE_SUPPORT_INF,16,.true.)
1226 #endif
1227 SUPPORTMACRO_NOARG(IEEE_SUPPORT_INF,.true.)
1228
1229 ! IEEE_SUPPORT_IO
1230
1231 SUPPORTMACRO(IEEE_SUPPORT_IO,4,.true.)
1232 SUPPORTMACRO(IEEE_SUPPORT_IO,8,.true.)
1233 #ifdef HAVE_GFC_REAL_10
1234 SUPPORTMACRO(IEEE_SUPPORT_IO,10,.true.)
1235 #endif
1236 #ifdef HAVE_GFC_REAL_16
1237 SUPPORTMACRO(IEEE_SUPPORT_IO,16,.true.)
1238 #endif
1239 SUPPORTMACRO_NOARG(IEEE_SUPPORT_IO,.true.)
1240
1241 ! IEEE_SUPPORT_NAN
1242
1243 SUPPORTMACRO(IEEE_SUPPORT_NAN,4,.true.)
1244 SUPPORTMACRO(IEEE_SUPPORT_NAN,8,.true.)
1245 #ifdef HAVE_GFC_REAL_10
1246 SUPPORTMACRO(IEEE_SUPPORT_NAN,10,.true.)
1247 #endif
1248 #ifdef HAVE_GFC_REAL_16
1249 SUPPORTMACRO(IEEE_SUPPORT_NAN,16,.true.)
1250 #endif
1251 SUPPORTMACRO_NOARG(IEEE_SUPPORT_NAN,.true.)
1252
1253 ! IEEE_SUPPORT_SQRT
1254
1255 SUPPORTMACRO(IEEE_SUPPORT_SQRT,4,.true.)
1256 SUPPORTMACRO(IEEE_SUPPORT_SQRT,8,.true.)
1257 #ifdef HAVE_GFC_REAL_10
1258 SUPPORTMACRO(IEEE_SUPPORT_SQRT,10,.true.)
1259 #endif
1260 #ifdef HAVE_GFC_REAL_16
1261 SUPPORTMACRO(IEEE_SUPPORT_SQRT,16,.true.)
1262 #endif
1263 SUPPORTMACRO_NOARG(IEEE_SUPPORT_SQRT,.true.)
1264
1265 ! IEEE_SUPPORT_STANDARD
1266
1267 SUPPORTMACRO(IEEE_SUPPORT_STANDARD,4,.true.)
1268 SUPPORTMACRO(IEEE_SUPPORT_STANDARD,8,.true.)
1269 #ifdef HAVE_GFC_REAL_10
1270 SUPPORTMACRO(IEEE_SUPPORT_STANDARD,10,.true.)
1271 #endif
1272 #ifdef HAVE_GFC_REAL_16
1273 SUPPORTMACRO(IEEE_SUPPORT_STANDARD,16,.true.)
1274 #endif
1275 SUPPORTMACRO_NOARG(IEEE_SUPPORT_STANDARD,.true.)
1276
1277 end module IEEE_ARITHMETIC