libgfortran/ieee/ieee_arithmetic.F90

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