-
Notifications
You must be signed in to change notification settings - Fork 0
/
ieee_4dev.f90
51 lines (37 loc) · 1.46 KB
/
ieee_4dev.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
module ieee_4dev_mod
!--------------------------------------------------------------------------------------------------!
! This module makes some components of IEEE_ARITHMETIC available. Only for development and tests.
!
! Coded by Zaikun ZHANG (www.zhangzk.net).
!
! Started: July 2020
!
! Last Modified: Monday, March 14, 2022 PM02:40:12
!--------------------------------------------------------------------------------------------------!
use, intrinsic :: IEEE_ARITHMETIC, only : IEEE_VALUE, &
& IEEE_QUIET_NAN, IEEE_SIGNALING_NAN, IEEE_POSITIVE_INF, IEEE_NEGATIVE_INF
use, non_intrinsic :: consts_mod, only : RP
implicit none
private
public :: ieeenan, ieeenan_q, ieeenan_s, ieeeinf, ieeeinf_p, ieeeinf_n
contains
pure real(RP) function ieeenan()
ieeenan = IEEE_VALUE(1.0_RP, IEEE_QUIET_NAN)
!ieeenan = IEEE_VALUE(1.0_RP, IEEE_SIGNALING_NAN) ! Singling NaN can trigger an "floating invalid" error
end function ieeenan
pure real(RP) function ieeenan_q()
ieeenan_q = IEEE_VALUE(1.0_RP, IEEE_QUIET_NAN)
end function ieeenan_q
pure real(RP) function ieeenan_s()
ieeenan_s = IEEE_VALUE(1.0_RP, IEEE_SIGNALING_NAN)
end function ieeenan_s
pure real(RP) function ieeeinf()
ieeeinf = IEEE_VALUE(1.0_RP, IEEE_POSITIVE_INF)
end function ieeeinf
pure real(RP) function ieeeinf_p()
ieeeinf_p = IEEE_VALUE(1.0_RP, IEEE_POSITIVE_INF)
end function ieeeinf_p
pure real(RP) function ieeeinf_n()
ieeeinf_n = IEEE_VALUE(1.0_RP, IEEE_NEGATIVE_INF)
end function ieeeinf_n
end module ieee_4dev_mod