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 module contains implementations of the tests of the procedures under the generic interfaces
19 : !> [getBin](@ref pm_arraySearch::getBin).
20 : !>
21 : !> \fintest
22 : !>
23 : !> \author
24 : !> \AmirShahmoradi, September 1, 2017, 11:35 PM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
25 :
26 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
27 :
28 : #if SK_ENABLED && D0_ENABLED
29 : #define GET_SIZE len
30 : #else
31 : #define GET_SIZE size
32 : #endif
33 :
34 : #if LK_ENABLED && D1_ENABLED
35 : #define IS_EQUAL .eqv.
36 : #else
37 : #define IS_EQUAL ==
38 : #endif
39 :
40 : use pm_val2str, only: getStr
41 : use pm_arraySort, only: setSorted
42 :
43 : character(*, SK), parameter :: PROCEDURE_NAME = "@getBin()"
44 :
45 : #if SK_ENABLED && D0_ENABLED
46 1 : character(:,SKC) , allocatable :: Array
47 1 : character(:,SKC) , allocatable :: value
48 : #elif SK_ENABLED && D1_ENABLED
49 : character(2,SKC), dimension(:), allocatable :: Array
50 : character(2,SKC) :: value
51 : #elif IK_ENABLED && D1_ENABLED
52 : integer(IKC) , dimension(:), allocatable :: Array
53 : integer(IKC) :: value
54 : #elif LK_ENABLED && D1_ENABLED
55 : logical(LKC) , dimension(:), allocatable :: Array
56 : logical(LKC) :: value
57 : #elif CK_ENABLED && D1_ENABLED
58 : complex(CKC) , dimension(:), allocatable :: Array
59 : complex(CKC) :: value
60 : #elif RK_ENABLED && D1_ENABLED
61 : real(RKC) , dimension(:), allocatable :: Array
62 : real(RKC) :: value
63 : #else
64 : #error "Unrecognized interface."
65 : #endif
66 : integer(IK) :: index
67 : integer(IK) :: index_ref
68 :
69 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
70 :
71 15 : assertion = .true._LK
72 :
73 15 : call runTestsWith()
74 15 : call runTestsWith(isLess = isLess)
75 :
76 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
77 :
78 : contains
79 :
80 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
81 :
82 429 : function isLess(value, segment) result(less)
83 : use pm_complexCompareLex, only: operator(<)
84 : #if SK_ENABLED && D0_ENABLED || SK_ENABLED && D1_ENABLED
85 : character(*,SKC), intent(in) :: value, segment
86 : #elif IK_ENABLED && D1_ENABLED
87 : integer(IKC) , intent(in) :: value, segment
88 : #elif CK_ENABLED && D1_ENABLED
89 : complex(CKC) , intent(in) :: value, segment
90 : #elif RK_ENABLED && D1_ENABLED
91 : real(RKC) , intent(in) :: value, segment
92 : #elif LK_ENABLED && D1_ENABLED
93 : logical(LKC) , intent(in) :: value, segment
94 : #endif
95 : logical(LK) :: less
96 429 : less = value < segment
97 429 : end function
98 :
99 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
100 :
101 : subroutine reset()
102 227 : if (allocated(Array)) deallocate(Array)
103 : end subroutine reset
104 :
105 :
106 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
107 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
108 :
109 30 : subroutine runTestsWith(isLess)
110 : logical(LK), external, optional :: isLess
111 :
112 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
113 :
114 : call reset()
115 :
116 : #if SK_ENABLED && D0_ENABLED
117 2 : Array = SKC_"abcdefgh"
118 2 : value = SKC_" "
119 : #elif SK_ENABLED && D1_ENABLED
120 20 : Array = ["aa", "bb", "cc", "dd", "ee", "ff", "gg", "hh"]
121 2 : value = " "
122 : #elif IK_ENABLED && D1_ENABLED
123 100 : Array = int([1,2,3,4,5,6,7,8], kind = IKC)
124 10 : value = 0_IKC
125 : #elif CK_ENABLED && D1_ENABLED
126 80 : Array = cmplx([1,2,3,4,5,6,7,8], [1,2,3,4,5,6,7,8], kind = CKC)
127 8 : value = cmplx(0, kind = CKC)
128 : #elif RK_ENABLED && D1_ENABLED
129 80 : Array = real([1,2,3,4,5,6,7,8], kind = RKC)
130 8 : value = 0._RKC
131 : #endif
132 30 : index_ref = 0_IK
133 :
134 30 : call report(isLess)
135 30 : call test%assert(assertion, PROCEDURE_NAME//SK_": A value that is less than all elements of Array, has `index = 0_IK`.", int(__LINE__, IK))
136 :
137 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
138 :
139 : call reset()
140 :
141 : #if SK_ENABLED && D0_ENABLED
142 2 : Array = "acegikmo"
143 2 : value = "a"
144 : #elif SK_ENABLED && D1_ENABLED
145 20 : Array = ["aa", "cc", "ee", "gg", "ii", "kk", "mm", "oo"]
146 2 : value = "aa"
147 : #elif IK_ENABLED && D1_ENABLED
148 100 : Array = int([1,2,4,6,8,10,12,14], kind = IKC)
149 10 : value = 1_IKC
150 : #elif CK_ENABLED && D1_ENABLED
151 80 : Array = cmplx([1,2,4,6,8,10,12,14], -[1,2,4,6,8,10,12,14], kind = CKC)
152 8 : value = cmplx(1, -1, kind = CKC)
153 : #elif RK_ENABLED && D1_ENABLED
154 80 : Array = real([1,2,4,6,8,10,12,14], kind = RKC)
155 8 : value = 1._RKC
156 : #endif
157 30 : index_ref = 1_IK
158 :
159 30 : call report(isLess)
160 30 : call test%assert(assertion, PROCEDURE_NAME//SK_": A value that is equal to the first element of Array, has `index = 1_IK`.", int(__LINE__, IK))
161 :
162 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
163 :
164 : call reset()
165 :
166 : #if SK_ENABLED && D0_ENABLED
167 2 : Array = "acegikmo"
168 2 : value = "b"
169 : #elif SK_ENABLED && D1_ENABLED
170 20 : Array = ["aa", "cc", "ee", "gg", "ii", "kk", "mm", "oo"]
171 2 : value = "bb"
172 : #elif IK_ENABLED && D1_ENABLED
173 100 : Array = int([0,2,4,6,8,10,12,14], kind = IKC)
174 10 : value = 1_IKC
175 : #elif CK_ENABLED && D1_ENABLED
176 80 : Array = cmplx([0,2,4,6,8,10,12,14], -[0,2,4,6,8,10,12,14], kind = CKC)
177 8 : value = cmplx(1, 5, kind = CKC)
178 : #elif RK_ENABLED && D1_ENABLED
179 80 : Array = real([0,2,4,6,8,10,12,14], kind = RKC)
180 8 : value = 1._RKC
181 : #endif
182 30 : index_ref = 1_IK
183 :
184 30 : call report(isLess)
185 30 : call test%assert(assertion, PROCEDURE_NAME//SK_": A value that is between the first two elements of Array, has `index = 1_IK`.", int(__LINE__, IK))
186 :
187 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
188 :
189 : call reset()
190 :
191 : #if SK_ENABLED && D0_ENABLED
192 2 : Array = "acegikmo"
193 2 : value = "c"
194 : #elif SK_ENABLED && D1_ENABLED
195 20 : Array = ["aa", "cc", "ee", "gg", "ii", "kk", "mm", "oo"]
196 2 : value = "cc"
197 : #elif IK_ENABLED && D1_ENABLED
198 100 : Array = int([0,2,4,6,8,10,12,14], kind = IKC)
199 10 : value = 2_IKC
200 : #elif CK_ENABLED && D1_ENABLED
201 80 : Array = cmplx([0,2,4,6,8,10,12,14], -[0,2,4,6,8,10,12,14], kind = CKC)
202 8 : value = cmplx(2, 2, kind = CKC)
203 : #elif RK_ENABLED && D1_ENABLED
204 80 : Array = real([0,2,4,6,8,10,12,14], kind = RKC)
205 8 : value = 2._RKC
206 : #endif
207 30 : index_ref = 2_IK
208 :
209 30 : call report(isLess)
210 30 : call test%assert(assertion, PROCEDURE_NAME//SK_": A value that is equal to the second element of Array, has `index = 2_IK`.", int(__LINE__, IK))
211 :
212 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
213 :
214 : call reset()
215 :
216 : #if SK_ENABLED && D0_ENABLED
217 2 : Array = "acegikm"
218 2 : value = "c"
219 : #elif SK_ENABLED && D1_ENABLED
220 18 : Array = ["aa", "cc", "ee", "gg", "ii", "kk", "mm"]
221 2 : value = "cc"
222 : #elif IK_ENABLED && D1_ENABLED
223 90 : Array = int([0,2,4,6,8,10,12], kind = IKC)
224 10 : value = 2_IKC
225 : #elif CK_ENABLED && D1_ENABLED
226 72 : Array = cmplx([0,2,4,6,8,10,12], -[0,2,4,6,8,10,12], kind = CKC)
227 8 : value = cmplx(2, -2, kind = CKC)
228 : #elif RK_ENABLED && D1_ENABLED
229 72 : Array = real([0,2,4,6,8,10,12], kind = RKC)
230 8 : value = 2._RKC
231 : #endif
232 30 : index_ref = 2_IK
233 :
234 30 : call report(isLess)
235 30 : call test%assert(assertion, PROCEDURE_NAME//SK_": A value that is equal to the second element of Array, has `index = 2_IK`.", int(__LINE__, IK))
236 :
237 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
238 :
239 : call reset()
240 :
241 : #if SK_ENABLED && D0_ENABLED
242 2 : Array = "acegikm"
243 2 : value = "k"
244 : #elif SK_ENABLED && D1_ENABLED
245 18 : Array = ["aa", "cc", "ee", "gg", "ii", "kk", "mm"]
246 2 : value = "kk"
247 : #elif IK_ENABLED && D1_ENABLED
248 90 : Array = int([0,2,4,6,8,10,12], kind = IKC)
249 10 : value = 10_IKC
250 : #elif CK_ENABLED && D1_ENABLED
251 72 : Array = cmplx([0,2,4,6,8,10,12], -[0,2,4,6,8,10,12], kind = CKC)
252 8 : value = cmplx(10, -2, kind = CKC)
253 : #elif RK_ENABLED && D1_ENABLED
254 72 : Array = real([0,2,4,6,8,10,12], kind = RKC)
255 8 : value = 10._RKC
256 : #endif
257 30 : index_ref = 6_IK
258 :
259 30 : call report(isLess)
260 30 : call test%assert(assertion, PROCEDURE_NAME//SK_": A value that is equal to the second element of Array, has `index = 2_IK`.", int(__LINE__, IK))
261 :
262 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
263 :
264 : call reset()
265 :
266 : #if SK_ENABLED && D0_ENABLED
267 2 : Array = "acegikmo"
268 2 : value = "o"
269 : #elif SK_ENABLED && D1_ENABLED
270 20 : Array = ["aa", "cc", "ee", "gg", "ii", "kk", "mm", "oo"]
271 2 : value = "oo"
272 : #elif IK_ENABLED && D1_ENABLED
273 100 : Array = int([0,2,4,6,8,10,12,14], kind = IKC)
274 10 : value = 14_IKC
275 : #elif CK_ENABLED && D1_ENABLED
276 80 : Array = cmplx([0,2,4,6,8,10,12,14], -[0,2,4,6,8,10,12,14], kind = CKC)
277 8 : value = cmplx(14, 3, kind = CKC)
278 : #elif RK_ENABLED && D1_ENABLED
279 80 : Array = real([0,2,4,6,8,10,12,14], kind = RKC)
280 8 : value = 14._RKC
281 : #endif
282 30 : index_ref = GET_SIZE(Array, kind = IK)
283 :
284 30 : call report(isLess)
285 30 : call test%assert(assertion, PROCEDURE_NAME//SK_": A value that is equal to the last element of Array, has `index = size(Array)`.", int(__LINE__, IK))
286 :
287 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
288 :
289 : call reset()
290 :
291 : #if SK_ENABLED && D0_ENABLED
292 2 : Array = "acegikmo"
293 2 : value = "z"
294 : #elif SK_ENABLED && D1_ENABLED
295 20 : Array = ["aa", "cc", "ee", "gg", "ii", "kk", "mm", "oo"]
296 2 : value = "oz"
297 : #elif IK_ENABLED && D1_ENABLED
298 100 : Array = int([0,2,4,6,8,10,12,14], kind = IKC)
299 10 : value = 20_IKC
300 : #elif CK_ENABLED && D1_ENABLED
301 80 : Array = cmplx([0,2,4,6,8,10,12,14], [0,2,4,6,8,10,12,14]**2, kind = CKC)
302 8 : value = cmplx(20, -5, kind = CKC)
303 : #elif RK_ENABLED && D1_ENABLED
304 80 : Array = real([0,2,4,6,8,10,12,14], kind = RKC)
305 8 : value = 20._RKC
306 : #endif
307 30 : index_ref = GET_SIZE(Array, kind = IK)
308 :
309 30 : call report(isLess)
310 30 : call test%assert(assertion, PROCEDURE_NAME//SK_": A value that is larger than element of Array, has `index = size(Array)`.", int(__LINE__, IK))
311 :
312 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
313 :
314 : #if SK_ENABLED && D0_ENABLED
315 : call reset()
316 :
317 2 : Array = "acegikmo"
318 :
319 2 : value = "cg"
320 2 : index_ref = 2_IK
321 2 : call report(isLess)
322 2 : call test%assert(assertion, PROCEDURE_NAME//SK_": A character value """//getStr(value)//""" has `index = 2_IK`.", int(__LINE__, IK))
323 :
324 2 : value = "ca"
325 2 : index_ref = 1_IK
326 2 : call report(isLess)
327 2 : call test%assert(assertion, PROCEDURE_NAME//SK_": A character value """//getStr(value)//""" has `index = 1_IK`.", int(__LINE__, IK))
328 : #endif
329 :
330 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
331 :
332 30 : end subroutine
333 :
334 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
335 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
336 :
337 244 : subroutine report(isLess)
338 : use pm_io, only: display_type
339 : logical(LK) , external , optional :: isLess
340 244 : type(display_type) :: disp
341 :
342 244 : if (present(isLess)) then
343 122 : index = getBin(Array, value, isLess)
344 : else
345 122 : index = getBin(Array, value)
346 : end if
347 :
348 : ! Report test results if needed.
349 :
350 244 : disp = display_type()
351 : !write(*,*) getBinEnabled, present(instance), present(sorted), present(positive)
352 : !write(*,*) Array
353 : !write(*,*) value
354 : !write(*,*) index
355 : !write(*,*) index_ref
356 244 : assertion = assertion .and. index == index_ref
357 :
358 244 : if (test%traceable .and. .not. assertion) then
359 :
360 : ! LCOV_EXCL_START
361 : write(test%disp%unit,"(*(g0,:,', '))")
362 :
363 : call disp%show("index")
364 : call disp%show( index )
365 : call disp%show("index_ref")
366 : call disp%show( index_ref )
367 : write(test%disp%unit,"(*(g0,:,', '))") "present(isLess) ", present(isLess)
368 :
369 : write(test%disp%unit,"(*(g0,:,', '))")
370 : ! LCOV_EXCL_STOP
371 :
372 : end if
373 :
374 244 : end subroutine
375 :
376 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
377 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
378 :
379 : #undef GET_SIZE
380 : #undef IS_EQUAL
|
