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 file contains procedures implementations of the module [pm_arrayMembership](@ref pm_arrayMembership).
19 : !>
20 : !> \finmain
21 : !>
22 : !> \author
23 : !> \FatemehBagheri, Wednesday 5:03 PM, August 11, 2021, Dallas, TX
24 :
25 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26 :
27 : ! Define size function.
28 : #if D0_D0_ENABLED
29 : #define GET_SIZE(x) len(x, kind = IK)
30 : #define GET_INDEX(i) i:i
31 : #elif D0_D1_ENABLED || D1_D1_ENABLED
32 : #define GET_INDEX(i) i
33 : #define GET_SIZE(x) size(x, kind = IK)
34 : #else
35 : #error "Unrecognized interface."
36 : #endif
37 : ! Define equivalence check operator.
38 : #if LK_ENABLED
39 : #define IS_NEQ .neqv.
40 : #elif SK_ENABLED || IK_ENABLED || CK_ENABLED || RK_ENABLED
41 : #define IS_NEQ /=
42 : #else
43 : #error "Unrecognized interface."
44 : #endif
45 : ! Define comparison check operators.
46 : #if SK_ENABLED || IK_ENABLED || RK_ENABLED
47 : #define IS_LESS(a, b) a < b
48 : #define IS_MORE(a, b) a > b
49 : #elif LK_ENABLED
50 : #define IS_LESS(a, b) .not. a .and. b
51 : #define IS_MORE(a, b) a .and. .not. b
52 : #elif CK_ENABLED
53 : #define IS_LESS(a, b) (a%re < b%re .or. (a%re == b%re .and. a%im < b%im))
54 : #define IS_MORE(a, b) (a%re > b%re .or. (a%re == b%re .and. a%im > b%im))
55 : #else
56 : #error "Unrecognized interface."
57 : #endif
58 :
59 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
60 : #if in_ENABLED && (D0_D0_ENABLED || D1_D1_ENABLED)
61 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
62 :
63 : integer(IK) :: i, j, lenVal, lenSet
64 : lenVal = GET_SIZE(val)
65 7 : lenSet = GET_SIZE(set)
66 32 : loopVal: do i = 1, lenVal
67 190 : loopSet: do j = 1, lenSet
68 179 : if (set(GET_INDEX(j)) IS_NEQ val(GET_INDEX(i))) cycle loopSet
69 14 : member(i) = .true._LK
70 190 : cycle loopVal
71 : end do loopSet
72 18 : member(i) = .false._LK
73 : end do loopVal
74 :
75 : !%%%%%%%%%%%%%%%%%%%%%%%%%%
76 : #elif in_ENABLED && D0_D1_ENABLED
77 : !%%%%%%%%%%%%%%%%%%%%%%%%%%
78 :
79 : integer(IK) :: j, lenSet
80 39 : lenSet = GET_SIZE(set)
81 177 : do j = 1, lenSet
82 175 : if (set(j) IS_NEQ val) cycle
83 : member = .true._LK
84 140 : return
85 : end do
86 : member = .false._LK
87 :
88 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
89 : #elif inrange_ENABLED && (D0_D0_ENABLED || D1_D1_ENABLED)
90 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
91 :
92 : integer(IK) :: i, lenVal
93 : lenVal = GET_SIZE(val)
94 34 : do i = 1, lenVal
95 45 : member(i) = .not. logical(IS_LESS(val(GET_INDEX(i)), set(GET_INDEX(1))) .or. IS_MORE(val(GET_INDEX(i)), set(GET_INDEX(2))), LK)
96 : end do
97 :
98 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
99 : #elif inrange_ENABLED && D0_D1_ENABLED
100 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
101 :
102 16005 : member = .not. logical(IS_LESS(val, set(1)) .or. IS_MORE(val, set(2)), LK)
103 :
104 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
105 : #elif allin_ENABLED && (D0_D0_ENABLED || D1_D1_ENABLED)
106 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
107 :
108 : integer(IK) :: i, j, lenVal, lenSet
109 16170 : lenVal = GET_SIZE(val)
110 16170 : lenSet = GET_SIZE(Set)
111 60749 : loopVal: do i = 1, lenVal
112 129203 : loopSet: do j = 1, lenSet
113 129195 : if (Set(GET_INDEX(j)) IS_NEQ val(GET_INDEX(i))) cycle loopSet
114 84624 : cycle loopVal
115 : end do loopSet
116 : allMember = .false._LK
117 16162 : return
118 : end do loopVal
119 : allMember = .true._LK
120 :
121 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
122 : #elif allinrange_ENABLED && (D0_D0_ENABLED || D1_D1_ENABLED)
123 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
124 :
125 : integer(IK) :: i, lenVal
126 7612 : lenVal = GET_SIZE(val)
127 22829 : do i = 1, lenVal
128 22829 : if (IS_LESS(val(GET_INDEX(i)), Set(GET_INDEX(1))) .or. IS_MORE(val(GET_INDEX(i)), Set(GET_INDEX(2)))) then
129 : allMember = .false._LK
130 : return
131 : end if
132 : end do
133 : allMember = .true._LK
134 :
135 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
136 : #elif anyin_ENABLED && (D0_D0_ENABLED || D1_D1_ENABLED)
137 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
138 :
139 : integer(IK) :: i, j, lenVal, lenSet
140 12 : lenVal = GET_SIZE(val)
141 12 : lenSet = GET_SIZE(Set)
142 19 : loopVal: do i = 1, lenVal
143 100 : loopSet: do j = 1, lenSet
144 91 : if (Set(GET_INDEX(j)) IS_NEQ val(GET_INDEX(i))) cycle loopSet
145 : anyMember = .true._LK
146 88 : return
147 : end do loopSet
148 : end do loopVal
149 : anyMember = .false._LK
150 :
151 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
152 : #elif anyinrange_ENABLED && (D0_D0_ENABLED || D1_D1_ENABLED)
153 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
154 :
155 : integer(IK) :: i, lenVal
156 12 : lenVal = GET_SIZE(val)
157 15 : do i = 1, lenVal
158 15 : if (IS_LESS(val(GET_INDEX(i)), Set(GET_INDEX(1))) .or. IS_MORE(val(GET_INDEX(i)), Set(GET_INDEX(2)))) cycle
159 : anyMember = .true._LK
160 3 : return
161 : end do
162 : anyMember = .false._LK
163 :
164 : #else
165 : !%%%%%%%%%%%%%%%%%%%%%%%%
166 : #error "Unrecognized interface."
167 : !%%%%%%%%%%%%%%%%%%%%%%%%
168 : #endif
169 :
170 : #undef GET_INDEX
171 : #undef GET_SIZE
172 : #undef IS_LESS
173 : #undef IS_MORE
174 : #undef IS_NEQ
|
