Line data Source code
1 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3 : !!!! !!!!
4 : !!!! ParaMonte: Parallel Monte Carlo and Machine Learning Library. !!!!
5 : !!!! !!!!
6 : !!!! Copyright (C) 2012-present, The Computational Data Science Lab !!!!
7 : !!!! !!!!
8 : !!!! This file is part of the ParaMonte library. !!!!
9 : !!!! !!!!
10 : !!!! LICENSE !!!!
11 : !!!! !!!!
12 : !!!! https://github.com/cdslaborg/paramonte/blob/main/LICENSE.md !!!!
13 : !!!! !!!!
14 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
16 :
17 : !> \brief
18 : !> This include file contains implementations of the procedures in module [pm_except](@ref pm_except).
19 : !>
20 : !> \finmain
21 : !>
22 : !> \author
23 : !> \FatemehBagheri, Sunday 11:23 PM, September 19, 2021, Dallas, TX
24 :
25 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26 :
27 : ! Define zero.
28 : #if IK_ENABLED
29 : integer(IKC), parameter :: ZERO = 0_IKC, MINMAX = huge(0_IKC)
30 : #elif CK_ENABLED
31 : use pm_complexCompareAny, only: operator(<)
32 : complex(CKC), parameter :: ZERO = (0._CKC, 0._CKC), MINMAX = huge(0._CKC)
33 : #elif RK_ENABLED
34 : real(RKC) , parameter :: ZERO = 0._RKC, MINMAX = huge(0._RKC)
35 : #else
36 : #error "Unrecognized interface."
37 : #endif
38 : !%%%%%%%%%%%%%%%%%%%%%%
39 : #if isAddOutflowPos_ENABLED
40 : !%%%%%%%%%%%%%%%%%%%%%%
41 :
42 28 : outflow = logical(ZERO < a .and. ZERO < b, LK)
43 14 : if (outflow) outflow = logical(+MINMAX - a < b, LK)
44 :
45 : !%%%%%%%%%%%%%%%%%%%%%%
46 : #elif isAddOutflowNeg_ENABLED
47 : !%%%%%%%%%%%%%%%%%%%%%%
48 :
49 24 : outflow = logical(a < ZERO .and. b < ZERO, LK)
50 6 : if (outflow) outflow = logical(b < -MINMAX - a, LK)
51 :
52 : !%%%%%%%%%%%%%%%%%%%
53 : #elif isAddOutflow_ENABLED
54 : !%%%%%%%%%%%%%%%%%%%
55 :
56 14 : outflow = isAddOutflowPos(a, b) .or. isAddOutflowNeg(a, b)
57 :
58 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
59 : #elif RK_ENABLED && (getInfPos_ENABLED || setInfPos_ENABLED)
60 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
61 :
62 931 : infPos = ieee_value(infPos, ieee_positive_inf)
63 :
64 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
65 : #elif RK_ENABLED && (getInfNeg_ENABLED || setInfNeg_ENABLED)
66 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
67 :
68 949 : infNeg = ieee_value(infNeg, ieee_negative_inf)
69 :
70 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
71 : #elif CK_ENABLED && (getInfPos_ENABLED || setInfPos_ENABLED)
72 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
73 :
74 839 : infPos%re = ieee_value(infPos%re, ieee_positive_inf)
75 839 : infPos%im = ieee_value(infPos%im, ieee_positive_inf)
76 :
77 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
78 : #elif CK_ENABLED && (getInfNeg_ENABLED || setInfNeg_ENABLED)
79 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
80 :
81 901 : infNeg%re = ieee_value(infNeg%re, ieee_negative_inf)
82 901 : infNeg%im = ieee_value(infNeg%im, ieee_negative_inf)
83 :
84 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
85 : #elif RK_ENABLED && isInfPos_ENABLED
86 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
87 :
88 14664683 : infPos = .not. (ieee_is_finite(x) .or. ieee_is_negative(x))
89 :
90 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
91 : #elif RK_ENABLED && isInfNeg_ENABLED
92 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
93 :
94 14657772 : infNeg = ieee_is_negative(x) .and. .not. ieee_is_finite(x)
95 :
96 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
97 : #elif CK_ENABLED && isInfPos_ENABLED
98 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
99 :
100 4957965 : infPos = isInfPos(x%re) .or. isInfPos(x%im)
101 : !infPos = .not. ( (ieee_is_finite(x%re) .or. ieee_is_negative(x%re)) .and. (ieee_is_finite(x%im) .or. ieee_is_negative(x%im)) )
102 :
103 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
104 : #elif CK_ENABLED && isInfNeg_ENABLED
105 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
106 :
107 4955606 : infNeg = isInfNeg(x%re) .or. isInfNeg(x%im)
108 : !infNeg = (ieee_is_negative(x%re) .and. .not. ieee_is_finite(x%re)) .or. (ieee_is_negative(x%im) .and. .not. ieee_is_finite(x%im))
109 :
110 : !%%%%%%%%%%%%
111 : #elif isInf_ENABLED
112 : !%%%%%%%%%%%%
113 :
114 9703436 : inf = isInfPos(x) .or. isInfNeg(x)
115 :
116 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
117 : #elif CK_ENABLED && (getNAN_ENABLED || setNAN_ENABLED)
118 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
119 :
120 880 : nan%re = ieee_value(nan%re, ieee_quiet_nan)
121 880 : nan%im = ieee_value(nan%im, ieee_quiet_nan)
122 :
123 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
124 : #elif RK_ENABLED && (getNAN_ENABLED || setNAN_ENABLED)
125 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
126 :
127 : !real, parameter :: NAN = transfer(2143289344_IK, 1.) This works only on i686 and x86_64 arch.
128 15471 : nan = ieee_value(nan, ieee_quiet_nan)
129 :
130 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
131 : #elif isNAN_ENABLED && IEEE_ENABLED && CK_ENABLED
132 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
133 :
134 4956377 : isNotANumber = ieee_is_nan(x%re) .or. ieee_is_nan(x%im)
135 :
136 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
137 : #elif isNAN_ENABLED && IEEE_ENABLED && RK_ENABLED
138 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
139 :
140 4763825 : isNotANumber = ieee_is_nan(x)
141 :
142 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%
143 : #elif isNAN_ENABLED && XNEQ_ENABLED
144 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%
145 :
146 0 : isNotANumber = logical(x /= xcopy, LK)
147 :
148 : #else
149 : !%%%%%%%%%%%%%%%%%%%%%%%%
150 : #error "Unrecognized interface."
151 : !%%%%%%%%%%%%%%%%%%%%%%%%
152 : #endif
|
