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 : !> [getCompact](@ref pm_arrayCompact::getCompact),
20 : !> [setCompact](@ref pm_arrayCompact::setCompact).
21 : !>
22 : !> \todo
23 : !> \phigh The tests in this file still benefit from expansion and improvement.
24 : !>
25 : !> \fintest
26 : !>
27 : !> \author
28 : !> \AmirShahmoradi, September 1, 2017, 11:35 PM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
29 :
30 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
31 :
32 : #if LK_ENABLED
33 : #define IS_EQUAL .eqv.
34 : #else
35 : #define IS_EQUAL ==
36 : #endif
37 :
38 : #if SK_ENABLED && D0_ENABLED
39 : #define GET_SIZE(Array, DIM) len(Array, kind = IK)
40 : #define GET_SLICE(i) i:i
41 : #elif D1_ENABLED
42 : #define GET_SIZE(Array, DIM) size(Array, DIM, IK)
43 : #define GET_SLICE(i) i
44 : #elif !D2_ENABLED
45 : #error "Unrecognized interface."
46 : #endif
47 : integer(IK) :: i, dim, csize, csize_ref
48 : #if SK_ENABLED && D0_ENABLED
49 2 : character(:,SKC) , allocatable :: ArrayVerbose, ArrayCompact, ArrayCompact_ref
50 : #elif SK_ENABLED && D1_ENABLED
51 : character(2,SKC) , allocatable :: ArrayVerbose(:), ArrayCompact(:), ArrayCompact_ref(:)
52 : #elif IK_ENABLED && D1_ENABLED
53 : integer(IKC) , allocatable :: ArrayVerbose(:), ArrayCompact(:), ArrayCompact_ref(:)
54 : #elif LK_ENABLED && D1_ENABLED
55 : logical(LKC) , allocatable :: ArrayVerbose(:), ArrayCompact(:), ArrayCompact_ref(:)
56 : #elif CK_ENABLED && D1_ENABLED
57 : complex(CKC) , allocatable :: ArrayVerbose(:), ArrayCompact(:), ArrayCompact_ref(:)
58 : #elif RK_ENABLED && D1_ENABLED
59 : real(RKC) , allocatable :: ArrayVerbose(:), ArrayCompact(:), ArrayCompact_ref(:)
60 : #elif SK_ENABLED && D2_ENABLED
61 : character(2,SKC) , allocatable :: ArrayVerbose(:,:), ArrayCompact(:,:), ArrayCompact_ref(:,:)
62 : #elif IK_ENABLED && D2_ENABLED
63 : integer(IKC) , allocatable :: ArrayVerbose(:,:), ArrayCompact(:,:), ArrayCompact_ref(:,:)
64 : #elif LK_ENABLED && D2_ENABLED
65 : logical(LKC) , allocatable :: ArrayVerbose(:,:), ArrayCompact(:,:), ArrayCompact_ref(:,:)
66 : #elif CK_ENABLED && D2_ENABLED
67 : complex(CKC) , allocatable :: ArrayVerbose(:,:), ArrayCompact(:,:), ArrayCompact_ref(:,:)
68 : #elif RK_ENABLED && D2_ENABLED
69 : real(RKC) , allocatable :: ArrayVerbose(:,:), ArrayCompact(:,:), ArrayCompact_ref(:,:)
70 : #else
71 : #error "Unrecognized interface."
72 : #endif
73 : integer(IK) , allocatable :: Weight_ref(:)
74 : #if setCompact_ENABLED
75 : integer(IK) , allocatable :: Weight(:)
76 : #elif !getCompact_ENABLED
77 : #error "Unrecognized interface."
78 : #endif
79 :
80 78 : assertion = .true._LK
81 :
82 : !%%%%%%%%%%%%%%%%%%%%%%%
83 : #if D0_ENABLED || D1_ENABLED
84 : !%%%%%%%%%%%%%%%%%%%%%%%
85 :
86 40 : dim = 1
87 :
88 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
89 :
90 40 : call reset()
91 : #if SK_ENABLED && D0_ENABLED
92 2 : allocate(character(0,SKC) :: ArrayCompact_ref)
93 : #else
94 38 : allocate(ArrayCompact_ref(0))
95 : #endif
96 2 : call setUnifRand(ArrayCompact_ref)
97 78 : ArrayCompact_ref = getUnique(ArrayCompact_ref)
98 40 : csize_ref = GET_SIZE(ArrayCompact_ref, dim)
99 40 : allocate(Weight_ref(csize_ref))
100 40 : call setUnifRand(Weight_ref, 1_IK, 10_IK)
101 78 : ArrayVerbose = getVerbose(ArrayCompact_ref, Weight_ref, sum(Weight_ref, mask = Weight_ref > 0_IK))
102 :
103 : #if getCompact_ENABLED
104 39 : ArrayCompact = getCompact(ArrayVerbose)
105 20 : csize = GET_SIZE(ArrayCompact, dim)
106 : #elif setCompact_ENABLED
107 39 : ArrayCompact = ArrayVerbose
108 20 : allocate(Weight(GET_SIZE(ArrayCompact, dim)))
109 : call setCompact(ArrayCompact, Weight, csize)
110 : #endif
111 :
112 40 : assertion = assertion .and. csize == csize_ref
113 40 : call report()
114 40 : call test%assert(assertion, SK_"The compact size of an empty verbose array must be properly set.", int(__LINE__, IK))
115 :
116 40 : assertion = .true._LK
117 40 : do i = 1, csize
118 0 : assertion = assertion .and. ArrayCompact(GET_SLICE(i)) IS_EQUAL ArrayCompact_ref(GET_SLICE(i))
119 0 : call report()
120 20 : call test%assert(assertion, SK_"An empty verbose array must be properly condensed.", int(__LINE__, IK))
121 : #if setCompact_ENABLED
122 0 : assertion = assertion .and. Weight(i) == Weight_ref(i)
123 0 : call report()
124 20 : call test%assert(assertion, SK_"The Weight of an empty verbose array must be properly set.", int(__LINE__, IK))
125 : #endif
126 : end do
127 :
128 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
129 :
130 40 : call reset()
131 : #if SK_ENABLED && D0_ENABLED
132 2 : allocate(character(10,SKC) :: ArrayCompact_ref)
133 : #else
134 38 : allocate(ArrayCompact_ref(10))
135 : #endif
136 420 : call setUnifRand(ArrayCompact_ref)
137 678 : ArrayCompact_ref = getUnique(ArrayCompact_ref)
138 40 : csize_ref = GET_SIZE(ArrayCompact_ref, dim)
139 40 : allocate(Weight_ref(csize_ref))
140 360 : call setUnifRand(Weight_ref, 1_IK, 10_IK)
141 2083 : ArrayVerbose = getVerbose(ArrayCompact_ref, Weight_ref, sum(Weight_ref, mask = Weight_ref > 0_IK))
142 :
143 : #if getCompact_ENABLED
144 189 : ArrayCompact = getCompact(ArrayVerbose)
145 20 : csize = GET_SIZE(ArrayCompact, dim)
146 : #elif setCompact_ENABLED
147 860 : ArrayCompact = ArrayVerbose
148 20 : allocate(Weight(GET_SIZE(ArrayCompact, dim)))
149 : call setCompact(ArrayCompact, Weight, csize)
150 : #endif
151 :
152 40 : assertion = assertion .and. csize == csize_ref
153 40 : call report()
154 40 : call test%assert(assertion, SK_"The compact size of a non-empty verbose array must be properly set.", int(__LINE__, IK))
155 :
156 40 : assertion = .true._LK
157 402 : do i = 1, csize
158 320 : assertion = assertion .and. ArrayCompact(GET_SLICE(i)) IS_EQUAL ArrayCompact_ref(GET_SLICE(i))
159 320 : call report()
160 340 : call test%assert(assertion, SK_"A non-empty verbose array must be properly condensed.", int(__LINE__, IK))
161 : #if setCompact_ENABLED
162 160 : assertion = assertion .and. Weight(i) == Weight_ref(i)
163 160 : call report()
164 180 : call test%assert(assertion, SK_"The Weight of a non-empty verbose array must be properly set.", int(__LINE__, IK))
165 : #endif
166 : end do
167 :
168 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
169 :
170 : !%%%%%%%%%
171 : #elif D2_ENABLED
172 : !%%%%%%%%%
173 :
174 114 : do dim = 1, 2
175 :
176 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
177 :
178 76 : call reset()
179 76 : allocate(ArrayCompact_ref(0,0))
180 : call setUnifRand(ArrayCompact_ref)
181 76 : csize_ref = size(ArrayCompact_ref, dim)
182 76 : allocate(Weight_ref(csize_ref))
183 76 : call setUnifRand(Weight_ref, 1_IK, 10_IK)
184 152 : ArrayVerbose = getVerbose(ArrayCompact_ref, Weight_ref, sum(Weight_ref, mask = Weight_ref > 0_IK), dim)
185 :
186 : #if getCompact_ENABLED
187 76 : ArrayCompact = getCompact(ArrayVerbose, dim)
188 38 : csize = size(ArrayCompact, dim)
189 : #elif setCompact_ENABLED
190 76 : ArrayCompact = ArrayVerbose
191 38 : allocate(Weight(size(ArrayCompact, dim)))
192 : call setCompact(ArrayCompact, Weight, csize, dim)
193 : #endif
194 :
195 76 : assertion = assertion .and. csize == csize_ref
196 76 : call report()
197 76 : call test%assert(assertion, SK_"The compact size of an empty verbose array must be properly set.", int(__LINE__, IK))
198 :
199 76 : assertion = .true._LK
200 76 : do i = 1, csize
201 0 : assertion = assertion .and. all(ArrayCompact IS_EQUAL ArrayCompact_ref)
202 0 : call report()
203 38 : call test%assert(assertion, SK_"An empty verbose array must be properly condensed.", int(__LINE__, IK))
204 : #if setCompact_ENABLED
205 0 : assertion = assertion .and. Weight(i) == Weight_ref(i)
206 0 : call report()
207 38 : call test%assert(assertion, SK_"The Weight of an empty verbose array must be properly set.", int(__LINE__, IK))
208 : #endif
209 : end do
210 :
211 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
212 :
213 76 : call reset()
214 : #if SK_ENABLED
215 : ArrayVerbose = reshape( [ "AB", "CD", "EF" &
216 : , "AB", "CD", "EF" &
217 : , "GH", "IJ", "KL" &
218 : , "GH", "IJ", "KL" &
219 : , "GH", "IJ", "KL" &
220 : , "MN", "OP", "QR" &
221 92 : ], shape = [6, 3], order = [2, 1])
222 : #elif IK_ENABLED
223 : ArrayVerbose = int(reshape( [ +1, +2, +3 &
224 : , +1, +2, +3 &
225 : , +4, +5, +6 &
226 : , +4, +5, +6 &
227 : , +4, +5, +6 &
228 : , +7, +8, +9 &
229 460 : ], shape = [6, 3], order = [2, 1]), IKC)
230 : #elif LK_ENABLED
231 : ArrayVerbose = logical(reshape( [ .false., .false., .true. &
232 : , .false., .false., .true. &
233 : , .true., .false., .false. &
234 : , .true., .false., .false. &
235 : , .true., .false., .false. &
236 : , .false., .true., .false. &
237 460 : ], shape = [6, 3], order = [2, 1]), LKC)
238 : #elif CK_ENABLED
239 : ArrayVerbose = cmplx( reshape( [ (+1, -1), (+2, -2), (+3, -3) &
240 : , (+1, -1), (+2, -2), (+3, -3) &
241 : , (+4, -4), (+5, -5), (+6, -6) &
242 : , (+4, -4), (+5, -5), (+6, -6) &
243 : , (+4, -4), (+5, -5), (+6, -6) &
244 : , (+7, -7), (+8, -8), (+9, -9) &
245 368 : ], shape = [6, 3], order = [2, 1]), kind = CKC)
246 : #elif RK_ENABLED
247 : ArrayVerbose = real( reshape( [ +1, +2, +3 &
248 : , +1, +2, +3 &
249 : , +4, +5, +6 &
250 : , +4, +5, +6 &
251 : , +4, +5, +6 &
252 : , +7, +8, +9 &
253 368 : ], shape = [6, 3], order = [2, 1]), RKC)
254 : #else
255 : #error "Unrecognized interface."
256 : #endif
257 380 : Weight_ref = [2, 3, 1]
258 1064 : ArrayCompact_ref = ArrayVerbose([1, 3, 6],:)
259 :
260 76 : if (dim == 2_IK) then
261 1900 : ArrayVerbose = transpose(ArrayVerbose)
262 988 : ArrayCompact_ref = transpose(ArrayCompact_ref)
263 : end if
264 :
265 76 : csize_ref = size(ArrayCompact_ref, dim)
266 :
267 : #if getCompact_ENABLED
268 532 : ArrayCompact = getCompact(ArrayVerbose, dim)
269 38 : csize = size(ArrayCompact, dim)
270 : #elif setCompact_ENABLED
271 1007 : ArrayCompact = ArrayVerbose
272 38 : allocate(Weight(size(ArrayCompact, dim)))
273 : call setCompact(ArrayCompact, Weight, csize, dim)
274 : #endif
275 :
276 76 : assertion = assertion .and. csize == csize_ref
277 76 : call report()
278 76 : call test%assert(assertion, SK_"The compact size of a non-empty verbose array must be properly set.", int(__LINE__, IK))
279 :
280 76 : assertion = .true._LK
281 418 : do i = 1, csize
282 228 : if (dim == 1_IK) then
283 456 : assertion = assertion .and. all(ArrayCompact(csize,:) IS_EQUAL ArrayCompact_ref(csize,:))
284 : else
285 456 : assertion = assertion .and. all(ArrayCompact(:,csize) IS_EQUAL ArrayCompact_ref(:,csize))
286 : end if
287 228 : call report()
288 266 : call test%assert(assertion, SK_"A non-empty verbose array must be properly condensed.", int(__LINE__, IK))
289 : #if setCompact_ENABLED
290 114 : assertion = assertion .and. Weight(i) == Weight_ref(i)
291 114 : call report()
292 152 : call test%assert(assertion, SK_"The Weight of a non-empty verbose array must be properly set.", int(__LINE__, IK))
293 : #endif
294 : end do
295 :
296 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
297 :
298 : end do
299 :
300 : #else
301 : !%%%%%%%%%%%%%%%%%%%%%%%%
302 : #error "Unrecognized interface."
303 : !%%%%%%%%%%%%%%%%%%%%%%%%
304 : #endif
305 :
306 : contains
307 :
308 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
309 :
310 232 : subroutine reset()
311 : #if setCompact_ENABLED
312 116 : if (allocated(Weight)) deallocate(Weight)
313 : #endif
314 232 : if (allocated(Weight_ref)) deallocate(Weight_ref)
315 232 : if (allocated(ArrayCompact)) deallocate(ArrayCompact)
316 232 : if (allocated(ArrayVerbose)) deallocate(ArrayVerbose)
317 232 : if (allocated(ArrayCompact_ref)) deallocate(ArrayCompact_ref)
318 232 : end subroutine
319 :
320 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
321 :
322 1054 : subroutine report()
323 1054 : if (test%traceable .and. .not. assertion) then
324 : ! LCOV_EXCL_START
325 : write(test%disp%unit,"(*(g0,:,', '))")
326 : write(test%disp%unit,"(*(g0,:,', '))") "ArrayVerbose ", ArrayVerbose
327 : write(test%disp%unit,"(*(g0,:,', '))") "ArrayCompact ", ArrayCompact
328 : write(test%disp%unit,"(*(g0,:,', '))") "ArrayCompact_ref ", ArrayCompact_ref
329 : #if setCompact_ENABLED
330 : write(test%disp%unit,"(*(g0,:,', '))") "Weight_ref ", Weight_ref
331 : write(test%disp%unit,"(*(g0,:,', '))") "Weight ", Weight
332 : #endif
333 : write(test%disp%unit,"(*(g0,:,', '))") "csize_ref ", csize_ref
334 : write(test%disp%unit,"(*(g0,:,', '))") "csize ", csize
335 : write(test%disp%unit,"(*(g0,:,', '))") "dim ", dim
336 : write(test%disp%unit,"(*(g0,:,', '))")
337 : ! LCOV_EXCL_STOP
338 : end if
339 1054 : end subroutine
340 :
341 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
342 :
343 : #undef GET_SLICE
344 : #undef IS_EQUAL
345 : #undef GET_SIZE
346 : #undef ALL
|
