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 interface [setRemapped](@ref pm_arrayRemap::setRemapped).
19 : !>
20 : !> \fintest
21 : !>
22 : !> \author
23 : !> \AmirShahmoradi, September 1, 2017, 11:35 PM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
24 :
25 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26 :
27 : ! Define comparison operator.
28 : #if LK_ENABLED && D1_ENABLED
29 : #define ISEQ .eqv.
30 : #else
31 : #define ISEQ ==
32 : #endif
33 : ! Define sizing function.
34 : #if !(SK_ENABLED && D0_ENABLED)
35 : #define GET_SIZE size
36 : #endif
37 : ! Define procedure name.
38 : #if getRemapped_ENABLED
39 : character(*, SK), parameter :: PROCEDURE_NAME = "@getRemapped()"
40 : #elif setRemapped_ENABLED
41 : character(*, SK), parameter :: PROCEDURE_NAME = "@setRemapped()"
42 : #endif
43 : #if SK_ENABLED && D0_ENABLED
44 : #define GET_SIZE len
45 : #define ALL
46 2 : character(:,SKC), allocatable :: Array, arrayNew, ArrayNew_ref
47 : #elif SK_ENABLED && D1_ENABLED
48 : character(2,SKC), dimension(:), allocatable :: Array, arrayNew, ArrayNew_ref
49 : #elif IK_ENABLED && D1_ENABLED
50 : integer(IKC) , dimension(:), allocatable :: Array, arrayNew, ArrayNew_ref
51 : #elif LK_ENABLED && D1_ENABLED
52 : logical(LKC) , dimension(:), allocatable :: Array, arrayNew, ArrayNew_ref
53 : #elif CK_ENABLED && D1_ENABLED
54 : complex(CKC) , dimension(:), allocatable :: Array, arrayNew, ArrayNew_ref
55 : #elif RK_ENABLED && D1_ENABLED
56 : real(RKC) , dimension(:), allocatable :: Array, arrayNew, ArrayNew_ref
57 : #else
58 : #error "Unrecognized interface."
59 : #endif
60 : integer(IK), allocatable :: index(:)
61 : logical(LK) :: backward_def
62 : logical(LK) :: arrayNewEnabled
63 :
64 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
65 :
66 40 : assertion = .true._LK
67 40 : arrayNewEnabled = .false._LK
68 40 : call runTestsWith()
69 40 : call runTestsWith(action = reverse)
70 40 : arrayNewEnabled = .true._LK
71 40 : call runTestsWith()
72 40 : call runTestsWith(action = reverse)
73 :
74 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
75 :
76 : contains
77 :
78 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
79 :
80 160 : subroutine runTestsWith(action)
81 : type(reverse_type), intent(in), optional :: action
82 :
83 160 : backward_def = present(action)
84 160 : if (allocated(index)) deallocate(index)
85 160 : if (allocated(Array)) deallocate(Array)
86 160 : if (allocated(ArrayNew_ref)) deallocate(ArrayNew_ref)
87 :
88 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
89 :
90 : #if SK_ENABLED && D0_ENABLED
91 8 : Array = ""
92 8 : ArrayNew_ref = ""
93 : #elif SK_ENABLED && D1_ENABLED
94 8 : allocate(character(2,SKC) :: Array(0), ArrayNew_ref(0))
95 : #elif IK_ENABLED && D1_ENABLED
96 40 : allocate(Array(0), ArrayNew_ref(0))
97 : #elif LK_ENABLED && D1_ENABLED
98 40 : allocate(Array(0), ArrayNew_ref(0))
99 : #elif CK_ENABLED && D1_ENABLED
100 32 : allocate(Array(0), ArrayNew_ref(0))
101 : #elif RK_ENABLED && D1_ENABLED
102 32 : allocate(Array(0), ArrayNew_ref(0))
103 : #endif
104 160 : allocate(index(GET_SIZE(Array)))
105 160 : call report()
106 160 : call test%assert(assertion, desc = PROCEDURE_NAME//SK_": An empty array has a remapped array of length zero.")
107 :
108 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
109 :
110 : #if SK_ENABLED && D0_ENABLED
111 8 : Array = SKC_" "
112 8 : ArrayNew_ref = SKC_" "
113 : #elif SK_ENABLED && D1_ENABLED
114 24 : Array = [SKC_" "]
115 24 : ArrayNew_ref = [SKC_" "]
116 : #elif IK_ENABLED && D1_ENABLED
117 120 : Array = [1_IKC]
118 120 : ArrayNew_ref = [1_IKC]
119 : #elif LK_ENABLED && D1_ENABLED
120 120 : Array = [.true._LKC]
121 120 : ArrayNew_ref = [.true._LKC]
122 : #elif CK_ENABLED && D1_ENABLED
123 96 : Array = [(+1._CKC, -1._CKC)]
124 96 : ArrayNew_ref = [(+1._CKC, -1._CKC)]
125 : #elif RK_ENABLED && D1_ENABLED
126 96 : Array = [1._RKC]
127 96 : ArrayNew_ref = [1._RKC]
128 : #endif
129 480 : index = [1_IK]
130 160 : call report(action)
131 160 : call test%assert(assertion, desc = PROCEDURE_NAME//SK_": An array of length 1 has a remapped array of length 1.")
132 :
133 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
134 :
135 : #if SK_ENABLED && D0_ENABLED
136 8 : Array = SKC_"ABCDE "
137 8 : if (backward_def) then
138 4 : ArrayNew_ref = SKC_" EDCBA"
139 : else
140 4 : ArrayNew_ref = Array
141 : end if
142 : #elif SK_ENABLED && D1_ENABLED
143 64 : Array = ["AA", "BB", "CC", "DD", "EE", " "]
144 8 : if (backward_def) then
145 32 : ArrayNew_ref = Array(size(Array):1:-1)
146 : else
147 36 : ArrayNew_ref = Array
148 : end if
149 : #elif IK_ENABLED && D1_ENABLED
150 320 : Array = [1_IKC, 2_IKC, 3_IKC, 4_IKC, 5_IKC, 6_IKC]
151 40 : if (backward_def) then
152 160 : ArrayNew_ref = Array(size(Array):1:-1)
153 : else
154 180 : ArrayNew_ref = Array
155 : end if
156 : #elif LK_ENABLED && D1_ENABLED
157 320 : Array = [.false._LKC, .true._LKC, .false._LKC, .true._LKC, .false._LKC, .true._LKC]
158 40 : if (backward_def) then
159 160 : ArrayNew_ref = Array(size(Array):1:-1)
160 : else
161 180 : ArrayNew_ref = Array
162 : end if
163 : #elif CK_ENABLED && D1_ENABLED
164 256 : Array = [(+1._CKC, -1._CKC), (+2._CKC, -2._CKC), (+3._CKC, -3._CKC), (+4._CKC, -4._CKC), (+5._CKC, -5._CKC), (+6._CKC, -6._CKC)]
165 32 : if (backward_def) then
166 128 : ArrayNew_ref = Array(size(Array):1:-1)
167 : else
168 144 : ArrayNew_ref = Array
169 : end if
170 : #elif RK_ENABLED && D1_ENABLED
171 256 : Array = [1._RKC, 2._RKC, 3._RKC, 4._RKC, 5._RKC, 6._RKC]
172 32 : if (backward_def) then
173 128 : ArrayNew_ref = Array(size(Array):1:-1)
174 : else
175 144 : ArrayNew_ref = Array
176 : end if
177 : #endif
178 1280 : index = [1_IK, 2_IK, 3_IK, 4_IK, 5_IK, 6_IK]
179 160 : call report(action)
180 160 : call test%assert(assertion, desc = PROCEDURE_NAME//SK_": The order of an array of length 6 must not change by a map that is the same as the array indices, unless `action = reverse`.")
181 :
182 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
183 :
184 : #if SK_ENABLED && D0_ENABLED
185 8 : Array = "ABCDE "
186 8 : if (backward_def) then
187 4 : ArrayNew_ref = "ADEC B"
188 : else
189 4 : ArrayNew_ref = "B CEDA"
190 : end if
191 : #elif SK_ENABLED && D1_ENABLED
192 64 : Array = ["AA", "BB", "CC", "DD", "EE", " "]
193 8 : if (backward_def) then
194 32 : ArrayNew_ref = ["AA", "DD", "EE", "CC", " ", "BB"]
195 : else
196 32 : ArrayNew_ref = ["BB", " ", "CC", "EE", "DD", "AA"]
197 : end if
198 : #elif IK_ENABLED && D1_ENABLED
199 320 : Array = [1_IKC, 2_IKC, 3_IKC, 4_IKC, 5_IKC, 6_IKC]
200 40 : if (backward_def) then
201 160 : ArrayNew_ref = [1_IKC, 4_IKC, 5_IKC, 3_IKC, 6_IKC, 2_IKC]
202 : else
203 160 : ArrayNew_ref = [2_IKC, 6_IKC, 3_IKC, 5_IKC, 4_IKC, 1_IKC]
204 : end if
205 : #elif LK_ENABLED && D1_ENABLED
206 320 : Array = [.false._LKC, .true._LKC, .false._LKC, .true._LKC, .false._LKC, .true._LKC]
207 40 : if (backward_def) then
208 160 : ArrayNew_ref = [.false._LKC, .true._LKC, .false._LKC, .false._LKC, .true._LKC, .true._LKC]
209 : else
210 160 : ArrayNew_ref = [.true._LKC, .true._LKC, .false._LKC, .false._LKC, .true._LKC, .false._LKC]
211 : end if
212 : #elif CK_ENABLED && D1_ENABLED
213 256 : Array = [(+1._CKC, -1._CKC), (+2._CKC, -2._CKC), (+3._CKC, -3._CKC), (+4._CKC, -4._CKC), (+5._CKC, -5._CKC), (+6._CKC, -6._CKC)]
214 32 : if (backward_def) then
215 128 : ArrayNew_ref = [(+1._CKC, -1._CKC), (+4._CKC, -4._CKC), (+5._CKC, -5._CKC), (+3._CKC, -3._CKC), (+6._CKC, -6._CKC), (+2._CKC, -2._CKC)]
216 : else
217 128 : ArrayNew_ref = [(+2._CKC, -2._CKC), (+6._CKC, -6._CKC), (+3._CKC, -3._CKC), (+5._CKC, -5._CKC), (+4._CKC, -4._CKC), (+1._CKC, -1._CKC)]
218 : end if
219 : #elif RK_ENABLED && D1_ENABLED
220 256 : Array = [1._RKC, 2._RKC, 3._RKC, 4._RKC, 5._RKC, 6._RKC]
221 32 : if (backward_def) then
222 128 : ArrayNew_ref = [1._RKC, 4._RKC, 5._RKC, 3._RKC, 6._RKC, 2._RKC]
223 : else
224 128 : ArrayNew_ref = [2._RKC, 6._RKC, 3._RKC, 5._RKC, 4._RKC, 1._RKC]
225 : end if
226 : #endif
227 1280 : index = [2_IK, 6_IK, 3_IK, 5_IK, 4_IK, 1_IK]
228 160 : call report(action)
229 160 : call test%assert(assertion, desc = PROCEDURE_NAME//SK_": An array of length 6 must be remapped correctly with unique indices.")
230 :
231 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
232 :
233 : #if SK_ENABLED && D0_ENABLED
234 8 : Array = "ABCDE "
235 8 : if (backward_def) then
236 4 : ArrayNew_ref = "AAAAAC"
237 : else
238 4 : ArrayNew_ref = "CAAAAA"
239 : end if
240 : #elif SK_ENABLED && D1_ENABLED
241 64 : Array = ["AA", "BB", "CC", "DD", "EE", " "]
242 8 : if (backward_def) then
243 32 : ArrayNew_ref = ["AA", "AA", "AA", "AA", "AA", "CC"]
244 : else
245 32 : ArrayNew_ref = ["CC", "AA", "AA", "AA", "AA", "AA"]
246 : end if
247 : #elif IK_ENABLED && D1_ENABLED
248 320 : Array = [1_IKC, 2_IKC, 3_IKC, 4_IKC, 5_IKC, 6_IKC]
249 40 : if (backward_def) then
250 160 : ArrayNew_ref = [1_IKC, 1_IKC, 1_IKC, 1_IKC, 1_IKC, 3_IKC]
251 : else
252 160 : ArrayNew_ref = [3_IKC, 1_IKC, 1_IKC, 1_IKC, 1_IKC, 1_IKC]
253 : end if
254 : #elif LK_ENABLED && D1_ENABLED
255 320 : Array = [.false._LKC, .true._LKC, .false._LKC, .true._LKC, .false._LKC, .true._LKC]
256 40 : if (backward_def) then
257 160 : ArrayNew_ref = [.false._LKC, .false._LKC, .false._LKC, .false._LKC, .false._LKC, .false._LKC]
258 : else
259 160 : ArrayNew_ref = [.false._LKC, .false._LKC, .false._LKC, .false._LKC, .false._LKC, .false._LKC]
260 : end if
261 : #elif CK_ENABLED && D1_ENABLED
262 256 : Array = [(+1._CKC, -1._CKC), (+2._CKC, -2._CKC), (+3._CKC, -3._CKC), (+4._CKC, -4._CKC), (+5._CKC, -5._CKC), (+6._CKC, -6._CKC)]
263 32 : if (backward_def) then
264 128 : ArrayNew_ref = [(+1._CKC, -1._CKC), (+1._CKC, -1._CKC), (+1._CKC, -1._CKC), (+1._CKC, -1._CKC), (+1._CKC, -1._CKC), (+3._CKC, -3._CKC)]
265 : else
266 128 : ArrayNew_ref = [(+3._CKC, -3._CKC), (+1._CKC, -1._CKC), (+1._CKC, -1._CKC), (+1._CKC, -1._CKC), (+1._CKC, -1._CKC), (+1._CKC, -1._CKC)]
267 : end if
268 : #elif RK_ENABLED && D1_ENABLED
269 256 : Array = [1._RKC, 2._RKC, 3._RKC, 4._RKC, 5._RKC, 6._RKC]
270 32 : if (backward_def) then
271 128 : ArrayNew_ref = [1._RKC, 1._RKC, 1._RKC, 1._RKC, 1._RKC, 3._RKC]
272 : else
273 128 : ArrayNew_ref = [3._RKC, 1._RKC, 1._RKC, 1._RKC, 1._RKC, 1._RKC]
274 : end if
275 : #endif
276 1280 : index = [3_IK, 1_IK, 1_IK, 1_IK, 1_IK, 1_IK]
277 160 : call report(action)
278 160 : call test%assert(assertion, desc = PROCEDURE_NAME//SK_": An array of length 6 must be remapped correctly with unique indices.")
279 :
280 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
281 :
282 160 : end subroutine
283 :
284 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
285 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
286 :
287 800 : subroutine report(action)
288 :
289 : type(reverse_type), intent(in), optional :: action
290 800 : if (allocated(arrayNew)) deallocate(arrayNew)
291 4312 : allocate(arrayNew, source = Array)
292 :
293 800 : if (present(action) .and. arrayNewEnabled) then
294 : #if getRemapped_ENABLED
295 517 : arrayNew = getRemapped(Array, index, action)
296 : #elif setRemapped_ENABLED
297 80 : call setRemapped(Array, index, action, arrayNew)
298 : #else
299 : #error "Unrecognized interface."
300 : #endif
301 640 : elseif (present(action)) then
302 : #if getRemapped_ENABLED
303 878 : arrayNew = getRemapped(arrayNew, index, action)
304 : #elif setRemapped_ENABLED
305 80 : call setRemapped(arrayNew, index, action)
306 : #endif
307 480 : elseif (arrayNewEnabled) then
308 : #if getRemapped_ENABLED
309 595 : arrayNew = getRemapped(Array, index)
310 : #elif setRemapped_ENABLED
311 120 : call setRemapped(Array, index, arrayNew = arrayNew)
312 : #endif
313 : else
314 : #if getRemapped_ENABLED
315 956 : arrayNew = getRemapped(arrayNew, index)
316 : #elif setRemapped_ENABLED
317 120 : call setRemapped(arrayNew, index)
318 : #endif
319 : end if
320 :
321 3688 : assertion = assertion .and. ALL(arrayNew ISEQ ArrayNew_ref)
322 800 : if (test%traceable .and. .not. assertion) then
323 : ! LCOV_EXCL_START
324 : write(test%disp%unit,"(*(g0,:,', '))")
325 : write(test%disp%unit,"(*(g0,:,', '))") "Array ", Array
326 : write(test%disp%unit,"(*(g0,:,', '))") "arrayNew ", arrayNew
327 : write(test%disp%unit,"(*(g0,:,', '))") "ArrayNew_ref ", ArrayNew_ref
328 : write(test%disp%unit,"(*(g0,:,', '))") "backward_def ", backward_def
329 : write(test%disp%unit,"(*(g0,:,', '))") "arrayNewEnabled ", arrayNewEnabled
330 : write(test%disp%unit,"(*(g0,:,', '))") "index ", index
331 : write(test%disp%unit,"(*(g0,:,', '))")
332 : ! LCOV_EXCL_STOP
333 : end if
334 :
335 800 : end subroutine
336 :
337 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
338 :
339 : #undef GET_SIZE
340 : #undef ISEQ
341 : #undef ALL
|
