| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | module finite_check | ||
| 2 | !> Finiteness test and quiet NaN without the IEEE intrinsic modules. | ||
| 3 | !> | ||
| 4 | !> gfortran saves and restores the floating-point environment on entry to and | ||
| 5 | !> exit from every procedure whose scope accesses an IEEE intrinsic module, | ||
| 6 | !> including through a procedure-local USE of any module that imports one. | ||
| 7 | !> In the orbit-tracing loop this cost up to 17% of the run time. The | ||
| 8 | !> exponent-bit test below is exact for IEEE binary64 and is unaffected by | ||
| 9 | !> -ffast-math, which may fold x /= x comparisons. | ||
| 10 | use, intrinsic :: iso_fortran_env, only: dp => real64, int64 | ||
| 11 | implicit none | ||
| 12 | private | ||
| 13 | public :: is_finite, quiet_nan | ||
| 14 | |||
| 15 | integer(int64), parameter :: EXPONENT_MASK = 2047_int64 | ||
| 16 | integer(int64), parameter :: QUIET_NAN_BITS = 9221120237041090560_int64 | ||
| 17 | |||
| 18 | contains | ||
| 19 | |||
| 20 | 1473882860 | elemental logical function is_finite(x) | |
| 21 | real(dp), intent(in) :: x | ||
| 22 | |||
| 23 | is_finite = iand(shiftr(transfer(x, 0_int64), 52), EXPONENT_MASK) & | ||
| 24 | 1473882860 | /= EXPONENT_MASK | |
| 25 | 1473882860 | end function is_finite | |
| 26 | |||
| 27 | 301119 | pure real(dp) function quiet_nan() | |
| 28 | 301119 | quiet_nan = transfer(QUIET_NAN_BITS, 1.0_dp) | |
| 29 | 301119 | end function quiet_nan | |
| 30 | |||
| 31 | end module finite_check | ||
| 32 |