46 PROGRAM test_idxsection
49 xt_int_kind, xt_bounds, xt_stripe, &
55 USE ftest_common,
ONLY: init_mpi, finish_mpi, test_abort
56 USE test_idxlist_utils,
ONLY: check_idxlist, test_err_count, check_stripes, &
57 idxlist_pack_unpack_copy
59 INTEGER,
PARAMETER :: xi = xt_int_kind
60 CHARACTER(len=*),
PARAMETER :: filename =
'test_idxsection_f.f90'
70 CALL test_1d_intersection1
71 CALL test_1d_intersection2
72 CALL test_2d_intersection1
75 CALL test_get_positions1
76 CALL test_get_positions2
77 CALL test_other_intersection
78 CALL test_signed_sizes1
79 CALL test_signed_sizes2
80 CALL test_signed_size_positions
81 CALL test_signed_size_intersections
82 CALL test_section_with_stride1
83 CALL test_section_with_stride2
88 IF (test_err_count() /= 0) &
89 CALL test_abort(
"non-zero error count!", filename, __line__)
94 SUBROUTINE test_1d_section
95 INTEGER(xt_int_kind),
PARAMETER :: start = 0_xi
96 INTEGER,
PARAMETER :: num_dimensions = 1
97 INTEGER(xt_int_kind),
PARAMETER :: global_size(num_dimensions) = 10_xi, &
98 local_start(num_dimensions) = 3_xi, &
99 ref_indices(5) = (/ 3_xi, 4_xi, 5_xi, 6_xi, 7_xi /)
100 INTEGER,
PARAMETER :: local_size(num_dimensions) = 5
101 TYPE(xt_stripe),
PARAMETER :: ref_stripes(1) = xt_stripe(3, 1, 5)
102 TYPE(xt_idxlist) :: idxsection
108 CALL do_tests(idxsection, ref_indices, ref_stripes)
112 END SUBROUTINE test_1d_section
114 SUBROUTINE test_2d_section
115 INTEGER(xt_int_kind),
PARAMETER :: start = 0_xi
116 INTEGER,
PARAMETER :: num_dimensions = 2
117 INTEGER(xt_int_kind),
PARAMETER :: global_size(num_dimensions) &
118 = (/ 5_xi, 6_xi /), &
119 local_start(num_dimensions) = (/ 1_xi, 2_xi /), &
120 ref_indices(6) = (/ 8_xi, 9_xi, 14_xi, 15_xi, 20_xi, 21_xi /)
121 INTEGER,
PARAMETER :: local_size(num_dimensions) = (/ 3, 2 /)
122 TYPE(xt_stripe),
PARAMETER :: ref_stripes(3) = (/ xt_stripe(8, 1, 2), &
123 xt_stripe(14, 1, 2), xt_stripe(20, 1, 2) /)
124 TYPE(xt_idxlist) :: idxsection
130 CALL do_tests(idxsection, ref_indices, ref_stripes)
134 END SUBROUTINE test_2d_section
136 SUBROUTINE test_3d_section
137 INTEGER(xt_int_kind),
PARAMETER :: start = 0_xi
138 INTEGER,
PARAMETER :: num_dimensions = 3
139 INTEGER(xt_int_kind),
PARAMETER :: global_size(num_dimensions) = 4_xi, &
140 local_start(num_dimensions) = (/ 0_xi, 1_xi, 1_xi /), &
141 ref_indices(16) = (/ 5_xi, 6_xi, 9_xi, 10_xi, 21_xi, 22_xi, 25_xi, &
142 26_xi, 37_xi, 38_xi, 41_xi, 42_xi, 53_xi, 54_xi, 57_xi, 58_xi /)
143 INTEGER,
PARAMETER :: local_size(num_dimensions) = (/ 4, 2, 2 /)
144 TYPE(xt_stripe),
PARAMETER :: ref_stripes(8) = (/ xt_stripe(5, 1, 2), &
145 xt_stripe(9, 1, 2), xt_stripe(21, 1, 2), xt_stripe(25, 1, 2), &
146 xt_stripe(37, 1, 2), xt_stripe(41, 1, 2), xt_stripe(53, 1, 2), &
147 xt_stripe(57, 1, 2) /)
148 TYPE(xt_idxlist) :: idxsection
154 CALL do_tests(idxsection, ref_indices, ref_stripes)
158 END SUBROUTINE test_3d_section
160 SUBROUTINE test_4d_section
161 INTEGER(xt_int_kind),
PARAMETER :: start = 0_xi
162 INTEGER,
PARAMETER :: num_dimensions = 4
163 INTEGER(xt_int_kind) :: i, j, k, l
164 INTEGER(xt_int_kind),
PARAMETER :: global_size(num_dimensions) &
165 = (/ 3_xi, 4_xi, 4_xi, 3_xi /), &
166 local_start(num_dimensions) &
167 = (/ 0_xi, 1_xi, 1_xi, 1_xi /), &
170 (/ 16_xi,17_xi,19_xi,20_xi,22_xi,23_xi, &
171 28_xi,29_xi,31_xi,32_xi,34_xi,35_xi, &
172 40_xi,41_xi,43_xi,44_xi,46_xi,47_xi, &
173 64_xi,65_xi,67_xi,68_xi,70_xi,71_xi, &
174 76_xi,77_xi,79_xi,80_xi,82_xi,83_xi, &
175 88_xi,89_xi,91_xi,92_xi,94_xi,95_xi /)
178 = (/ ((((16_xi + i + j*3_xi + k*12_xi + l*48_xi, &
179 & i=0_xi,1_xi), j=0_xi,2_xi), k=0_xi,2_xi), l=0_xi,1_xi) /)
181 INTEGER,
PARAMETER :: local_size(num_dimensions) = (/ 2, 3, 3, 2 /)
182 TYPE(xt_stripe),
PARAMETER :: ref_stripes(18) &
183 = (/ (((xt_stripe(16_xi + j*3_xi + k*12_xi + l*48_xi, 1_xi, 2), &
184 & j = 0_xi,2_xi), k=0_xi,2_xi), l=0_xi,1_xi) /)
185 TYPE(xt_idxlist) :: idxsection
191 CALL do_tests(idxsection, ref_indices, ref_stripes)
195 END SUBROUTINE test_4d_section
197 SUBROUTINE test_2d_simple
198 INTEGER(xt_int_kind),
PARAMETER :: start = 0_xi
199 INTEGER,
PARAMETER :: num_dimensions = 2
200 INTEGER(xt_int_kind) :: i, j
201 INTEGER(xt_int_kind),
PARAMETER :: global_size(num_dimensions) &
202 = (/ 5_xi, 10_xi /), &
203 local_start(num_dimensions) = (/ 1_xi, 2_xi /), &
205 = (/ ((12_xi + i + j*10_xi, i=0_xi,3_xi), j=0_xi,2_xi) /)
206 INTEGER,
PARAMETER :: local_size(num_dimensions) = (/ 3, 4 /)
207 TYPE(xt_idxlist) :: idxsection
213 CALL check_idxlist(idxsection, ref_indices)
216 END SUBROUTINE test_2d_simple
218 SUBROUTINE test_intersection(&
219 start_a, global_size_a, local_size_a, local_start_a, &
220 start_b, global_size_b, local_size_b, local_start_b, &
221 ref_indices, ref_stripes)
222 INTEGER(xt_int_kind),
INTENT(in) :: start_a, start_b, global_size_a(:), &
223 global_size_b(:), local_start_a(:), local_start_b(:), ref_indices(:)
224 INTEGER,
INTENT(in) :: local_size_a(:), local_size_b(:)
225 TYPE(xt_stripe),
INTENT(in) :: ref_stripes(:)
226 TYPE(xt_idxlist) :: idxsection(2), intersection
234 CALL do_tests(intersection, ref_indices, ref_stripes)
236 END SUBROUTINE test_intersection
238 SUBROUTINE test_1d_intersection1
239 INTEGER(xt_int_kind),
PARAMETER :: start=0_xi, &
240 global_size_a(1) = 10_xi, global_size_b(1) = 15_xi, &
241 local_start_a(1) = 4_xi, local_start_b(1) = 7_xi, &
242 ref_indices(2) = (/ 7_xi, 8_xi /)
243 INTEGER,
PARAMETER :: local_size_a(1) = 5, local_size_b(1) = 6
244 TYPE(xt_stripe),
PARAMETER :: ref_stripes(1) = (/ xt_stripe(7, 1, 2) /)
245 CALL test_intersection(&
246 start, global_size_a, local_size_a, local_start_a, &
247 start, global_size_b, local_size_b, local_start_b, &
248 ref_indices, ref_stripes)
249 END SUBROUTINE test_1d_intersection1
251 SUBROUTINE test_1d_intersection2
252 INTEGER(xt_int_kind),
PARAMETER :: start=0_xi, global_size_a(1) = 10_xi, &
253 global_size_b(1) = 10_xi, local_start_a(1) = 3_xi, &
254 local_start_b(1) = 4_xi, ref_indices(1) = (/ -1_xi /)
255 INTEGER,
PARAMETER :: local_size_a(1) = 1, local_size_b(1) = 5
256 TYPE(xt_stripe),
PARAMETER :: ref_stripes(1) = (/ xt_stripe(-1, -1, -1) /)
257 CALL test_intersection(&
258 start, global_size_a, local_size_a, local_start_a, &
259 start, global_size_b, local_size_b, local_start_b, &
260 ref_indices(1:0), ref_stripes(1:0))
261 END SUBROUTINE test_1d_intersection2
263 SUBROUTINE test_2d_intersection1
264 INTEGER,
PARAMETER :: n = 2
265 INTEGER(xt_int_kind),
PARAMETER :: start=0_xi, &
266 global_size_a(n) = 6_xi, global_size_b(n) = 6_xi, &
267 local_start_a(n) = 1_xi, local_start_b(n) = (/ 3_xi, 2_xi /), &
268 ref_indices(2) = (/ 20_xi, 26_xi /)
269 INTEGER,
PARAMETER :: local_size_a(n) = (/ 4, 2 /), local_size_b(n) = 3
270 TYPE(xt_stripe),
PARAMETER :: ref_stripes(2) = (/ xt_stripe(20, 1, 1), &
271 xt_stripe(26, 1, 1) /)
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
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
287 CALL check_idxlist(idxsection, ref_indices)
289 END SUBROUTINE test_2d_1
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
300 CALL check_idxlist(idxsection, ref_indices)
302 END SUBROUTINE test_2d_2
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
319 IF (num_found /= 3) &
320 CALL test_abort(
"xt_idxlist_get_positions_of_indices &
321 &returned incorrect num_unmatched", &
323 IF (any(positions /= ref_positions)) &
324 CALL test_abort(
"xt_idxlist_get_positions_of_indices &
325 &returned incorrect position", &
328 END SUBROUTINE test_get_positions1
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
342 TYPE(xt_idxlist) :: idxsection
347 IF (num_found /= 3) &
348 CALL test_abort(
"xt_idxlist_get_position_of_indices &
349 &returned incorrect num_unmatched", &
351 IF (any(positions /= ref_positions)) &
352 CALL test_abort(
"xt_idxlist_get_position_of_indices &
353 &returned incorrect position", &
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", &
364 END SUBROUTINE test_get_positions2
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
382 CALL check_idxlist(inter_idxlist, ref_inter_idx)
384 END SUBROUTINE test_other_intersection
387 SUBROUTINE test_signed_sizes1
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 /), &
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 /) )
437 local_size(:, mod(i, 4) + 1), local_start)
440 CALL check_idxlist(idxsection, ref_indices(:, i + 1))
445 END SUBROUTINE test_signed_sizes1
448 SUBROUTINE test_signed_sizes2
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 /), &
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 /) )
475 INTEGER,
PARAMETER :: local_size(n, 4) = reshape( &
476 (/ 2, 3, 2, -3, -2, 3, -2, -3 /), (/ n, 4 /) )
483 local_size(:, mod(i, 4) + 1), local_start)
486 CALL check_idxlist(idxsection, ref_indices(:, i + 1))
491 END SUBROUTINE test_signed_sizes2
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 /), &
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 /) )
536 TYPE(xt_idxlist) :: idxsection_a, idxsection_b, &
537 idxvec_a, idxvec_b, idxsection_intersection, &
538 idxsection_intersection_other, idxvec_intersection
544 local_size(:, mod(i, 4) + 1), local_start)
546 local_size(:, mod(j, 4) + 1), local_start)
554 idxsection_intersection_other &
558 CALL check_idxlist(idxsection_intersection, &
560 CALL check_idxlist(idxsection_intersection_other, &
574 END SUBROUTINE test_signed_size_intersections
576 SUBROUTINE test_signed_size_positions
577 TYPE(xt_idxlist) :: idxsection
578 INTEGER,
PARAMETER :: n = 2, num_pos = 34
579 INTEGER :: positions(num_pos)
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 /), &
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, &
602 local_size, local_start)
605 CALL check_idxlist(idxsection, ref_indices)
610 CALL test_abort(
"error in xt_idxlist_get_positions_of_indices &
611 &(wrong number of unmatched indices)", &
614 IF (any(ref_positions /= positions)) &
615 call test_abort(
"error in xt_idxlist_get_positions_of_indices &
616 &(wrong position)", &
621 END SUBROUTINE test_signed_size_positions
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
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 /), &
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, &
647 END SUBROUTINE test_section_with_stride1
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 /), &
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, &
661 END SUBROUTINE test_section_with_stride2
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
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
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
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
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(:)
720 TYPE(xt_stripe),
ALLOCATABLE :: stripes(:)
721 TYPE(xt_idxlist) :: idxlist_copy
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)
730 IF (
SIZE(ref_stripes) /= 0) &
731 CALL test_abort(
"failed to reproduce stripes", filename, __line__)
736 idxlist_copy = idxlist_pack_unpack_copy(idxlist)
738 CALL check_idxlist(idxlist_copy, ref_indices)
746 CALL check_idxlist(idxlist_copy, ref_indices)
750 END SUBROUTINE do_tests
752 END PROGRAM test_idxsection
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)
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)
const Xt_int * xt_idxlist_get_indices_const(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)