57 USE ftest_common,
ONLY: init_mpi, finish_mpi, test_abort
58 USE test_idxlist_utils,
ONLY: check_idxlist, test_err_count, check_stripes, &
59 check_offsets, idxlist_pack_unpack_copy
61 INTEGER,
PARAMETER :: xi = xt_int_kind
62 INTEGER(xt_int_kind),
PARAMETER :: index_vector(7) &
63 = (/ 1_xi, 2_xi, 3_xi, 4_xi, 5_xi, 6_xi, 7_xi /)
64 CHARACTER(len=*),
PARAMETER :: filename =
'test_idxvec_f.f90'
69 CALL test_idxvec_pack_unpack
71 CALL test_repeated_equal_indices
73 CALL test_intersection_surjective
74 CALL test_intersection_partial
75 CALL test_intersection_inverse_partial
76 CALL test_intersection_unsort_partial
77 CALL test_intersection_unsort_inverse_partial
85 CALL test_get_indices_at_positions1
86 CALL test_get_indices_at_positions2
87 CALL test_get_indices_at_positions3
88 CALL test_get_positions_of_indices
89 CALL test_bounding_box1
90 CALL test_bounding_box2
91 CALL test_bounding_box3
93 IF (test_err_count() /= 0) &
94 CALL test_abort(
"non-zero error count!", filename, __line__)
98 SUBROUTINE test_idxvec_pack_unpack
99 TYPE(xt_idxlist) :: idxvector, idxvector_copy, intersection
100 TYPE(xt_stripe),
PARAMETER :: ref_stripes(1) = (/ xt_stripe(1, 1, 7) /)
101 CALL setup_idxvec(idxvector, index_vector)
103 idxvector_copy = idxlist_pack_unpack_copy(idxvector)
105 CALL check_idxlist(idxvector_copy, index_vector)
109 CALL check_idxlist(intersection, index_vector)
111 CALL compare_stripes(idxvector, ref_stripes)
117 END SUBROUTINE test_idxvec_pack_unpack
119 SUBROUTINE test_copying
120 TYPE(xt_idxlist) :: idxvector, idxvector_copy
121 CALL setup_idxvec(idxvector, index_vector)
123 CALL check_idxlist(idxvector_copy, index_vector)
126 END SUBROUTINE test_copying
128 SUBROUTINE test_repeated_equal_indices
129 INTEGER(xt_int_kind),
PARAMETER :: index_vector(8) &
130 = (/ 1_xi, 2_xi, 3_xi, 7_xi, 5_xi, 6_xi, 7_xi, 7_xi /)
131 TYPE(xt_idxlist) :: idxvector
132 CALL setup_idxvec(idxvector, index_vector)
134 END SUBROUTINE test_repeated_equal_indices
136 SUBROUTINE test_positions
137 LOGICAL,
PARAMETER :: single_match_only = .true.
138 INTEGER(xt_int_kind),
PARAMETER :: index_vector(20) &
139 = (/ 10_xi, 15_xi, 14_xi, 13_xi, 12_xi, &
140 & 15_xi, 10_xi, 11_xi, 12_xi, 13_xi, &
141 & 23_xi, 18_xi, 19_xi, 20_xi, 21_xi, &
142 & 31_xi, 26_xi, 27_xi, 28_xi, 29_xi /), &
143 intersection_vector(13) &
144 = (/ 12_xi, 12_xi, 13_xi, 13_xi, 14_xi, &
145 & 15_xi, 15_xi, 20_xi, 21_xi, 23_xi, &
146 & 28_xi, 29_xi, 31_xi /)
147 INTEGER :: intersection_pos(SIZE(intersection_vector))
148 INTEGER,
PARAMETER :: ref_intersection_pos(SIZE(intersection_vector)) &
149 = (/ 4, 8, 3, 9, 2, 1, 5, 13, 14, 10, 18, 19, 15 /)
150 TYPE(xt_idxlist) :: idxvector
152 CALL setup_idxvec(idxvector, index_vector)
154 intersection_vector, intersection_pos, single_match_only)
156 CALL test_abort(
'expected indices not found!', filename, __line__)
157 CALL check_offsets(intersection_pos, ref_intersection_pos)
159 END SUBROUTINE test_positions
161 SUBROUTINE test_intersection(index_vector_a, index_vector_b, &
162 ref_intersection_indices)
163 INTEGER(xt_int_kind),
INTENT(in) :: index_vector_a(:), index_vector_b(:), &
164 ref_intersection_indices(:)
167 TYPE(xt_idxlist) :: idxvector1, idxvector2, intersection
168 CALL setup_idxvec(idxvector1, index_vector_a)
169 CALL setup_idxvec(idxvector2, index_vector_b)
171 CALL check_idxlist(intersection, ref_intersection_indices)
175 END SUBROUTINE test_intersection
177 SUBROUTINE test_intersection_surjective
178 INTEGER(xt_int_kind),
PARAMETER :: index_vector(3, 2) &
179 = reshape((/ 1_xi, 2_xi, 3_xi, 1_xi, 2_xi, 3_xi /), &
180 & shape(index_vector)), &
181 ref_intersection_indices(3) = (/ 1_xi, 2_xi, 3_xi /)
182 CALL test_intersection(index_vector(:, 1), index_vector(:, 2), &
183 ref_intersection_indices)
184 END SUBROUTINE test_intersection_surjective
186 SUBROUTINE test_intersection_partial
187 INTEGER(xt_int_kind),
PARAMETER :: index_vector(3, 2) &
188 = reshape((/ 1_xi, 2_xi, 3_xi, 2_xi, 3_xi, 4_xi /), &
189 & shape(index_vector)), &
190 ref_intersection_indices(2) = (/ 2_xi, 3_xi /)
191 CALL test_intersection(index_vector(:, 1), index_vector(:, 2), &
192 ref_intersection_indices)
193 END SUBROUTINE test_intersection_partial
195 SUBROUTINE test_intersection_inverse_partial
196 INTEGER(xt_int_kind),
PARAMETER :: index_vector(3, 2) &
197 = reshape((/ 2_xi, 3_xi, 4_xi, 1_xi, 2_xi, 3_xi /), &
198 & shape(index_vector)), &
199 ref_intersection_indices(2) = (/ 2_xi, 3_xi /)
200 CALL test_intersection(index_vector(:, 1), index_vector(:, 2), &
201 ref_intersection_indices)
202 END SUBROUTINE test_intersection_inverse_partial
204 SUBROUTINE test_intersection_unsort_partial
205 INTEGER(xt_int_kind),
PARAMETER :: index_vector(3, 2) &
206 = reshape((/ 4_xi, 2_xi, 3_xi, 3_xi, 1_xi, 2_xi /), &
207 & shape(index_vector)), &
208 ref_intersection_indices(2) = (/ 2_xi, 3_xi /)
209 CALL test_intersection(index_vector(:, 1), index_vector(:, 2), &
210 ref_intersection_indices)
211 END SUBROUTINE test_intersection_unsort_partial
213 SUBROUTINE test_intersection_unsort_inverse_partial
214 INTEGER(xt_int_kind),
PARAMETER :: index_vector(3, 2) &
215 = reshape((/ 3_xi, 1_xi, 2_xi, 4_xi, 2_xi, 3_xi /), &
216 & shape(index_vector)), &
217 ref_intersection_indices(2) = (/ 2_xi, 3_xi /)
218 CALL test_intersection(index_vector(:, 1), index_vector(:, 2), &
219 ref_intersection_indices)
220 END SUBROUTINE test_intersection_unsort_inverse_partial
222 SUBROUTINE test_idxvec_from_stripes(stripes, ref_indices)
223 TYPE(xt_stripe),
INTENT(in) :: stripes(:)
224 INTEGER(xt_int_kind),
INTENT(in) :: ref_indices(:)
226 TYPE(xt_idxlist) :: idxvec
228 CALL check_idxlist(idxvec, ref_indices)
230 END SUBROUTINE test_idxvec_from_stripes
232 SUBROUTINE test_stripes1
233 TYPE(xt_stripe),
PARAMETER :: stripes(2) = &
234 (/ xt_stripe(5, 1, 5), xt_stripe(4, -1, 5) /)
235 INTEGER(xt_int_kind),
PARAMETER :: ref_indices(10) &
236 = (/ 5_xi, 6_xi, 7_xi, 8_xi, 9_xi, 4_xi, 3_xi, 2_xi, 1_xi, 0_xi /)
237 CALL test_idxvec_from_stripes(stripes, ref_indices)
238 END SUBROUTINE test_stripes1
240 SUBROUTINE test_stripes2
241 TYPE(xt_stripe),
PARAMETER :: stripes(3) &
242 = (/ xt_stripe(0, 1, 5), xt_stripe(2, 1, 5), xt_stripe(4, 1, 5) /)
243 INTEGER(xt_int_kind),
PARAMETER :: ref_indices(15) &
244 = (/ 0_xi, 1_xi, 2_xi, 3_xi, 4_xi, &
245 & 2_xi, 3_xi, 4_xi, 5_xi, 6_xi, &
246 & 4_xi, 5_xi, 6_xi, 7_xi, 8_xi /)
247 CALL test_idxvec_from_stripes(stripes, ref_indices)
248 END SUBROUTINE test_stripes2
250 SUBROUTINE test_stripes3
251 TYPE(xt_stripe),
PARAMETER :: stripes(3) &
252 = (/ xt_stripe(2, 1, 5), xt_stripe(0, 1, 5), xt_stripe(4, 1, 5) /)
253 INTEGER(xt_int_kind),
PARAMETER :: ref_indices(15) &
254 = (/ 2_xi, 3_xi, 4_xi, 5_xi, 6_xi, &
255 & 0_xi, 1_xi, 2_xi, 3_xi, 4_xi, &
256 & 4_xi, 5_xi, 6_xi, 7_xi, 8_xi /)
257 CALL test_idxvec_from_stripes(stripes, ref_indices)
258 END SUBROUTINE test_stripes3
260 SUBROUTINE test_stripes4
261 TYPE(xt_stripe),
PARAMETER :: stripes(3) &
262 = (/ xt_stripe(2, 1, 5), xt_stripe(4, -1, 5), xt_stripe(4, 1, 5) /)
263 INTEGER(xt_int_kind),
PARAMETER :: ref_indices(15) &
264 = (/ 2_xi, 3_xi, 4_xi, 5_xi, 6_xi, &
265 & 4_xi, 3_xi, 2_xi, 1_xi, 0_xi, &
266 & 4_xi, 5_xi, 6_xi, 7_xi, 8_xi /)
267 CALL test_idxvec_from_stripes(stripes, ref_indices)
268 END SUBROUTINE test_stripes4
270 SUBROUTINE test_stripes5
271 TYPE(xt_stripe),
PARAMETER :: stripes(3) &
272 = (/ xt_stripe(0, 3, 5), xt_stripe(1, 3, 5), xt_stripe(14, -3, 5) /)
273 INTEGER(xt_int_kind),
PARAMETER :: ref_indices(15) &
274 = (/ 0_xi, 3_xi, 6_xi, 9_xi, 12_xi, &
275 & 1_xi, 4_xi, 7_xi, 10_xi, 13_xi, &
276 & 14_xi, 11_xi, 8_xi, 5_xi, 2_xi /)
277 CALL test_idxvec_from_stripes(stripes, ref_indices)
278 END SUBROUTINE test_stripes5
280 SUBROUTINE test_stripes6
281 TYPE(xt_stripe),
PARAMETER :: stripes(3) &
282 = (/ xt_stripe(0, 3, 5), xt_stripe(2, 3, 5), xt_stripe(14, -3, 5) /)
283 INTEGER(xt_int_kind),
PARAMETER :: ref_indices(15) &
284 = (/ 0_xi, 3_xi, 6_xi, 9_xi, 12_xi, &
285 & 2_xi, 5_xi, 8_xi, 11_xi, 14_xi, &
286 & 14_xi, 11_xi, 8_xi, 5_xi, 2_xi /)
287 CALL test_idxvec_from_stripes(stripes, ref_indices)
288 END SUBROUTINE test_stripes6
290 SUBROUTINE test_stripes7
291 TYPE(xt_stripe),
PARAMETER :: stripes(4) = (/ xt_stripe(0, -1, 5), &
292 xt_stripe(1, 1, 5), xt_stripe(-5, -1, 5), xt_stripe(6, 1, 5) /)
293 INTEGER(xt_int_kind),
PARAMETER :: ref_indices(20) &
294 = (/ 0_xi, -1_xi, -2_xi, -3_xi, -4_xi, &
295 & 1_xi, 2_xi, 3_xi, 4_xi, 5_xi, &
296 & -5_xi, -6_xi, -7_xi, -8_xi, -9_xi, &
297 & 6_xi, 7_xi, 8_xi, 9_xi, 10_xi /)
298 CALL test_idxvec_from_stripes(stripes, ref_indices)
299 END SUBROUTINE test_stripes7
301 SUBROUTINE test_get_indices_at_positions(indices, undef_idx, pos)
302 INTEGER(xt_int_kind),
INTENT(in) :: indices(:), undef_idx
303 INTEGER,
INTENT(in) :: pos(:)
304 INTEGER(xt_int_kind) :: ref_sel_idx(SIZE(pos)), sel_idx(SIZE(pos))
305 INTEGER :: i, num_pos, undef_count, ref_undef_count
306 TYPE(xt_idxlist) :: idxvec
314 ref_sel_idx(i) = undef_idx
315 ref_undef_count = ref_undef_count + 1
320 IF (undef_count /= ref_undef_count)
THEN
321 CALL test_abort(
"test_idxvec_f.f90: (undef_count /= ref_undef_count)", &
325 IF (sel_idx(i) /= ref_sel_idx(i))
THEN
326 WRITE (msg,
'(2(a,i0),a)')
"test_idxvec_f.f90: (sel_idx(", i, &
327 ") /= ref_sel_idx(", i,
"))"
328 CALL test_abort(msg, filename, __line__)
332 END SUBROUTINE test_get_indices_at_positions
334 SUBROUTINE test_get_indices_at_positions1
335 INTEGER(xt_int_kind),
PARAMETER :: indices(16) &
336 = (/ 0_xi, 3_xi, 6_xi, 9_xi, 12_xi, 1_xi, 4_xi, 7_xi, &
337 & 10_xi, 13_xi, 14_xi, 11_xi, 8_xi, 5_xi, 2_xi, 1_xi /)
338 INTEGER(xt_int_kind),
PARAMETER :: undef_idx = -huge(undef_idx)
339 INTEGER,
PARAMETER :: pos(13) &
340 = (/ 0, 2, 7, 9, 11, 100, 11, 200, 9, 300, 7, 400, 5 /)
341 CALL test_get_indices_at_positions(indices, undef_idx, pos)
342 END SUBROUTINE test_get_indices_at_positions1
344 SUBROUTINE test_get_indices_at_positions2
345 INTEGER(xt_int_kind),
PARAMETER :: indices(16) &
346 = (/ 0_xi, 3_xi, 6_xi, 9_xi, 12_xi, 1_xi, 4_xi, 7_xi, &
347 & 10_xi, 13_xi, 14_xi, 11_xi, 8_xi, 5_xi, 2_xi, 1_xi /)
348 INTEGER(xt_int_kind),
PARAMETER :: undef_idx = -huge(undef_idx)
349 INTEGER,
PARAMETER :: pos(9) &
350 = (/ 0, 2, 7, 9, 11, 11, 9, 7, 5 /)
351 CALL test_get_indices_at_positions(indices, undef_idx, pos)
352 END SUBROUTINE test_get_indices_at_positions2
354 SUBROUTINE test_get_indices_at_positions3
355 INTEGER(xt_int_kind),
PARAMETER :: indices(16) &
356 = (/ 0_xi, 3_xi, 6_xi, 9_xi, 12_xi, 1_xi, 4_xi, 7_xi, &
357 & 10_xi, 13_xi, 14_xi, 11_xi, 8_xi, 5_xi, 2_xi, 1_xi /)
358 INTEGER(xt_int_kind),
PARAMETER :: undef_idx = -huge(indices(1))
359 INTEGER,
PARAMETER :: pos(9) &
360 = (/ 100, 102, 107, 109, 1011, 1011, 109, 107, 105 /)
361 CALL test_get_indices_at_positions(indices, undef_idx, pos)
362 END SUBROUTINE test_get_indices_at_positions3
364 SUBROUTINE test_get_positions_of_indices
365 INTEGER(xt_int_kind),
PARAMETER :: indices(2) = (/ 0_xi, 2_xi /), &
366 selection(3) = (/ 1_xi, 2_xi, 3_xi /)
367 INTEGER :: i, position, positions(SIZE(selection))
368 INTEGER,
PARAMETER :: ref_positions(3) = (/ -1, 1, -1 /)
369 TYPE(xt_idxlist) :: idxvec
374 CALL test_abort(
'xt_idxlist_get_position_of_index did not return &
379 CALL test_abort(
'xt_idxlist_get_position_of_index_off did not return &
384 CALL test_abort(
'xt_idxlist_get_position_of_index_off did not return &
389 CALL test_abort(
'xt_idxlist_get_positions_of_indices did not return &
390 &correct number of matches', &
393 DO i = 1,
SIZE(selection)
394 IF (positions(i) /= ref_positions(i)) &
395 CALL test_abort(
'xt_idxlist_get_positions_of_indices returned &
396 &incorrect position', &
400 END SUBROUTINE test_get_positions_of_indices
402 SUBROUTINE test_bounding_box(indices, global_size, global_start_index, &
404 INTEGER(xt_int_kind),
INTENT(in) :: indices(:), global_size(:), &
406 TYPE(xt_bounds),
INTENT(in) :: ref_bounds(:)
408 TYPE(xt_bounds) :: bounds(SIZE(global_size))
410 TYPE(xt_idxlist) :: idxvec
413 ndim =
SIZE(global_size)
414 IF (
SIZE(ref_bounds) /= ndim) &
415 CALL test_abort(
'ERROR: inequal dimensions', filename, __line__)
423 IF (bounds(i)%start /= ref_bounds(i)%start)
THEN
424 WRITE (0,
'(2(a,i0))')
'bounds(', i,
')%start=', bounds(i)%start
425 WRITE (0,
'(2(a,i0))')
'ref_bounds(', i,
')%start=', ref_bounds(i)%start
426 WRITE (msg,
'(a,i0)')
"ERROR: xt_idxlist_get_bounding_box inequal &
428 CALL test_abort(msg, filename, __line__)
430 IF (bounds(i)%size /= ref_bounds(i)%size)
THEN
431 WRITE (0,
'(2(a,i0))')
'bounds(', i,
')%size=', bounds(i)%size
432 WRITE (0,
'(2(a,i0))')
'ref_bounds(', i,
')%size=', ref_bounds(i)%size
433 WRITE (msg,
'(a,i0)')
"ERROR: xt_idxlist_get_bounding_box inequal &
435 CALL test_abort(msg, filename, __line__)
439 END SUBROUTINE test_bounding_box
441 SUBROUTINE test_bounding_box1
442 INTEGER(xt_int_kind),
PARAMETER :: indices(2) = (/ 21_xi, 42_xi /), &
443 global_size(3) = 4_xi, global_start_index = 0_xi
444 TYPE(xt_bounds),
PARAMETER :: ref_bounds(3) = xt_bounds(1_xi, 2_xi)
445 CALL test_bounding_box(indices, global_size, global_start_index, ref_bounds)
446 END SUBROUTINE test_bounding_box1
448 SUBROUTINE test_bounding_box2
449 INTEGER(xt_int_kind),
PARAMETER :: indices(5) &
450 = (/ 45_xi, 35_xi, 32_xi, 48_xi, 33_xi /), &
451 global_size(3) = (/ 5_xi, 4_xi, 3_xi /), global_start_index = 1_xi
452 TYPE(xt_bounds),
PARAMETER :: ref_bounds(3) &
453 = (/ xt_bounds(2, 2), xt_bounds(2, 2), xt_bounds(1, 2) /)
454 CALL test_bounding_box(indices, global_size, global_start_index, ref_bounds)
455 END SUBROUTINE test_bounding_box2
457 SUBROUTINE test_bounding_box3
458 INTEGER(xt_int_kind),
PARAMETER :: indices(1) = (/ -1_xi /), &
459 global_size(3) = 4_xi, global_start_index = 0_xi
460 TYPE(xt_bounds),
PARAMETER :: ref_bounds(3) = xt_bounds(0, 0)
461 CALL test_bounding_box(indices(1:0), global_size, global_start_index, &
463 END SUBROUTINE test_bounding_box3
465 SUBROUTINE setup_idxvec(idxlist, index_vector)
466 TYPE(xt_idxlist),
INTENT(out) :: idxlist
467 INTEGER(xt_int_kind),
INTENT(in) :: index_vector(:)
470 CALL check_idxlist(idxlist, index_vector)
471 END SUBROUTINE setup_idxvec
473 SUBROUTINE compare_stripes(idxlist, ref_stripes)
474 TYPE(xt_idxlist),
INTENT(in) :: idxlist
475 TYPE(xt_stripe),
INTENT(in) :: ref_stripes(:)
477 TYPE(xt_stripe),
ALLOCATABLE :: stripes(:)
481 CALL check_stripes(stripes, ref_stripes)
483 END SUBROUTINE compare_stripes
485 END PROGRAM test_idxvec
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)
int xt_idxlist_get_index_at_position(Xt_idxlist idxlist, int position, Xt_int *index)
int xt_idxlist_get_position_of_index_off(Xt_idxlist idxlist, Xt_int index, int *position, int offset)
int xt_idxlist_get_indices_at_positions(Xt_idxlist idxlist, const int *positions, int num_pos, Xt_int *indices, Xt_int undef_idx)
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_idxvec_from_stripes_new(const struct Xt_stripe *stripes, int num_stripes)
Xt_idxlist xt_idxvec_new(const Xt_int *idxlist, int num_indices)