Yet Another eXchange Tool 0.11.4
Loading...
Searching...
No Matches
test_idxsection_f.f90
1
12!
13! Keywords:
14! Maintainer: Jörg Behrens <behrens@dkrz.de>
15! Moritz Hanke <hanke@dkrz.de>
16! Thomas Jahns <jahns@dkrz.de>
17! URL: https://dkrz-sw.gitlab-pages.dkrz.de/yaxt/
18!
19! Redistribution and use in source and binary forms, with or without
20! modification, are permitted provided that the following conditions are
21! met:
22!
23! Redistributions of source code must retain the above copyright notice,
24! this list of conditions and the following disclaimer.
25!
26! Redistributions in binary form must reproduce the above copyright
27! notice, this list of conditions and the following disclaimer in the
28! documentation and/or other materials provided with the distribution.
29!
30! Neither the name of the DKRZ GmbH nor the names of its contributors
31! may be used to endorse or promote products derived from this software
32! without specific prior written permission.
33!
34! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
35! IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
36! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
37! PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
38! OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
39! EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
40! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
41! PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
42! LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
43! NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
44! SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
45!
46#include "fc_feature_defs.inc"
47PROGRAM test_idxsection
48 USE mpi
49 USE yaxt, ONLY: xt_initialize, xt_finalize, xt_idxlist, &
50 xt_int_kind, xt_bounds, xt_stripe, &
55 xt_idxsection_new, xt_idxvec_new, OPERATOR(/=), OPERATOR(==)
56 USE ftest_common, ONLY: init_mpi, finish_mpi, test_abort
57 USE test_idxlist_utils, ONLY: check_idxlist, test_err_count, check_stripes, &
58 idxlist_pack_unpack_copy
59 IMPLICIT NONE
60 INTEGER, PARAMETER :: xi = xt_int_kind
61 CHARACTER(len=*), PARAMETER :: filename = 'test_idxsection_f.f90'
62
63 CALL init_mpi
64 CALL xt_initialize(mpi_comm_world)
65
66 CALL test_1d_section
67 CALL test_2d_section
68 CALL test_3d_section
69 CALL test_4d_section
70 CALL test_2d_simple
71 CALL test_1d_intersection1
72 CALL test_1d_intersection2
73 CALL test_2d_intersection1
74 CALL test_2d_1
75 CALL test_2d_2
76 CALL test_get_positions1
77 CALL test_get_positions2
78 CALL test_other_intersection
79 CALL test_signed_sizes1
80 CALL test_signed_sizes2
81 CALL test_signed_size_positions
82 CALL test_signed_size_intersections
83 CALL test_section_with_stride1
84 CALL test_section_with_stride2
85 CALL test_bb1
86 CALL test_bb2
87 CALL test_bb3
88
89 IF (test_err_count() /= 0) &
90 CALL test_abort("non-zero error count!", filename, __line__)
91 CALL xt_finalize
92 CALL finish_mpi
93
94CONTAINS
95 SUBROUTINE test_1d_section
96 INTEGER(xt_int_kind), PARAMETER :: start = 0_xi
97 INTEGER, PARAMETER :: num_dimensions = 1
98 INTEGER(xt_int_kind), PARAMETER :: global_size(num_dimensions) = 10_xi, &
99 local_start(num_dimensions) = 3_xi, &
100 ref_indices(5) = (/ 3_xi, 4_xi, 5_xi, 6_xi, 7_xi /)
101 INTEGER, PARAMETER :: local_size(num_dimensions) = 5
102 TYPE(xt_stripe), PARAMETER :: ref_stripes(1) = xt_stripe(3, 1, 5)
103 TYPE(xt_idxlist) :: idxsection
104
105 ! create index section
106 idxsection = xt_idxsection_new(start, global_size, local_size, local_start)
107
108 ! testing
109 CALL do_tests(idxsection, ref_indices, ref_stripes)
110
111 ! clean up
112 CALL xt_idxlist_delete(idxsection)
113 END SUBROUTINE test_1d_section
114
115 SUBROUTINE test_2d_section
116 INTEGER(xt_int_kind), PARAMETER :: start = 0_xi
117 INTEGER, PARAMETER :: num_dimensions = 2
118 INTEGER(xt_int_kind), PARAMETER :: global_size(num_dimensions) &
119 = (/ 5_xi, 6_xi /), &
120 local_start(num_dimensions) = (/ 1_xi, 2_xi /), &
121 ref_indices(6) = (/ 8_xi, 9_xi, 14_xi, 15_xi, 20_xi, 21_xi /)
122 INTEGER, PARAMETER :: local_size(num_dimensions) = (/ 3, 2 /)
123 TYPE(xt_stripe), PARAMETER :: ref_stripes(3) = (/ xt_stripe(8, 1, 2), &
124 xt_stripe(14, 1, 2), xt_stripe(20, 1, 2) /)
125 TYPE(xt_idxlist) :: idxsection
126
127 ! create index section
128 idxsection = xt_idxsection_new(start, global_size, local_size, local_start)
129
130 ! testing
131 CALL do_tests(idxsection, ref_indices, ref_stripes)
132
133 ! clean up
134 CALL xt_idxlist_delete(idxsection)
135 END SUBROUTINE test_2d_section
136
137 SUBROUTINE test_3d_section
138 INTEGER(xt_int_kind), PARAMETER :: start = 0_xi
139 INTEGER, PARAMETER :: num_dimensions = 3
140 INTEGER(xt_int_kind), PARAMETER :: global_size(num_dimensions) = 4_xi, &
141 local_start(num_dimensions) = (/ 0_xi, 1_xi, 1_xi /), &
142 ref_indices(16) = (/ 5_xi, 6_xi, 9_xi, 10_xi, 21_xi, 22_xi, 25_xi, &
143 26_xi, 37_xi, 38_xi, 41_xi, 42_xi, 53_xi, 54_xi, 57_xi, 58_xi /)
144 INTEGER, PARAMETER :: local_size(num_dimensions) = (/ 4, 2, 2 /)
145 TYPE(xt_stripe), PARAMETER :: ref_stripes(8) = (/ xt_stripe(5, 1, 2), &
146 xt_stripe(9, 1, 2), xt_stripe(21, 1, 2), xt_stripe(25, 1, 2), &
147 xt_stripe(37, 1, 2), xt_stripe(41, 1, 2), xt_stripe(53, 1, 2), &
148 xt_stripe(57, 1, 2) /)
149 TYPE(xt_idxlist) :: idxsection
150
151 ! create index section
152 idxsection = xt_idxsection_new(start, global_size, local_size, local_start)
153
154 ! testing
155 CALL do_tests(idxsection, ref_indices, ref_stripes)
156
157 ! clean up
158 CALL xt_idxlist_delete(idxsection)
159 END SUBROUTINE test_3d_section
160
161 SUBROUTINE test_4d_section
162 INTEGER(xt_int_kind), PARAMETER :: start = 0_xi
163 INTEGER, PARAMETER :: num_dimensions = 4
164 INTEGER(xt_int_kind) :: i, j, k, l
165 INTEGER(xt_int_kind), PARAMETER :: global_size(num_dimensions) &
166 = (/ 3_xi, 4_xi, 4_xi, 3_xi /), &
167 local_start(num_dimensions) &
168 = (/ 0_xi, 1_xi, 1_xi, 1_xi /), &
169#ifdef __xlC__
170 ref_indices(36) = &
171 (/ 16_xi,17_xi,19_xi,20_xi,22_xi,23_xi, &
172 28_xi,29_xi,31_xi,32_xi,34_xi,35_xi, &
173 40_xi,41_xi,43_xi,44_xi,46_xi,47_xi, &
174 64_xi,65_xi,67_xi,68_xi,70_xi,71_xi, &
175 76_xi,77_xi,79_xi,80_xi,82_xi,83_xi, &
176 88_xi,89_xi,91_xi,92_xi,94_xi,95_xi /)
177#else
178 ref_indices(36) &
179 = (/ ((((16_xi + i + j*3_xi + k*12_xi + l*48_xi, &
180 & i=0_xi,1_xi), j=0_xi,2_xi), k=0_xi,2_xi), l=0_xi,1_xi) /)
181#endif
182 INTEGER, PARAMETER :: local_size(num_dimensions) = (/ 2, 3, 3, 2 /)
183 TYPE(xt_stripe), PARAMETER :: ref_stripes(18) &
184 = (/ (((xt_stripe(16_xi + j*3_xi + k*12_xi + l*48_xi, 1_xi, 2), &
185 & j = 0_xi,2_xi), k=0_xi,2_xi), l=0_xi,1_xi) /)
186 TYPE(xt_idxlist) :: idxsection
187
188 ! create index section
189 idxsection = xt_idxsection_new(start, global_size, local_size, local_start)
190
191 ! testing
192 CALL do_tests(idxsection, ref_indices, ref_stripes)
193
194 ! clean up
195 CALL xt_idxlist_delete(idxsection)
196 END SUBROUTINE test_4d_section
197
198 SUBROUTINE test_2d_simple
199 INTEGER(xt_int_kind), PARAMETER :: start = 0_xi
200 INTEGER, PARAMETER :: num_dimensions = 2
201 INTEGER(xt_int_kind) :: i, j
202 INTEGER(xt_int_kind), PARAMETER :: global_size(num_dimensions) &
203 = (/ 5_xi, 10_xi /), &
204 local_start(num_dimensions) = (/ 1_xi, 2_xi /), &
205 ref_indices(12) &
206 = (/ ((12_xi + i + j*10_xi, i=0_xi,3_xi), j=0_xi,2_xi) /)
207 INTEGER, PARAMETER :: local_size(num_dimensions) = (/ 3, 4 /)
208 TYPE(xt_idxlist) :: idxsection
209
210 ! create index section
211 idxsection = xt_idxsection_new(start, global_size, local_size, local_start)
212
213 ! testing
214 CALL check_idxlist(idxsection, ref_indices)
215
216 CALL xt_idxlist_delete(idxsection)
217 END SUBROUTINE test_2d_simple
218
219 SUBROUTINE test_intersection(&
220 start_a, global_size_a, local_size_a, local_start_a, &
221 start_b, global_size_b, local_size_b, local_start_b, &
222 ref_indices, ref_stripes)
223 INTEGER(xt_int_kind), INTENT(in) :: start_a, start_b, global_size_a(:), &
224 global_size_b(:), local_start_a(:), local_start_b(:), ref_indices(:)
225 INTEGER, INTENT(in) :: local_size_a(:), local_size_b(:)
226 TYPE(xt_stripe), INTENT(in) :: ref_stripes(:)
227 TYPE(xt_idxlist) :: idxsection(2), intersection
228 idxsection(1) = xt_idxsection_new(start_a, global_size_a, local_size_a, &
229 local_start_a)
230 idxsection(2) = xt_idxsection_new(start_b, global_size_b, local_size_b, &
231 local_start_b)
232 intersection = xt_idxlist_get_intersection(idxsection(1), idxsection(2))
233 CALL xt_idxlist_delete(idxsection(2))
234 CALL xt_idxlist_delete(idxsection(1))
235 CALL do_tests(intersection, ref_indices, ref_stripes)
236 CALL xt_idxlist_delete(intersection)
237 END SUBROUTINE test_intersection
238
239 SUBROUTINE test_1d_intersection1
240 INTEGER(xt_int_kind), PARAMETER :: start=0_xi, &
241 global_size_a(1) = 10_xi, global_size_b(1) = 15_xi, &
242 local_start_a(1) = 4_xi, local_start_b(1) = 7_xi, &
243 ref_indices(2) = (/ 7_xi, 8_xi /)
244 INTEGER, PARAMETER :: local_size_a(1) = 5, local_size_b(1) = 6
245 TYPE(xt_stripe), PARAMETER :: ref_stripes(1) = (/ xt_stripe(7, 1, 2) /)
246 CALL test_intersection(&
247 start, global_size_a, local_size_a, local_start_a, &
248 start, global_size_b, local_size_b, local_start_b, &
249 ref_indices, ref_stripes)
250 END SUBROUTINE test_1d_intersection1
251
252 SUBROUTINE test_1d_intersection2
253 INTEGER(xt_int_kind), PARAMETER :: start=0_xi, global_size_a(1) = 10_xi, &
254 global_size_b(1) = 10_xi, local_start_a(1) = 3_xi, &
255 local_start_b(1) = 4_xi, ref_indices(1) = (/ -1_xi /)
256 INTEGER, PARAMETER :: local_size_a(1) = 1, local_size_b(1) = 5
257 TYPE(xt_stripe), PARAMETER :: ref_stripes(1) = (/ xt_stripe(-1, -1, -1) /)
258 CALL test_intersection(&
259 start, global_size_a, local_size_a, local_start_a, &
260 start, global_size_b, local_size_b, local_start_b, &
261 ref_indices(1:0), ref_stripes(1:0))
262 END SUBROUTINE test_1d_intersection2
263
264 SUBROUTINE test_2d_intersection1
265 INTEGER, PARAMETER :: n = 2
266 INTEGER(xt_int_kind), PARAMETER :: start=0_xi, &
267 global_size_a(n) = 6_xi, global_size_b(n) = 6_xi, &
268 local_start_a(n) = 1_xi, local_start_b(n) = (/ 3_xi, 2_xi /), &
269 ref_indices(2) = (/ 20_xi, 26_xi /)
270 INTEGER, PARAMETER :: local_size_a(n) = (/ 4, 2 /), local_size_b(n) = 3
271 TYPE(xt_stripe), PARAMETER :: ref_stripes(1) = (/ xt_stripe(20, 6, 2) /)
272 CALL test_intersection(&
273 start, global_size_a, local_size_a, local_start_a, &
274 start, global_size_b, local_size_b, local_start_b, &
275 ref_indices, ref_stripes)
276 END SUBROUTINE test_2d_intersection1
277
278 SUBROUTINE test_2d_1
279 INTEGER, PARAMETER :: n = 2
280 INTEGER(xt_int_kind), PARAMETER :: start=0_xi, &
281 global_size(n) = 4, local_start(n) = (/ 0_xi, 2_xi /), &
282 ref_indices(4) = (/ 2_xi, 3_xi, 6_xi, 7_xi /)
283 INTEGER, PARAMETER :: local_size(n) = 2
284 TYPE(xt_idxlist) :: idxsection
285 idxsection = xt_idxsection_new(start, n, global_size, local_size, &
286 local_start)
287 CALL check_idxlist(idxsection, ref_indices)
288 CALL xt_idxlist_delete(idxsection)
289 END SUBROUTINE test_2d_1
290
291 SUBROUTINE test_2d_2
292 INTEGER, PARAMETER :: n = 2
293 INTEGER(xt_int_kind), PARAMETER :: start=1_xi, &
294 global_size(n) = 4_xi, local_start(n) = (/ 0_xi, 2_xi /), &
295 ref_indices(4) = (/ 3_xi, 4_xi, 7_xi, 8_xi /)
296 INTEGER, PARAMETER :: local_size(n) = 2
297 TYPE(xt_idxlist) :: idxsection
298 idxsection = xt_idxsection_new(start, n, global_size, local_size, &
299 local_start)
300 CALL check_idxlist(idxsection, ref_indices)
301 CALL xt_idxlist_delete(idxsection)
302 END SUBROUTINE test_2d_2
303
304 SUBROUTINE test_get_positions1
305 INTEGER, PARAMETER :: n = 2, num_selection = 6
306 INTEGER(xt_int_kind), PARAMETER :: start=0_xi, &
307 global_size(n) = 4_xi, local_start(n) = (/ 0_xi, 2_xi /)
308 INTEGER, PARAMETER :: local_size(n) = 2
309 INTEGER(xt_int_kind), PARAMETER :: selection(num_selection) &
310 = (/ 1_xi, 2_xi, 5_xi, 6_xi, 7_xi, 8_xi /)
311 INTEGER, PARAMETER :: ref_positions(num_selection) &
312 = (/ 1*0 - 1, 2*0 + 0, 5*0 - 1, 6*0 + 2, 7*0 + 3, 8*0 - 1 /)
313 INTEGER :: positions(num_selection), num_found
314 TYPE(xt_idxlist) :: idxsection
315 idxsection = xt_idxsection_new(start, n, global_size, local_size, &
316 local_start)
317 num_found = xt_idxlist_get_positions_of_indices(idxsection, selection, &
318 positions, .false.)
319 IF (num_found /= 3) &
320 CALL test_abort("xt_idxlist_get_positions_of_indices &
321 &returned incorrect num_unmatched", &
322 filename, __line__)
323 IF (any(positions /= ref_positions)) &
324 CALL test_abort("xt_idxlist_get_positions_of_indices &
325 &returned incorrect position", &
326 filename, __line__)
327 CALL xt_idxlist_delete(idxsection)
328 END SUBROUTINE test_get_positions1
329
330 SUBROUTINE test_get_positions2
331 INTEGER, PARAMETER :: n = 2, num_selection = 9
332 INTEGER(xt_int_kind), PARAMETER :: start=0_xi, &
333 global_size(n) = 4_xi, local_start(n) = (/ 0_xi, 2_xi /)
334 INTEGER, PARAMETER :: local_size(n) = 2
335 INTEGER(xt_int_kind), PARAMETER :: selection(num_selection) &
336 = (/ 2_xi, 1_xi, 5_xi, 7_xi, 6_xi, 7_xi, 7_xi, 6_xi, 8_xi /)
337 INTEGER, PARAMETER :: ref_positions(num_selection) &
338 = (/ 2*0 + 0, 1*0 - 1, 5*0 - 1, 7*0 + 3, 6*0 + 2, 7*0 + 3, 7*0 + 3, &
339 & 6*0 + 2, 8*0 - 1 /)
340 integer :: positions(num_selection), num_found, i, p
341 LOGICAL :: notfound
342 TYPE(xt_idxlist) :: idxsection
343 idxsection = xt_idxsection_new(start, n, global_size, local_size, &
344 local_start)
345 num_found = xt_idxlist_get_positions_of_indices(idxsection, selection, &
346 positions, .false.)
347 IF (num_found /= 3) &
348 CALL test_abort("xt_idxlist_get_position_of_indices &
349 &returned incorrect num_unmatched", &
350 filename, __line__)
351 IF (any(positions /= ref_positions)) &
352 CALL test_abort("xt_idxlist_get_position_of_indices &
353 &returned incorrect position", &
354 filename, __line__)
355 DO i = 1, num_selection
356 notfound = xt_idxlist_get_position_of_index(idxsection, selection(i), p)
357 IF (p /= ref_positions(i) &
358 .OR. (notfound .AND. ref_positions(i) /= -1)) &
359 CALL test_abort("xt_idxlist_get_position_of_index &
360 &returned incorrect position", &
361 filename, __line__)
362 END DO
363 CALL xt_idxlist_delete(idxsection)
364 END SUBROUTINE test_get_positions2
365
366 SUBROUTINE test_other_intersection
367 INTEGER, PARAMETER :: n = 2, num_sel_idx = 9
368 INTEGER(xt_int_kind), PARAMETER :: start=0_xi, &
369 global_size(n) = 4_xi, local_start(n) = (/ 0_xi, 2_xi /), &
370 sel_idx(num_sel_idx) &
371 = (/ 2_xi, 1_xi, 5_xi, 7_xi, 6_xi, 7_xi, 7_xi, 6_xi, 8_xi /), &
372 ref_inter_idx(6) = (/ 2_xi, 6_xi, 6_xi, 7_xi, 7_xi, 7_xi /)
373 INTEGER, PARAMETER :: local_size(n) = 2
374 TYPE(xt_idxlist) :: idxsection, sel_idxlist, inter_idxlist
375
376 idxsection = xt_idxsection_new(start, n, global_size, local_size, &
377 local_start)
378 sel_idxlist = xt_idxvec_new(sel_idx)
379 inter_idxlist = xt_idxlist_get_intersection(idxsection, sel_idxlist)
380 CALL xt_idxlist_delete(sel_idxlist)
381 CALL xt_idxlist_delete(idxsection)
382 CALL check_idxlist(inter_idxlist, ref_inter_idx)
383 CALL xt_idxlist_delete(inter_idxlist)
384 END SUBROUTINE test_other_intersection
385
386 ! test 2D section with arbitrary size signs
387 SUBROUTINE test_signed_sizes1
388 INTEGER :: i
389 TYPE(xt_idxlist) :: idxsection
390 INTEGER, PARAMETER :: n = 2
391 INTEGER(xt_int_kind), PARAMETER :: start = 0, &
392 global_size(n, 4) = reshape( &
393 (/ 5_xi, 10_xi, 5_xi,-10_xi, -5_xi, 10_xi, -5_xi, -10_xi /), &
394 (/ n, 4 /) ), &
395 local_start(2) = (/ 1_xi, 2_xi /), &
396 ref_indices(12, 16) = reshape( &
397 (/ 12_xi, 13_xi, 14_xi, 15_xi, 22_xi, 23_xi, 24_xi, 25_xi, 32_xi, &
398 & 33_xi, 34_xi, 35_xi, &
399 & 15_xi, 14_xi, 13_xi, 12_xi, 25_xi, 24_xi, 23_xi, 22_xi, 35_xi, &
400 & 34_xi, 33_xi, 32_xi, &
401 & 32_xi, 33_xi, 34_xi, 35_xi, 22_xi, 23_xi, 24_xi, 25_xi, 12_xi, &
402 & 13_xi, 14_xi, 15_xi, &
403 & 35_xi, 34_xi, 33_xi, 32_xi, 25_xi, 24_xi, 23_xi, 22_xi, 15_xi, &
404 & 14_xi, 13_xi, 12_xi, &
405 & 17_xi, 16_xi, 15_xi, 14_xi, 27_xi, 26_xi, 25_xi, 24_xi, 37_xi, &
406 & 36_xi, 35_xi, 34_xi, &
407 & 14_xi, 15_xi, 16_xi, 17_xi, 24_xi, 25_xi, 26_xi, 27_xi, 34_xi, &
408 & 35_xi, 36_xi, 37_xi, &
409 & 37_xi, 36_xi, 35_xi, 34_xi, 27_xi, 26_xi, 25_xi, 24_xi, 17_xi, &
410 & 16_xi, 15_xi, 14_xi, &
411 & 34_xi, 35_xi, 36_xi, 37_xi, 24_xi, 25_xi, 26_xi, 27_xi, 14_xi, &
412 & 15_xi, 16_xi, 17_xi, &
413 & 32_xi, 33_xi, 34_xi, 35_xi, 22_xi, 23_xi, 24_xi, 25_xi, 12_xi, &
414 & 13_xi, 14_xi, 15_xi, &
415 & 35_xi, 34_xi, 33_xi, 32_xi, 25_xi, 24_xi, 23_xi, 22_xi, 15_xi, &
416 & 14_xi, 13_xi, 12_xi, &
417 & 12_xi, 13_xi, 14_xi, 15_xi, 22_xi, 23_xi, 24_xi, 25_xi, 32_xi, &
418 & 33_xi, 34_xi, 35_xi, &
419 & 15_xi, 14_xi, 13_xi, 12_xi, 25_xi, 24_xi, 23_xi, 22_xi, 35_xi, &
420 & 34_xi, 33_xi, 32_xi, &
421 & 37_xi, 36_xi, 35_xi, 34_xi, 27_xi, 26_xi, 25_xi, 24_xi, 17_xi, &
422 & 16_xi, 15_xi, 14_xi, &
423 & 34_xi, 35_xi, 36_xi, 37_xi, 24_xi, 25_xi, 26_xi, 27_xi, 14_xi, &
424 & 15_xi, 16_xi, 17_xi, &
425 & 17_xi, 16_xi, 15_xi, 14_xi, 27_xi, 26_xi, 25_xi, 24_xi, 37_xi, &
426 & 36_xi, 35_xi, 34_xi, &
427 & 14_xi, 15_xi, 16_xi, 17_xi, 24_xi, 25_xi, 26_xi, 27_xi, 34_xi, &
428 & 35_xi, 36_xi, 37_xi /), (/ 12, 16 /) )
429 INTEGER, PARAMETER :: local_size(n, 4) = reshape( &
430 (/ 3, 4, 3, -4, -3, 4, -3, -4 /), (/ n, 4 /) )
431 ! iterate through all sign combinations of -/+ for local and global
432 ! and for x and y, giving 2^2^2 combinations
433 DO i = 0, 15
434 ! create index section
435
436 idxsection = xt_idxsection_new(start, n, global_size(:, i/4 + 1), &
437 local_size(:, mod(i, 4) + 1), local_start)
438
439 ! testing
440 CALL check_idxlist(idxsection, ref_indices(:, i + 1))
441
442 ! clean up
443 CALL xt_idxlist_delete(idxsection)
444 END DO
445 END SUBROUTINE test_signed_sizes1
446
447 ! test 2D section with arbitrary size signs
448 SUBROUTINE test_signed_sizes2
449 INTEGER :: i
450 TYPE(xt_idxlist) :: idxsection
451 INTEGER, PARAMETER :: n = 2
452 INTEGER(xt_int_kind), PARAMETER :: start = 0, &
453 global_size(n, 4) = reshape( &
454 (/ 5_xi, 6_xi, 5_xi,-6_xi, -5_xi, 6_xi, -5_xi, -6_xi /), &
455 (/ n, 4 /) ), &
456 local_start(2) = (/ 1_xi, 2_xi /), &
457 ref_indices(6, 16) = reshape( &
458 (/ 8_xi, 9_xi, 10_xi, 14_xi, 15_xi, 16_xi, &
459 & 10_xi, 9_xi, 8_xi, 16_xi, 15_xi, 14_xi, &
460 & 14_xi, 15_xi, 16_xi, 8_xi, 9_xi, 10_xi, &
461 & 16_xi, 15_xi, 14_xi, 10_xi, 9_xi, 8_xi, &
462 & 9_xi, 8_xi, 7_xi, 15_xi, 14_xi, 13_xi, &
463 & 7_xi, 8_xi, 9_xi, 13_xi, 14_xi, 15_xi, &
464 & 15_xi, 14_xi, 13_xi, 9_xi, 8_xi, 7_xi, &
465 & 13_xi, 14_xi, 15_xi, 7_xi, 8_xi, 9_xi, &
466 & 20_xi, 21_xi, 22_xi, 14_xi, 15_xi, 16_xi, &
467 & 22_xi, 21_xi, 20_xi, 16_xi, 15_xi, 14_xi, &
468 & 14_xi, 15_xi, 16_xi, 20_xi, 21_xi, 22_xi, &
469 & 16_xi, 15_xi, 14_xi, 22_xi, 21_xi, 20_xi, &
470 & 21_xi, 20_xi, 19_xi, 15_xi, 14_xi, 13_xi, &
471 & 19_xi, 20_xi, 21_xi, 13_xi, 14_xi, 15_xi, &
472 & 15_xi, 14_xi, 13_xi, 21_xi, 20_xi, 19_xi, &
473 & 13_xi, 14_xi, 15_xi, 19_xi, 20_xi, 21_xi /), (/ 6, 16 /) )
474 ! iterate through all sign combinations of -/+ for local and global
475 INTEGER, PARAMETER :: local_size(n, 4) = reshape( &
476 (/ 2, 3, 2, -3, -2, 3, -2, -3 /), (/ n, 4 /) )
477 ! iterate through all sign combinations of -/+ for local and global
478 ! and for x and y, giving 2^2^2 combinations
479 DO i = 0, 15
480 ! create index section
481
482 idxsection = xt_idxsection_new(start, n, global_size(:, i/4 + 1), &
483 local_size(:, mod(i, 4) + 1), local_start)
484
485 ! testing
486 CALL check_idxlist(idxsection, ref_indices(:, i + 1))
487
488 ! clean up
489 CALL xt_idxlist_delete(idxsection)
490 END DO
491 END SUBROUTINE test_signed_sizes2
492
493 SUBROUTINE test_signed_size_intersections
494 INTEGER, PARAMETER :: n = 2
495 INTEGER(xt_int_kind), PARAMETER :: start = 0, &
496 global_size(n, 4) = reshape( &
497 (/ 5_xi, 10_xi, 5_xi,-10_xi, -5_xi, 10_xi, -5_xi, -10_xi /), &
498 (/ n, 4 /) ), &
499 local_start(2) = (/ 1_xi, 2_xi /), &
500 indices(12, 16) = reshape( &
501 (/ 12_xi, 13_xi, 14_xi, 15_xi, 22_xi, 23_xi, 24_xi, 25_xi, 32_xi, &
502 & 33_xi, 34_xi, 35_xi, &
503 & 15_xi, 14_xi, 13_xi, 12_xi, 25_xi, 24_xi, 23_xi, 22_xi, 35_xi, &
504 & 34_xi, 33_xi, 32_xi, &
505 & 32_xi, 33_xi, 34_xi, 35_xi, 22_xi, 23_xi, 24_xi, 25_xi, 12_xi, &
506 & 13_xi, 14_xi, 15_xi, &
507 & 35_xi, 34_xi, 33_xi, 32_xi, 25_xi, 24_xi, 23_xi, 22_xi, 15_xi, &
508 & 14_xi, 13_xi, 12_xi, &
509 & 17_xi, 16_xi, 15_xi, 14_xi, 27_xi, 26_xi, 25_xi, 24_xi, 37_xi, &
510 & 36_xi, 35_xi, 34_xi, &
511 & 14_xi, 15_xi, 16_xi, 17_xi, 24_xi, 25_xi, 26_xi, 27_xi, 34_xi, &
512 & 35_xi, 36_xi, 37_xi, &
513 & 37_xi, 36_xi, 35_xi, 34_xi, 27_xi, 26_xi, 25_xi, 24_xi, 17_xi, &
514 & 16_xi, 15_xi, 14_xi, &
515 & 34_xi, 35_xi, 36_xi, 37_xi, 24_xi, 25_xi, 26_xi, 27_xi, 14_xi, &
516 & 15_xi, 16_xi, 17_xi, &
517 & 32_xi, 33_xi, 34_xi, 35_xi, 22_xi, 23_xi, 24_xi, 25_xi, 12_xi, &
518 & 13_xi, 14_xi, 15_xi, &
519 & 35_xi, 34_xi, 33_xi, 32_xi, 25_xi, 24_xi, 23_xi, 22_xi, 15_xi, &
520 & 14_xi, 13_xi, 12_xi, &
521 & 12_xi, 13_xi, 14_xi, 15_xi, 22_xi, 23_xi, 24_xi, 25_xi, 32_xi, &
522 & 33_xi, 34_xi, 35_xi, &
523 & 15_xi, 14_xi, 13_xi, 12_xi, 25_xi, 24_xi, 23_xi, 22_xi, 35_xi, &
524 & 34_xi, 33_xi, 32_xi, &
525 & 37_xi, 36_xi, 35_xi, 34_xi, 27_xi, 26_xi, 25_xi, 24_xi, 17_xi, &
526 & 16_xi, 15_xi, 14_xi, &
527 & 34_xi, 35_xi, 36_xi, 37_xi, 24_xi, 25_xi, 26_xi, 27_xi, 14_xi, &
528 & 15_xi, 16_xi, 17_xi, &
529 & 17_xi, 16_xi, 15_xi, 14_xi, 27_xi, 26_xi, 25_xi, 24_xi, 37_xi, &
530 & 36_xi, 35_xi, 34_xi, &
531 & 14_xi, 15_xi, 16_xi, 17_xi, 24_xi, 25_xi, 26_xi, 27_xi, 34_xi, &
532 & 35_xi, 36_xi, 37_xi /), (/ 12, 16 /) )
533 INTEGER, PARAMETER :: local_size(n, 4) = reshape( &
534 (/ 3, 4, 3, -4, -3, 4, -3, -4 /), (/ n, 4 /) )
535 INTEGER :: i, j
536 TYPE(xt_idxlist) :: idxsection_a, idxsection_b, &
537 idxvec_a, idxvec_b, idxsection_intersection, &
538 idxsection_intersection_other, idxvec_intersection
539
540 DO i = 0, 15
541 DO j = 0, 15
542 ! create index section
543 idxsection_a = xt_idxsection_new(start, n, global_size(:, i/4 + 1), &
544 local_size(:, mod(i, 4) + 1), local_start)
545 idxsection_b = xt_idxsection_new(start, n, global_size(:, j/4 + 1), &
546 local_size(:, mod(j, 4) + 1), local_start)
547 ! create reference index vectors
548 idxvec_a = xt_idxvec_new(indices(:, i+1))
549 idxvec_b = xt_idxvec_new(indices(:, j+1))
550
551 ! testing
552 idxsection_intersection = xt_idxlist_get_intersection(idxsection_a, &
553 idxsection_b)
554 idxsection_intersection_other &
555 = xt_idxlist_get_intersection(idxsection_a, idxvec_b)
556 idxvec_intersection = xt_idxlist_get_intersection(idxvec_a, idxvec_b)
557
558 CALL check_idxlist(idxsection_intersection, &
559 xt_idxlist_get_indices_const(idxvec_intersection))
560 CALL check_idxlist(idxsection_intersection_other, &
561 xt_idxlist_get_indices_const(idxvec_intersection))
562
563 ! clean up
564
565 CALL xt_idxlist_delete(idxsection_a)
566 CALL xt_idxlist_delete(idxsection_b)
567 CALL xt_idxlist_delete(idxvec_a)
568 CALL xt_idxlist_delete(idxvec_b)
569 CALL xt_idxlist_delete(idxsection_intersection)
570 CALL xt_idxlist_delete(idxsection_intersection_other)
571 CALL xt_idxlist_delete(idxvec_intersection)
572 END DO
573 END DO
574 END SUBROUTINE test_signed_size_intersections
575
576 SUBROUTINE test_signed_size_positions
577 TYPE(xt_idxlist) :: idxsection
578 INTEGER, PARAMETER :: n = 2, num_pos = 34
579 INTEGER :: positions(num_pos)
580
581 INTEGER(xt_int_kind), PARAMETER :: start = 0, &
582 global_size(n) = (/ -5_xi, 6_xi /), &
583 local_start(n) = (/ 1_xi, 2_xi /), &
584 ref_indices(6) = (/ 16_xi, 15_xi, 14_xi, 22_xi, 21_xi, 20_xi /), &
585 indices(num_pos) = &
586 (/ -1_xi, 0_xi, 1_xi, 2_xi, 3_xi, &
587 & 4_xi, 5_xi, 6_xi, 7_xi, 8_xi, &
588 & 9_xi, 10_xi, 11_xi, 12_xi, 13_xi, &
589 & 14_xi, 15_xi, 14_xi, 16_xi, 17_xi, &
590 & 18_xi, 19_xi, 20_xi, 20_xi, 21_xi, &
591 & 22_xi, 23_xi, 24_xi, 25_xi, 26_xi, &
592 & 27_xi, 28_xi, 29_xi, 30_xi /)
593 INTEGER, PARAMETER :: local_size(n) = (/ -2, -3 /)
594 INTEGER, PARAMETER :: ref_positions(num_pos) = &
595 (/ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, &
596 & -1, -1, -1, -1, -1, 2, 1, -1, 0, -1, &
597 & -1, -1, 5, -1, 4, 3, -1, -1, -1, -1, &
598 & -1, -1, -1, -1 /)
599
600 ! create index section
601 idxsection = xt_idxsection_new(start, n, global_size, &
602 local_size, local_start)
603
604 ! testing
605 CALL check_idxlist(idxsection, ref_indices)
606
607 ! check get_positions_of_indices
608 if (xt_idxlist_get_positions_of_indices(idxsection, indices, positions, &
609 .true.) /= 28) &
610 CALL test_abort("error in xt_idxlist_get_positions_of_indices &
611 &(wrong number of unmatched indices)", &
612 filename, __line__)
613
614 IF (any(ref_positions /= positions)) &
615 call test_abort("error in xt_idxlist_get_positions_of_indices &
616 &(wrong position)", &
617 filename, __line__)
618
619 ! clean up
620 CALL xt_idxlist_delete(idxsection)
621 END SUBROUTINE test_signed_size_positions
622
623 SUBROUTINE test_section_with_stride(start, global_size, local_size, &
624 local_start, ref_indices)
625 INTEGER(xt_int_kind), INTENT(in) :: start, global_size(:), &
626 local_start(:), ref_indices(:)
627 INTEGER, INTENT(in) :: local_size(:)
628 TYPE(xt_idxlist) :: idxsection
629 idxsection = xt_idxsection_new(start, SIZE(global_size), global_size, &
630 local_size, local_start)
631 CALL check_idxlist(idxsection, ref_indices)
632 CALL xt_idxlist_delete(idxsection)
633 END SUBROUTINE test_section_with_stride
634
635 SUBROUTINE test_section_with_stride1
636 INTEGER, PARAMETER :: num_dimensions = 3
637 INTEGER(xt_int_kind), PARAMETER :: start = 0_xi, &
638 global_size(num_dimensions) = (/ 5_xi, 5_xi, 2_xi /), &
639 local_start(num_dimensions) = (/ 2_xi, 0_xi, 1_xi /), &
640 ref_indices(12) = &
641 (/ 21_xi, 23_xi, 25_xi, 27_xi, &
642 & 31_xi, 33_xi, 35_xi, 37_xi, &
643 & 41_xi, 43_xi, 45_xi, 47_xi /)
644 INTEGER, PARAMETER :: local_size(num_dimensions) = (/ 3, 4, 1 /)
645 CALL test_section_with_stride(start, global_size, local_size, local_start, &
646 ref_indices)
647 END SUBROUTINE test_section_with_stride1
648
649 SUBROUTINE test_section_with_stride2
650 INTEGER, PARAMETER :: num_dimensions = 4
651 INTEGER(xt_int_kind), PARAMETER :: start = 0_xi, &
652 global_size(num_dimensions) = (/ 3_xi, 2_xi, 5_xi, 2_xi /), &
653 local_start(num_dimensions) = (/ 0_xi, 1_xi, 1_xi, 0_xi /), &
654 ref_indices(12) = &
655 (/ 12_xi, 14_xi, 16_xi, 18_xi, &
656 & 32_xi, 34_xi, 36_xi, 38_xi, &
657 & 52_xi, 54_xi, 56_xi, 58_xi /)
658 INTEGER, PARAMETER :: local_size(num_dimensions) = (/ 3, 1, 4, 1 /)
659 CALL test_section_with_stride(start, global_size, local_size, local_start, &
660 ref_indices)
661 END SUBROUTINE test_section_with_stride2
662
663 SUBROUTINE check_bb(start, global_size, local_size, &
664 local_start, bb_start, global_bb_size, ref_bb)
665 INTEGER(xt_int_kind), INTENT(in) :: start, global_size(:), local_start(:), &
666 bb_start, global_bb_size(:)
667 INTEGER, INTENT(in) :: local_size(:)
668 TYPE(xt_bounds), INTENT(in) :: ref_bb(:)
669 TYPE(xt_idxlist) :: idxsection
670 TYPE(xt_bounds) :: bounds(SIZE(global_bb_size))
671 idxsection = xt_idxsection_new(start, SIZE(global_size), global_size, &
672 local_size, local_start)
673 bounds = xt_idxlist_get_bounding_box(idxsection, global_bb_size, bb_start)
674 IF (any(bounds /= ref_bb)) &
675 CALL test_abort("bounding box mismatch", filename, __line__)
676 CALL xt_idxlist_delete(idxsection)
677 END SUBROUTINE check_bb
678
679 SUBROUTINE test_bb1
680 INTEGER, PARAMETER :: num_dimensions = 3
681 INTEGER(xt_int_kind), PARAMETER :: start = 0_xi, &
682 global_size(num_dimensions) = 4_xi, &
683 local_start(num_dimensions) = (/ 2_xi, 0_xi, 1_xi /)
684 INTEGER, PARAMETER :: local_size(num_dimensions) = 0
685 TYPE(xt_bounds), PARAMETER :: ref_bb(num_dimensions) = xt_bounds(0, 0)
686 CALL check_bb(start, global_size, local_size, local_start, start, &
687 int(global_size, xt_int_kind), ref_bb)
688 END SUBROUTINE test_bb1
689
690 SUBROUTINE test_bb2
691 INTEGER, PARAMETER :: num_dimensions = 3
692 INTEGER(xt_int_kind), PARAMETER :: start = 1_xi, &
693 global_size(num_dimensions) = (/ 5_xi, 4_xi, 3_xi /), &
694 local_start(num_dimensions) = (/ 2_xi, 2_xi, 1_xi /)
695 INTEGER, PARAMETER :: local_size(num_dimensions) = 2
696 TYPE(xt_bounds), PARAMETER :: ref_bb(num_dimensions) = &
697 (/ xt_bounds(2, 2), xt_bounds(2, 2), xt_bounds(1, 2) /)
698 CALL check_bb(start, global_size, local_size, local_start, start, &
699 int(global_size, xt_int_kind), ref_bb)
700 END SUBROUTINE test_bb2
701
702 SUBROUTINE test_bb3
703 INTEGER, PARAMETER :: num_dimensions = 4, bb_ndim = 3
704 INTEGER(xt_int_kind), PARAMETER :: start = 1_xi, &
705 global_size(num_dimensions) = (/ 5_xi, 2_xi, 2_xi, 3_xi /), &
706 local_start(num_dimensions) = (/ 2_xi, 0_xi, 1_xi, 1_xi /), &
707 global_bb_size(bb_ndim) = (/ 5_xi, 4_xi, 3_xi /)
708 INTEGER, PARAMETER :: local_size(num_dimensions) = (/ 2, 2, 1, 2 /)
709 TYPE(xt_bounds), PARAMETER :: ref_bb(bb_ndim) = &
710 (/ xt_bounds(2, 2), xt_bounds(1, 3), xt_bounds(1, 2) /)
711 CALL check_bb(start, global_size, local_size, local_start, start, &
712 global_bb_size, ref_bb)
713 END SUBROUTINE test_bb3
714
715 SUBROUTINE do_tests(idxlist, ref_indices, ref_stripes)
716 TYPE(xt_idxlist), INTENT(in) :: idxlist
717 INTEGER(xt_int_kind), INTENT(in) :: ref_indices(:)
718 TYPE(xt_stripe), OPTIONAL, INTENT(in) :: ref_stripes(:)
719
720 TYPE(xt_stripe), ALLOCATABLE :: stripes(:)
721 TYPE(xt_idxlist) :: idxlist_copy
722
723 CALL check_idxlist(idxlist, ref_indices)
724 IF (PRESENT(ref_stripes)) THEN
725 CALL xt_idxlist_get_index_stripes(idxlist, stripes)
726 IF (ALLOCATED(stripes)) THEN
727 CALL check_stripes(stripes, ref_stripes)
728 DEALLOCATE(stripes)
729 ELSE
730 IF (SIZE(ref_stripes) /= 0) &
731 CALL test_abort("failed to reproduce stripes", filename, __line__)
732 END IF
733 END IF
734
735 ! test packing and unpacking
736 idxlist_copy = idxlist_pack_unpack_copy(idxlist)
737 ! check copy
738 CALL check_idxlist(idxlist_copy, ref_indices)
739
740 CALL xt_idxlist_delete(idxlist_copy)
741
742 ! test copying
743 idxlist_copy = xt_idxlist_copy(idxlist)
744
745 ! check copy
746 CALL check_idxlist(idxlist_copy, ref_indices)
747
748 ! clean up
749 CALL xt_idxlist_delete(idxlist_copy)
750 END SUBROUTINE do_tests
751
752END PROGRAM test_idxsection
753!
754! Local Variables:
755! f90-continuation-indent: 5
756! coding: utf-8
757! indent-tabs-mode: nil
758! show-trailing-whitespace: t
759! require-trailing-newline: t
760! End:
761!
void xt_initialize(MPI_Comm default_comm)
Definition xt_init.c:70
void xt_finalize(void)
Definition xt_init.c:92
int xt_idxlist_get_positions_of_indices(Xt_idxlist idxlist, const Xt_int *indices, int num_indices, int *positions, int single_match_only)
Definition xt_idxlist.c:221
const Xt_int * xt_idxlist_get_indices_const(Xt_idxlist idxlist)
Definition xt_idxlist.c:119
void xt_idxlist_get_index_stripes(Xt_idxlist idxlist, struct Xt_stripe **stripes, int *num_stripes)
Definition xt_idxlist.c:135
void xt_idxlist_get_bounding_box(Xt_idxlist idxlist, unsigned ndim, const Xt_int global_size[ndim], Xt_int global_start_index, struct Xt_bounds bounds[ndim])
Definition xt_idxlist.c:379
Xt_idxlist xt_idxlist_get_intersection(Xt_idxlist idxlist_src, Xt_idxlist idxlist_dst)
Xt_idxlist xt_idxlist_copy(Xt_idxlist idxlist)
Definition xt_idxlist.c:94
int xt_idxlist_get_position_of_index(Xt_idxlist idxlist, Xt_int index, int *position)
Definition xt_idxlist.c:214
void xt_idxlist_delete(Xt_idxlist idxlist)
Definition xt_idxlist.c:75
Xt_idxlist xt_idxsection_new(Xt_int start, int num_dimensions, const Xt_int global_size[num_dimensions], const int local_size[num_dimensions], const Xt_int local_start[num_dimensions])
Xt_idxlist xt_idxvec_new(const Xt_int *idxlist, int num_indices)
Definition xt_idxvec.c:213