1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46#include "fc_feature_defs.inc"
47PROGRAM test_idxsection
48 USE mpi
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
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__)
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
107
108
109 CALL do_tests(idxsection, ref_indices, ref_stripes)
110
111
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), &
125 TYPE(xt_idxlist) :: idxsection
126
127
129
130
131 CALL do_tests(idxsection, ref_indices, ref_stripes)
132
133
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), &
149 TYPE(xt_idxlist) :: idxsection
150
151
153
154
155 CALL do_tests(idxsection, ref_indices, ref_stripes)
156
157
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
190
191
192 CALL do_tests(idxsection, ref_indices, ref_stripes)
193
194
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
212
213
214 CALL check_idxlist(idxsection, ref_indices)
215
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
229 local_start_a)
231 local_start_b)
235 CALL do_tests(intersection, ref_indices, ref_stripes)
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
286 local_start)
287 CALL check_idxlist(idxsection, ref_indices)
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
299 local_start)
300 CALL check_idxlist(idxsection, ref_indices)
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
316 local_start)
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__)
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
344 local_start)
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
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
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
377 local_start)
382 CALL check_idxlist(inter_idxlist, ref_inter_idx)
384 END SUBROUTINE test_other_intersection
385
386
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
432
433 DO i = 0, 15
434
435
437 local_size(:, mod(i, 4) + 1), local_start)
438
439
440 CALL check_idxlist(idxsection, ref_indices(:, i + 1))
441
442
444 END DO
445 END SUBROUTINE test_signed_sizes1
446
447
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
475 INTEGER, PARAMETER :: local_size(n, 4) = reshape( &
476 (/ 2, 3, 2, -3, -2, 3, -2, -3 /), (/ n, 4 /) )
477
478
479 DO i = 0, 15
480
481
483 local_size(:, mod(i, 4) + 1), local_start)
484
485
486 CALL check_idxlist(idxsection, ref_indices(:, i + 1))
487
488
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
544 local_size(:, mod(i, 4) + 1), local_start)
546 local_size(:, mod(j, 4) + 1), local_start)
547
550
551
553 idxsection_b)
554 idxsection_intersection_other &
557
558 CALL check_idxlist(idxsection_intersection, &
560 CALL check_idxlist(idxsection_intersection_other, &
562
563
564
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
602 local_size, local_start)
603
604
605 CALL check_idxlist(idxsection, ref_indices)
606
607
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
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
630 local_size, local_start)
631 CALL check_idxlist(idxsection, ref_indices)
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))
672 local_size, local_start)
674 IF (any(bounds /= ref_bb)) &
675 CALL test_abort("bounding box mismatch", filename, __line__)
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) = &
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) = &
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
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
736 idxlist_copy = idxlist_pack_unpack_copy(idxlist)
737
738 CALL check_idxlist(idxlist_copy, ref_indices)
739
741
742
744
745
746 CALL check_idxlist(idxlist_copy, ref_indices)
747
748
750 END SUBROUTINE do_tests
751
752END PROGRAM test_idxsection
753
754
755
756
757
758
759
760
761
void xt_initialize(MPI_Comm default_comm)
int xt_idxlist_get_positions_of_indices(Xt_idxlist idxlist, const Xt_int *indices, int num_indices, int *positions, int single_match_only)
const Xt_int * xt_idxlist_get_indices_const(Xt_idxlist idxlist)
void xt_idxlist_get_index_stripes(Xt_idxlist idxlist, struct Xt_stripe **stripes, int *num_stripes)
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])
Xt_idxlist xt_idxlist_get_intersection(Xt_idxlist idxlist_src, Xt_idxlist idxlist_dst)
Xt_idxlist xt_idxlist_copy(Xt_idxlist idxlist)
int xt_idxlist_get_position_of_index(Xt_idxlist idxlist, Xt_int index, int *position)
void xt_idxlist_delete(Xt_idxlist idxlist)
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)