1 ! Implementation of the IEEE_ARITHMETIC standard intrinsic module
2 ! Copyright (C) 2013 Free Software Foundation, Inc.
3 ! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
5 ! This file is part of the GNU Fortran runtime library (libgfortran).
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.
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.
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.
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/>. */
28 #include "c99_protos.inc"
29 #include "fpu-target.inc"
31 module IEEE_ARITHMETIC
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
44 ! Derived types and named constants
46 type, public :: IEEE_CLASS_TYPE
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)
64 type, public :: IEEE_ROUND_TYPE
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)
77 ! Equality operators on the derived types
78 interface operator (==)
79 module procedure IEEE_CLASS_TYPE_EQ, IEEE_ROUND_TYPE_EQ
81 public :: operator(==)
83 interface operator (/=)
84 module procedure IEEE_CLASS_TYPE_NE, IEEE_ROUND_TYPE_NE
86 public :: operator (/=)
92 elemental logical function _gfortran_ieee_is_finite_4(X)
93 real(kind=4), intent(in) :: X
95 elemental logical function _gfortran_ieee_is_finite_8(X)
96 real(kind=8), intent(in) :: X
100 interface IEEE_IS_FINITE
101 procedure _gfortran_ieee_is_finite_4, _gfortran_ieee_is_finite_8
103 public :: IEEE_IS_FINITE
108 elemental logical function _gfortran_ieee_is_nan_4(X)
109 real(kind=4), intent(in) :: X
111 elemental logical function _gfortran_ieee_is_nan_8(X)
112 real(kind=8), intent(in) :: X
116 interface IEEE_IS_NAN
117 procedure _gfortran_ieee_is_nan_4, _gfortran_ieee_is_nan_8
119 public :: IEEE_IS_NAN
124 elemental logical function _gfortran_ieee_is_negative_4(X)
125 real(kind=4), intent(in) :: X
127 elemental logical function _gfortran_ieee_is_negative_8(X)
128 real(kind=8), intent(in) :: X
132 interface IEEE_IS_NEGATIVE
133 procedure _gfortran_ieee_is_negative_4, _gfortran_ieee_is_negative_8
135 public :: IEEE_IS_NEGATIVE
140 elemental logical function _gfortran_ieee_is_normal_4(X)
141 real(kind=4), intent(in) :: X
143 elemental logical function _gfortran_ieee_is_normal_8(X)
144 real(kind=8), intent(in) :: X
148 interface IEEE_IS_NORMAL
149 procedure _gfortran_ieee_is_normal_4, _gfortran_ieee_is_normal_8
151 public :: IEEE_IS_NORMAL
156 elemental real(kind=4) function _gfortran_ieee_copy_sign_4_4 (X,Y)
157 real(kind=4), intent(in) :: X
158 real(kind=4), intent(in) :: Y
160 elemental real(kind=4) function _gfortran_ieee_copy_sign_4_8 (X,Y)
161 real(kind=4), intent(in) :: X
162 real(kind=8), intent(in) :: Y
164 elemental real(kind=8) function _gfortran_ieee_copy_sign_8_4 (X,Y)
165 real(kind=8), intent(in) :: X
166 real(kind=4), intent(in) :: Y
168 elemental real(kind=8) function _gfortran_ieee_copy_sign_8_8 (X,Y)
169 real(kind=8), intent(in) :: X
170 real(kind=8), intent(in) :: Y
174 interface IEEE_COPY_SIGN
175 procedure _gfortran_ieee_copy_sign_4_4, _gfortran_ieee_copy_sign_4_8, &
176 _gfortran_ieee_copy_sign_8_4, _gfortran_ieee_copy_sign_8_8
178 public :: IEEE_COPY_SIGN
183 elemental logical function _gfortran_ieee_unordered_4_4 (X,Y)
184 real(kind=4), intent(in) :: X
185 real(kind=4), intent(in) :: Y
187 elemental logical function _gfortran_ieee_unordered_4_8 (X,Y)
188 real(kind=4), intent(in) :: X
189 real(kind=8), intent(in) :: Y
191 elemental logical function _gfortran_ieee_unordered_8_4 (X,Y)
192 real(kind=8), intent(in) :: X
193 real(kind=4), intent(in) :: Y
195 elemental logical function _gfortran_ieee_unordered_8_8 (X,Y)
196 real(kind=8), intent(in) :: X
197 real(kind=8), intent(in) :: Y
201 interface IEEE_UNORDERED
202 procedure _gfortran_ieee_unordered_4_4, _gfortran_ieee_unordered_4_8, &
203 _gfortran_ieee_unordered_8_4, _gfortran_ieee_unordered_8_8
205 public :: IEEE_UNORDERED
210 elemental real(kind=4) function _gfortran_ieee_logb_4 (X)
211 real(kind=4), intent(in) :: X
213 elemental real(kind=8) function _gfortran_ieee_logb_8 (X)
214 real(kind=8), intent(in) :: X
219 procedure _gfortran_ieee_logb_4, _gfortran_ieee_logb_8
226 elemental real(kind=4) function _gfortran_ieee_next_after_4_4 (X, Y)
227 real(kind=4), intent(in) :: X
228 real(kind=4), intent(in) :: Y
230 elemental real(kind=4) function _gfortran_ieee_next_after_4_8 (X, Y)
231 real(kind=4), intent(in) :: X
232 real(kind=8), intent(in) :: Y
234 elemental real(kind=8) function _gfortran_ieee_next_after_8_4 (X, Y)
235 real(kind=8), intent(in) :: X
236 real(kind=4), intent(in) :: Y
238 elemental real(kind=8) function _gfortran_ieee_next_after_8_8 (X, Y)
239 real(kind=8), intent(in) :: X
240 real(kind=8), intent(in) :: Y
244 interface IEEE_NEXT_AFTER
245 procedure _gfortran_ieee_next_after_4_4, _gfortran_ieee_next_after_4_8, &
246 _gfortran_ieee_next_after_8_4, _gfortran_ieee_next_after_8_8
248 public :: IEEE_NEXT_AFTER
253 elemental real(kind=4) function _gfortran_ieee_rem_4_4 (X, Y)
254 real(kind=4), intent(in) :: X
255 real(kind=4), intent(in) :: Y
257 elemental real(kind=8) function _gfortran_ieee_rem_4_8 (X, Y)
258 real(kind=4), intent(in) :: X
259 real(kind=8), intent(in) :: Y
261 elemental real(kind=8) function _gfortran_ieee_rem_8_4 (X, Y)
262 real(kind=8), intent(in) :: X
263 real(kind=4), intent(in) :: Y
265 elemental real(kind=8) function _gfortran_ieee_rem_8_8 (X, Y)
266 real(kind=8), intent(in) :: X
267 real(kind=8), intent(in) :: Y
272 procedure _gfortran_ieee_rem_4_4, _gfortran_ieee_rem_4_8, &
273 _gfortran_ieee_rem_8_4, _gfortran_ieee_rem_8_8
280 elemental real(kind=4) function _gfortran_ieee_rint_4 (X)
281 real(kind=4), intent(in) :: X
283 elemental real(kind=8) function _gfortran_ieee_rint_8 (X)
284 real(kind=8), intent(in) :: X
289 procedure _gfortran_ieee_rint_4, _gfortran_ieee_rint_8
296 elemental real(kind=4) function _gfortran_ieee_scalb_4 (X, I)
297 real(kind=4), intent(in) :: X
298 integer, intent(in) :: I
300 elemental real(kind=8) function _gfortran_ieee_scalb_8 (X, I)
301 real(kind=8), intent(in) :: X
302 integer, intent(in) :: I
307 procedure _gfortran_ieee_scalb_4, _gfortran_ieee_scalb_8
314 module procedure IEEE_VALUE_4, IEEE_VALUE_8
321 module procedure IEEE_CLASS_4, IEEE_CLASS_8
325 ! Public declarations for contained procedures
326 public :: IEEE_GET_ROUNDING_MODE, IEEE_SET_ROUNDING_MODE
327 public :: IEEE_GET_UNDERFLOW_MODE, IEEE_SET_UNDERFLOW_MODE
328 public :: IEEE_SELECTED_REAL_KIND
330 ! IEEE_SUPPORT_ROUNDING
332 interface IEEE_SUPPORT_ROUNDING
333 module procedure IEEE_SUPPORT_ROUNDING_4, IEEE_SUPPORT_ROUNDING_8, &
334 #ifdef HAVE_GFC_REAL_10
335 IEEE_SUPPORT_ROUNDING_10, &
337 #ifdef HAVE_GFC_REAL_16
338 IEEE_SUPPORT_ROUNDING_16, &
340 IEEE_SUPPORT_ROUNDING_NOARG
342 public :: IEEE_SUPPORT_ROUNDING
344 ! Interface to the FPU-specific function
346 pure integer function support_rounding_helper(flag) &
347 bind(c, name="_gfortrani_support_fpu_rounding_mode")
348 integer, intent(in), value :: flag
352 ! IEEE_SUPPORT_UNDERFLOW_CONTROL
354 interface IEEE_SUPPORT_UNDERFLOW_CONTROL
355 module procedure IEEE_SUPPORT_UNDERFLOW_CONTROL_4, &
356 IEEE_SUPPORT_UNDERFLOW_CONTROL_8, &
357 #ifdef HAVE_GFC_REAL_10
358 IEEE_SUPPORT_UNDERFLOW_CONTROL_10, &
360 #ifdef HAVE_GFC_REAL_16
361 IEEE_SUPPORT_UNDERFLOW_CONTROL_16, &
363 IEEE_SUPPORT_UNDERFLOW_CONTROL_NOARG
365 public :: IEEE_SUPPORT_UNDERFLOW_CONTROL
367 ! Interface to the FPU-specific function
369 pure integer function support_underflow_control_helper(kind) &
370 bind(c, name="_gfortrani_support_fpu_underflow_control")
371 integer, intent(in), value :: kind
375 ! IEEE_SUPPORT_* generic functions
377 #if defined(HAVE_GFC_REAL_10) && defined(HAVE_GFC_REAL_16)
378 # define MACRO1(NAME) NAME/**/_4, NAME/**/_8, NAME/**/_10, NAME/**/_16, NAME/**/_NOARG
379 #elif defined(HAVE_GFC_REAL_10)
380 # define MACRO1(NAME) NAME/**/_4, NAME/**/_8, NAME/**/_10, NAME/**/_NOARG
381 #elif defined(HAVE_GFC_REAL_16)
382 # define MACRO1(NAME) NAME/**/_4, NAME/**/_8, NAME/**/_16, NAME/**/_NOARG
384 # define MACRO1(NAME) NAME/**/_4, NAME/**/_8, NAME/**/_NOARG
387 #define SUPPORTGENERIC(NAME) \
388 interface NAME ; module procedure MACRO1(NAME) ; end interface ; \
391 SUPPORTGENERIC(IEEE_SUPPORT_DATATYPE)
392 SUPPORTGENERIC(IEEE_SUPPORT_DENORMAL)
393 SUPPORTGENERIC(IEEE_SUPPORT_DIVIDE)
394 SUPPORTGENERIC(IEEE_SUPPORT_INF)
395 SUPPORTGENERIC(IEEE_SUPPORT_IO)
396 SUPPORTGENERIC(IEEE_SUPPORT_NAN)
397 SUPPORTGENERIC(IEEE_SUPPORT_SQRT)
398 SUPPORTGENERIC(IEEE_SUPPORT_STANDARD)
402 ! Equality operators for IEEE_CLASS_TYPE and IEEE_ROUNDING_MODE
403 elemental logical function IEEE_CLASS_TYPE_EQ (X, Y) result(res)
405 type(IEEE_CLASS_TYPE), intent(in) :: X, Y
406 res = (X%hidden == Y%hidden)
409 elemental logical function IEEE_CLASS_TYPE_NE (X, Y) result(res)
411 type(IEEE_CLASS_TYPE), intent(in) :: X, Y
412 res = (X%hidden /= Y%hidden)
415 elemental logical function IEEE_ROUND_TYPE_EQ (X, Y) result(res)
417 type(IEEE_ROUND_TYPE), intent(in) :: X, Y
418 res = (X%hidden == Y%hidden)
421 elemental logical function IEEE_ROUND_TYPE_NE (X, Y) result(res)
423 type(IEEE_ROUND_TYPE), intent(in) :: X, Y
424 res = (X%hidden /= Y%hidden)
427 ! IEEE_SELECTED_REAL_KIND
428 integer function IEEE_SELECTED_REAL_KIND (P, R, RADIX) result(res)
430 integer, intent(in), optional :: P, R, RADIX
434 if (present(p)) p2 = p
435 if (present(r)) r2 = r
437 ! The only IEEE types we support right now are binary
438 if (present(radix)) then
445 ! Does IEEE float fit?
446 if (precision(0.) >= p2 .and. range(0.) >= r2) then
451 ! Does IEEE double fit?
452 if (precision(0.d0) >= p2 .and. range(0.d0) >= r2) then
457 if (precision(0.d0) < p2 .and. range(0.d0) < r2) then
462 if (precision(0.d0) < p2) then
473 elemental function IEEE_CLASS_4 (X) result(res)
475 real(kind=4), intent(in) :: X
476 type(IEEE_CLASS_TYPE) :: res
479 pure integer function _gfortrani_ieee_class_helper_4(val)
480 real(kind=4), intent(in) :: val
484 res = IEEE_CLASS_TYPE(_gfortrani_ieee_class_helper_4(X))
487 elemental function IEEE_CLASS_8 (X) result(res)
489 real(kind=8), intent(in) :: X
490 type(IEEE_CLASS_TYPE) :: res
493 pure integer function _gfortrani_ieee_class_helper_8(val)
494 real(kind=8), intent(in) :: val
498 res = IEEE_CLASS_TYPE(_gfortrani_ieee_class_helper_8(X))
503 elemental real(kind=4) function IEEE_VALUE_4(X, C) result(res)
505 real(kind=4), intent(in) :: X
506 type(IEEE_CLASS_TYPE), intent(in) :: C
508 select case (C%hidden)
509 case (1) ! IEEE_SIGNALING_NAN
512 case (2) ! IEEE_QUIET_NAN
515 case (3) ! IEEE_NEGATIVE_INF
518 case (4) ! IEEE_NEGATIVE_NORMAL
520 case (5) ! IEEE_NEGATIVE_DENORMAL
523 case (6) ! IEEE_NEGATIVE_ZERO
526 case (7) ! IEEE_POSITIVE_ZERO
528 case (8) ! IEEE_POSITIVE_DENORMAL
531 case (9) ! IEEE_POSITIVE_NORMAL
533 case (10) ! IEEE_POSITIVE_INF
536 case default ! IEEE_OTHER_VALUE, should not happen
541 elemental real(kind=8) function IEEE_VALUE_8(X, C) result(res)
543 real(kind=8), intent(in) :: X
544 type(IEEE_CLASS_TYPE), intent(in) :: C
546 select case (C%hidden)
547 case (1) ! IEEE_SIGNALING_NAN
550 case (2) ! IEEE_QUIET_NAN
553 case (3) ! IEEE_NEGATIVE_INF
556 case (4) ! IEEE_NEGATIVE_NORMAL
558 case (5) ! IEEE_NEGATIVE_DENORMAL
561 case (6) ! IEEE_NEGATIVE_ZERO
564 case (7) ! IEEE_POSITIVE_ZERO
566 case (8) ! IEEE_POSITIVE_DENORMAL
569 case (9) ! IEEE_POSITIVE_NORMAL
571 case (10) ! IEEE_POSITIVE_INF
574 case default ! IEEE_OTHER_VALUE, should not happen
580 ! IEEE_GET_ROUNDING_MODE
582 subroutine IEEE_GET_ROUNDING_MODE (ROUND_VALUE)
584 type(IEEE_ROUND_TYPE), intent(out) :: ROUND_VALUE
587 integer function helper() &
588 bind(c, name="_gfortrani_get_fpu_rounding_mode")
592 ROUND_VALUE = IEEE_ROUND_TYPE(helper())
596 ! IEEE_SET_ROUNDING_MODE
598 subroutine IEEE_SET_ROUNDING_MODE (ROUND_VALUE)
600 type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
603 subroutine helper(val) &
604 bind(c, name="_gfortrani_set_fpu_rounding_mode")
605 integer, value :: val
609 call helper(ROUND_VALUE%hidden)
613 ! IEEE_GET_UNDERFLOW_MODE
615 subroutine IEEE_GET_UNDERFLOW_MODE (GRADUAL)
617 logical, intent(out) :: GRADUAL
620 integer function helper() &
621 bind(c, name="_gfortrani_get_fpu_underflow_mode")
625 GRADUAL = (helper() /= 0)
629 ! IEEE_SET_UNDERFLOW_MODE
631 subroutine IEEE_SET_UNDERFLOW_MODE (GRADUAL)
633 logical, intent(in) :: GRADUAL
636 subroutine helper(val) &
637 bind(c, name="_gfortrani_set_fpu_underflow_mode")
638 integer, value :: val
642 call helper(merge(1, 0, GRADUAL))
645 ! IEEE_SUPPORT_ROUNDING
647 pure logical function IEEE_SUPPORT_ROUNDING_4 (ROUND_VALUE, X) result(res)
649 real(kind=4), intent(in) :: X
650 type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
651 res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
654 pure logical function IEEE_SUPPORT_ROUNDING_8 (ROUND_VALUE, X) result(res)
656 real(kind=8), intent(in) :: X
657 type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
658 res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
661 #ifdef HAVE_GFC_REAL_10
662 pure logical function IEEE_SUPPORT_ROUNDING_10 (ROUND_VALUE, X) result(res)
664 real(kind=10), intent(in) :: X
665 type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
670 #ifdef HAVE_GFC_REAL_16
671 pure logical function IEEE_SUPPORT_ROUNDING_16 (ROUND_VALUE, X) result(res)
673 real(kind=16), intent(in) :: X
674 type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
679 pure logical function IEEE_SUPPORT_ROUNDING_NOARG (ROUND_VALUE) result(res)
681 type(IEEE_ROUND_TYPE), intent(in) :: ROUND_VALUE
682 #if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
685 res = (support_rounding_helper(ROUND_VALUE%hidden) /= 0)
689 ! IEEE_SUPPORT_UNDERFLOW_CONTROL
691 pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_4 (X) result(res)
693 real(kind=4), intent(in) :: X
694 res = (support_underflow_control_helper(4) /= 0)
697 pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_8 (X) result(res)
699 real(kind=8), intent(in) :: X
700 res = (support_underflow_control_helper(8) /= 0)
703 #ifdef HAVE_GFC_REAL_10
704 pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_10 (X) result(res)
706 real(kind=10), intent(in) :: X
711 #ifdef HAVE_GFC_REAL_16
712 pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_16 (X) result(res)
714 real(kind=16), intent(in) :: X
719 pure logical function IEEE_SUPPORT_UNDERFLOW_CONTROL_NOARG () result(res)
721 #if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
724 res = (support_underflow_control_helper(4) /= 0 &
725 .and. support_underflow_control_helper(8) /= 0)
729 ! IEEE_SUPPORT_* functions
731 #define SUPPORTMACRO(NAME, INTKIND, VALUE) \
732 pure logical function NAME/**/_/**/INTKIND (X) result(res) ; \
734 real(INTKIND), intent(in) :: X(..) ; \
738 #define SUPPORTMACRO_NOARG(NAME, VALUE) \
739 pure logical function NAME/**/_NOARG () result(res) ; \
744 ! IEEE_SUPPORT_DATATYPE
746 SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,4,.true.)
747 SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,8,.true.)
748 #ifdef HAVE_GFC_REAL_10
749 SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,10,.false.)
751 #ifdef HAVE_GFC_REAL_16
752 SUPPORTMACRO(IEEE_SUPPORT_DATATYPE,16,.false.)
754 #if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
755 SUPPORTMACRO_NOARG(IEEE_SUPPORT_DATATYPE,.false.)
757 SUPPORTMACRO_NOARG(IEEE_SUPPORT_DATATYPE,.true.)
760 ! IEEE_SUPPORT_DENORMAL
762 SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,4,.true.)
763 SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,8,.true.)
764 #ifdef HAVE_GFC_REAL_10
765 SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,10,.false.)
767 #ifdef HAVE_GFC_REAL_16
768 SUPPORTMACRO(IEEE_SUPPORT_DENORMAL,16,.false.)
770 #if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
771 SUPPORTMACRO_NOARG(IEEE_SUPPORT_DENORMAL,.false.)
773 SUPPORTMACRO_NOARG(IEEE_SUPPORT_DENORMAL,.true.)
776 ! IEEE_SUPPORT_DIVIDE
778 SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,4,.true.)
779 SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,8,.true.)
780 #ifdef HAVE_GFC_REAL_10
781 SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,10,.false.)
783 #ifdef HAVE_GFC_REAL_16
784 SUPPORTMACRO(IEEE_SUPPORT_DIVIDE,16,.false.)
786 #if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
787 SUPPORTMACRO_NOARG(IEEE_SUPPORT_DIVIDE,.false.)
789 SUPPORTMACRO_NOARG(IEEE_SUPPORT_DIVIDE,.true.)
794 SUPPORTMACRO(IEEE_SUPPORT_INF,4,.true.)
795 SUPPORTMACRO(IEEE_SUPPORT_INF,8,.true.)
796 #ifdef HAVE_GFC_REAL_10
797 SUPPORTMACRO(IEEE_SUPPORT_INF,10,.false.)
799 #ifdef HAVE_GFC_REAL_16
800 SUPPORTMACRO(IEEE_SUPPORT_INF,16,.false.)
802 #if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
803 SUPPORTMACRO_NOARG(IEEE_SUPPORT_INF,.false.)
805 SUPPORTMACRO_NOARG(IEEE_SUPPORT_INF,.true.)
810 SUPPORTMACRO(IEEE_SUPPORT_IO,4,.true.)
811 SUPPORTMACRO(IEEE_SUPPORT_IO,8,.true.)
812 #ifdef HAVE_GFC_REAL_10
813 SUPPORTMACRO(IEEE_SUPPORT_IO,10,.false.)
815 #ifdef HAVE_GFC_REAL_16
816 SUPPORTMACRO(IEEE_SUPPORT_IO,16,.false.)
818 #if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
819 SUPPORTMACRO_NOARG(IEEE_SUPPORT_IO,.false.)
821 SUPPORTMACRO_NOARG(IEEE_SUPPORT_IO,.true.)
826 SUPPORTMACRO(IEEE_SUPPORT_NAN,4,.true.)
827 SUPPORTMACRO(IEEE_SUPPORT_NAN,8,.true.)
828 #ifdef HAVE_GFC_REAL_10
829 SUPPORTMACRO(IEEE_SUPPORT_NAN,10,.false.)
831 #ifdef HAVE_GFC_REAL_16
832 SUPPORTMACRO(IEEE_SUPPORT_NAN,16,.false.)
834 #if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
835 SUPPORTMACRO_NOARG(IEEE_SUPPORT_NAN,.false.)
837 SUPPORTMACRO_NOARG(IEEE_SUPPORT_NAN,.true.)
842 SUPPORTMACRO(IEEE_SUPPORT_SQRT,4,.true.)
843 SUPPORTMACRO(IEEE_SUPPORT_SQRT,8,.true.)
844 #ifdef HAVE_GFC_REAL_10
845 SUPPORTMACRO(IEEE_SUPPORT_SQRT,10,.false.)
847 #ifdef HAVE_GFC_REAL_16
848 SUPPORTMACRO(IEEE_SUPPORT_SQRT,16,.false.)
850 #if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
851 SUPPORTMACRO_NOARG(IEEE_SUPPORT_SQRT,.false.)
853 SUPPORTMACRO_NOARG(IEEE_SUPPORT_SQRT,.true.)
856 ! IEEE_SUPPORT_STANDARD
858 SUPPORTMACRO(IEEE_SUPPORT_STANDARD,4,.true.)
859 SUPPORTMACRO(IEEE_SUPPORT_STANDARD,8,.true.)
860 #ifdef HAVE_GFC_REAL_10
861 SUPPORTMACRO(IEEE_SUPPORT_STANDARD,10,.false.)
863 #ifdef HAVE_GFC_REAL_16
864 SUPPORTMACRO(IEEE_SUPPORT_STANDARD,16,.false.)
866 #if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
867 SUPPORTMACRO_NOARG(IEEE_SUPPORT_STANDARD,.false.)
869 SUPPORTMACRO_NOARG(IEEE_SUPPORT_STANDARD,.true.)
872 end module IEEE_ARITHMETIC