I have posted on GitHub some functions for checking Inf/NaN, which aim to work even when compilers are invoked with aggressive optimization flags, such as gfortran -Ofast
.
There are many ways to implement functions like is_nan
. However, not all of them work with aggressive optimization flags. For example, there are such discussions on StackOverflow.
In addition, some compilers are buggy concerning the return type of ieee_is_nan
when some special compilation options are imposed, as has been discussed here on Fortran Discourse.
My choice of implementation is totally empirical, in the sense that I have not studied in-depth what the aggressive optimization flags really do, but only made some tests and found some implementation that worked correctly. In other words, I do not know why my implementation works but other implementations may not. The story may change when compilers are changed/updated.
The good news is, I have tested the functions on 9 compilers with the most aggressive optimization flags that I can figure out, all of which are happy. In particular, the functions work well with gfortran -Ofast
(gfortran
version 9.3.0), but those based on ieee_arithmetic
fail. Given the fact that -Ofast
implies -ffinite-math-only
, we cannot blame ieee_arithmetic
for the failure; instead, I am surprised by the success of my implementation under such an option.
You may try them if you are interested. The GitHub repository includes some simple tests in test/testinfnan.f90.
For your convenience, I copy-paste the functions below. More details can be found on GitHub.
! consts.f90
module consts_mod
implicit none
private
public :: SP, DP
integer, parameter :: SP = kind(0.0)
integer, parameter :: DP = kind(0.0D0)
end module consts_mod
! infnan.f90
module infnan_mod
use consts_mod, only : SP, DP
implicit none
private
public :: is_nan, is_finite, is_inf, is_posinf, is_neginf
interface is_nan
module procedure is_nan_sp, is_nan_dp
end interface is_nan
interface is_finite
module procedure is_finite_sp, is_finite_dp
end interface is_finite
interface is_posinf
module procedure is_posinf_sp, is_posinf_dp
end interface is_posinf
interface is_neginf
module procedure is_neginf_sp, is_neginf_dp
end interface is_neginf
interface is_inf
module procedure is_inf_sp, is_inf_dp
end interface is_inf
contains
elemental pure function is_nan_sp(x) result(y)
implicit none
real(SP), intent(in) :: x
logical :: y
y = (.not. (x <= huge(x) .and. x >= -huge(x))) .and. (.not. abs(x) > huge(x))
end function is_nan_sp
elemental pure function is_nan_dp(x) result(y)
implicit none
real(DP), intent(in) :: x
logical :: y
y = (.not. (x <= huge(x) .and. x >= -huge(x))) .and. (.not. abs(x) > huge(x))
end function is_nan_dp
elemental pure function is_finite_sp(x) result(y)
implicit none
real(SP), intent(in) :: x
logical :: y
y = (x <= huge(x) .and. x >= -huge(x))
end function is_finite_sp
elemental pure function is_finite_dp(x) result(y)
implicit none
real(DP), intent(in) :: x
logical :: y
y = (x <= huge(x) .and. x >= -huge(x))
end function is_finite_dp
elemental pure function is_inf_sp(x) result(y)
implicit none
real(SP), intent(in) :: x
logical :: y
y = (abs(x) > huge(x))
end function is_inf_sp
elemental pure function is_inf_dp(x) result(y)
implicit none
real(DP), intent(in) :: x
logical :: y
y = (abs(x) > huge(x))
end function is_inf_dp
elemental pure function is_posinf_sp(x) result(y)
implicit none
real(SP), intent(in) :: x
logical :: y
y = (abs(x) > huge(x)) .and. (x > 0)
end function is_posinf_sp
elemental pure function is_posinf_dp(x) result(y)
implicit none
real(DP), intent(in) :: x
logical :: y
y = (abs(x) > huge(x)) .and. (x > 0)
end function is_posinf_dp
elemental pure function is_neginf_sp(x) result(y)
implicit none
real(SP), intent(in) :: x
logical :: y
y = (abs(x) > huge(x)) .and. (x < 0)
end function is_neginf_sp
elemental pure function is_neginf_dp(x) result(y)
implicit none
real(DP), intent(in) :: x
logical :: y
y = (abs(x) > huge(x)) .and. (x < 0)
end function is_neginf_dp
end module infnan_mod
Any comments, suggestions, or criticism will be appreciated. Thank you very much for your attention!