Checking Inf/NaN when compilers are invoked with aggressive optimization flags

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!

3 Likes

Thank you very much!
So a simply question, for ‘release’ code, what flags do you suggest?

-O3 -march-native

is the above flag OK?
In my shallow experience, gfortran with the above flags almost always performs similar speed and same results with Intel Fortran with -O3 -xHost -heaparray -ipo
Although I almost always use Intel Fortran. gfortran for me is mostly just for testing.

My knowledge about the options is quite limited. I suppose the best information source would be the official document of gfortran.

-O3 seems OK, but combining it with -ffast-math is aggressive. In my tests, some naive implementations of is_nan work with -O3 or -ffast-math separately, but not when both are imposed.