Yet Another eXchange Tool 0.11.4
Loading...
Searching...
No Matches
test_idxvec_f.f90
1
12
13!
14! Keywords:
15! Maintainer: Jörg Behrens <behrens@dkrz.de>
16! Moritz Hanke <hanke@dkrz.de>
17! Thomas Jahns <jahns@dkrz.de>
18! URL: https://dkrz-sw.gitlab-pages.dkrz.de/yaxt/
19!
20! Redistribution and use in source and binary forms, with or without
21! modification, are permitted provided that the following conditions are
22! met:
23!
24! Redistributions of source code must retain the above copyright notice,
25! this list of conditions and the following disclaimer.
26!
27! Redistributions in binary form must reproduce the above copyright
28! notice, this list of conditions and the following disclaimer in the
29! documentation and/or other materials provided with the distribution.
30!
31! Neither the name of the DKRZ GmbH nor the names of its contributors
32! may be used to endorse or promote products derived from this software
33! without specific prior written permission.
34!
35! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
36! IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
37! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
38! PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
39! OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
40! EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
41! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
42! PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
43! LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
44! NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
45! SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
46!
47#include "fc_feature_defs.inc"
48PROGRAM test_idxvec
49 USE mpi
58 USE ftest_common, ONLY: init_mpi, finish_mpi, test_abort
59 USE test_idxlist_utils, ONLY: check_idxlist, test_err_count, check_stripes, &
60 check_offsets, idxlist_pack_unpack_copy
61 IMPLICIT NONE
62 INTEGER, PARAMETER :: xi = xt_int_kind
63 INTEGER(xt_int_kind), PARAMETER :: index_vector(7) &
64 = (/ 1_xi, 2_xi, 3_xi, 4_xi, 5_xi, 6_xi, 7_xi /)
65 CHARACTER(len=*), PARAMETER :: filename = 'test_idxvec_f.f90'
66
67 CALL init_mpi
68 CALL xt_initialize(mpi_comm_world)
69
70 CALL test_idxvec_pack_unpack
71 CALL test_copying
72 CALL test_repeated_equal_indices
73 CALL test_positions
74 CALL test_intersection_surjective
75 CALL test_intersection_partial
76 CALL test_intersection_inverse_partial
77 CALL test_intersection_unsort_partial
78 CALL test_intersection_unsort_inverse_partial
79 CALL test_stripes1
80 CALL test_stripes2
81 CALL test_stripes3
82 CALL test_stripes4
83 CALL test_stripes5
84 CALL test_stripes6
85 CALL test_stripes7
86 CALL test_get_indices_at_positions1
87 CALL test_get_indices_at_positions2
88 CALL test_get_indices_at_positions3
89 CALL test_get_positions_of_indices
90 CALL test_bounding_box1
91 CALL test_bounding_box2
92 CALL test_bounding_box3
93
94 IF (test_err_count() /= 0) &
95 CALL test_abort("non-zero error count!", filename, __line__)
96 CALL xt_finalize
97 CALL finish_mpi
98CONTAINS
99 SUBROUTINE test_idxvec_pack_unpack
100 TYPE(xt_idxlist) :: idxvector, idxvector_copy, intersection
101 TYPE(xt_stripe), PARAMETER :: ref_stripes(1) = (/ xt_stripe(1, 1, 7) /)
102 CALL setup_idxvec(idxvector, index_vector)
103
104 idxvector_copy = idxlist_pack_unpack_copy(idxvector)
105
106 CALL check_idxlist(idxvector_copy, index_vector)
107
108 intersection = xt_idxlist_get_intersection(idxvector, idxvector_copy)
109
110 CALL check_idxlist(intersection, index_vector)
111
112 CALL compare_stripes(idxvector, ref_stripes)
113
114 CALL xt_idxlist_delete(idxvector)
115 CALL xt_idxlist_delete(idxvector_copy)
116 CALL xt_idxlist_delete(intersection)
117
118 END SUBROUTINE test_idxvec_pack_unpack
119
120 SUBROUTINE test_copying
121 TYPE(xt_idxlist) :: idxvector, idxvector_copy
122 CALL setup_idxvec(idxvector, index_vector)
123 idxvector_copy = xt_idxlist_copy(idxvector)
124 CALL check_idxlist(idxvector_copy, index_vector)
125 CALL xt_idxlist_delete(idxvector)
126 CALL xt_idxlist_delete(idxvector_copy)
127 END SUBROUTINE test_copying
128
129 SUBROUTINE test_repeated_equal_indices
130 INTEGER(xt_int_kind), PARAMETER :: index_vector(8) &
131 = (/ 1_xi, 2_xi, 3_xi, 7_xi, 5_xi, 6_xi, 7_xi, 7_xi /)
132 TYPE(xt_idxlist) :: idxvector
133 CALL setup_idxvec(idxvector, index_vector)
134 CALL xt_idxlist_delete(idxvector)
135 END SUBROUTINE test_repeated_equal_indices
136
137 SUBROUTINE test_positions
138 LOGICAL, PARAMETER :: single_match_only = .true.
139 INTEGER(xt_int_kind), PARAMETER :: index_vector(20) &
140 = (/ 10_xi, 15_xi, 14_xi, 13_xi, 12_xi, &
141 & 15_xi, 10_xi, 11_xi, 12_xi, 13_xi, &
142 & 23_xi, 18_xi, 19_xi, 20_xi, 21_xi, &
143 & 31_xi, 26_xi, 27_xi, 28_xi, 29_xi /), &
144 intersection_vector(13) &
145 = (/ 12_xi, 12_xi, 13_xi, 13_xi, 14_xi, &
146 & 15_xi, 15_xi, 20_xi, 21_xi, 23_xi, &
147 & 28_xi, 29_xi, 31_xi /)
148 INTEGER :: intersection_pos(SIZE(intersection_vector))
149 INTEGER, PARAMETER :: ref_intersection_pos(SIZE(intersection_vector)) &
150 = (/ 4, 8, 3, 9, 2, 1, 5, 13, 14, 10, 18, 19, 15 /)
151 TYPE(xt_idxlist) :: idxvector
152 INTEGER :: notfound
153 CALL setup_idxvec(idxvector, index_vector)
154 notfound = xt_idxlist_get_positions_of_indices(idxvector, &
155 intersection_vector, intersection_pos, single_match_only)
156 IF (notfound /= 0) &
157 CALL test_abort('expected indices not found!', filename, __line__)
158 CALL check_offsets(intersection_pos, ref_intersection_pos)
159 CALL xt_idxlist_delete(idxvector)
160 END SUBROUTINE test_positions
161
162 SUBROUTINE test_intersection(index_vector_a, index_vector_b, &
163 ref_intersection_indices)
164 INTEGER(xt_int_kind), INTENT(in) :: index_vector_a(:), index_vector_b(:), &
165 ref_intersection_indices(:)
166 ! note: instead of declaring this as the move intuitive idxvector(2),
167 ! two distinct variables are used to remain compatible with NAG 5.2
168 TYPE(xt_idxlist) :: idxvector1, idxvector2, intersection
169 CALL setup_idxvec(idxvector1, index_vector_a)
170 CALL setup_idxvec(idxvector2, index_vector_b)
171 intersection = xt_idxlist_get_intersection(idxvector1, idxvector2)
172 CALL check_idxlist(intersection, ref_intersection_indices)
173 CALL xt_idxlist_delete(intersection)
174 CALL xt_idxlist_delete(idxvector2)
175 CALL xt_idxlist_delete(idxvector1)
176 END SUBROUTINE test_intersection
177
178 SUBROUTINE test_intersection_surjective
179 INTEGER(xt_int_kind), PARAMETER :: index_vector(3, 2) &
180 = reshape((/ 1_xi, 2_xi, 3_xi, 1_xi, 2_xi, 3_xi /), &
181 & shape(index_vector)), &
182 ref_intersection_indices(3) = (/ 1_xi, 2_xi, 3_xi /)
183 CALL test_intersection(index_vector(:, 1), index_vector(:, 2), &
184 ref_intersection_indices)
185 END SUBROUTINE test_intersection_surjective
186
187 SUBROUTINE test_intersection_partial
188 INTEGER(xt_int_kind), PARAMETER :: index_vector(3, 2) &
189 = reshape((/ 1_xi, 2_xi, 3_xi, 2_xi, 3_xi, 4_xi /), &
190 & shape(index_vector)), &
191 ref_intersection_indices(2) = (/ 2_xi, 3_xi /)
192 CALL test_intersection(index_vector(:, 1), index_vector(:, 2), &
193 ref_intersection_indices)
194 END SUBROUTINE test_intersection_partial
195
196 SUBROUTINE test_intersection_inverse_partial
197 INTEGER(xt_int_kind), PARAMETER :: index_vector(3, 2) &
198 = reshape((/ 2_xi, 3_xi, 4_xi, 1_xi, 2_xi, 3_xi /), &
199 & shape(index_vector)), &
200 ref_intersection_indices(2) = (/ 2_xi, 3_xi /)
201 CALL test_intersection(index_vector(:, 1), index_vector(:, 2), &
202 ref_intersection_indices)
203 END SUBROUTINE test_intersection_inverse_partial
204
205 SUBROUTINE test_intersection_unsort_partial
206 INTEGER(xt_int_kind), PARAMETER :: index_vector(3, 2) &
207 = reshape((/ 4_xi, 2_xi, 3_xi, 3_xi, 1_xi, 2_xi /), &
208 & shape(index_vector)), &
209 ref_intersection_indices(2) = (/ 2_xi, 3_xi /)
210 CALL test_intersection(index_vector(:, 1), index_vector(:, 2), &
211 ref_intersection_indices)
212 END SUBROUTINE test_intersection_unsort_partial
213
214 SUBROUTINE test_intersection_unsort_inverse_partial
215 INTEGER(xt_int_kind), PARAMETER :: index_vector(3, 2) &
216 = reshape((/ 3_xi, 1_xi, 2_xi, 4_xi, 2_xi, 3_xi /), &
217 & shape(index_vector)), &
218 ref_intersection_indices(2) = (/ 2_xi, 3_xi /)
219 CALL test_intersection(index_vector(:, 1), index_vector(:, 2), &
220 ref_intersection_indices)
221 END SUBROUTINE test_intersection_unsort_inverse_partial
222
223 SUBROUTINE test_idxvec_from_stripes(stripes, ref_indices)
224 TYPE(xt_stripe), INTENT(in) :: stripes(:)
225 INTEGER(xt_int_kind), INTENT(in) :: ref_indices(:)
226
227 TYPE(xt_idxlist) :: idxvec
228 idxvec = xt_idxvec_from_stripes_new(stripes)
229 CALL check_idxlist(idxvec, ref_indices)
230 CALL xt_idxlist_delete(idxvec)
231 END SUBROUTINE test_idxvec_from_stripes
232
233 SUBROUTINE test_stripes1
234 TYPE(xt_stripe), PARAMETER :: stripes(2) = &
235 (/ xt_stripe(5, 1, 5), xt_stripe(4, -1, 5) /)
236 INTEGER(xt_int_kind), PARAMETER :: ref_indices(10) &
237 = (/ 5_xi, 6_xi, 7_xi, 8_xi, 9_xi, 4_xi, 3_xi, 2_xi, 1_xi, 0_xi /)
238 CALL test_idxvec_from_stripes(stripes, ref_indices)
239 END SUBROUTINE test_stripes1
240
241 SUBROUTINE test_stripes2
242 TYPE(xt_stripe), PARAMETER :: stripes(3) &
243 = (/ xt_stripe(0, 1, 5), xt_stripe(2, 1, 5), xt_stripe(4, 1, 5) /)
244 INTEGER(xt_int_kind), PARAMETER :: ref_indices(15) &
245 = (/ 0_xi, 1_xi, 2_xi, 3_xi, 4_xi, &
246 & 2_xi, 3_xi, 4_xi, 5_xi, 6_xi, &
247 & 4_xi, 5_xi, 6_xi, 7_xi, 8_xi /)
248 CALL test_idxvec_from_stripes(stripes, ref_indices)
249 END SUBROUTINE test_stripes2
250
251 SUBROUTINE test_stripes3
252 TYPE(xt_stripe), PARAMETER :: stripes(3) &
253 = (/ xt_stripe(2, 1, 5), xt_stripe(0, 1, 5), xt_stripe(4, 1, 5) /)
254 INTEGER(xt_int_kind), PARAMETER :: ref_indices(15) &
255 = (/ 2_xi, 3_xi, 4_xi, 5_xi, 6_xi, &
256 & 0_xi, 1_xi, 2_xi, 3_xi, 4_xi, &
257 & 4_xi, 5_xi, 6_xi, 7_xi, 8_xi /)
258 CALL test_idxvec_from_stripes(stripes, ref_indices)
259 END SUBROUTINE test_stripes3
260
261 SUBROUTINE test_stripes4
262 TYPE(xt_stripe), PARAMETER :: stripes(3) &
263 = (/ xt_stripe(2, 1, 5), xt_stripe(4, -1, 5), xt_stripe(4, 1, 5) /)
264 INTEGER(xt_int_kind), PARAMETER :: ref_indices(15) &
265 = (/ 2_xi, 3_xi, 4_xi, 5_xi, 6_xi, &
266 & 4_xi, 3_xi, 2_xi, 1_xi, 0_xi, &
267 & 4_xi, 5_xi, 6_xi, 7_xi, 8_xi /)
268 CALL test_idxvec_from_stripes(stripes, ref_indices)
269 END SUBROUTINE test_stripes4
270
271 SUBROUTINE test_stripes5
272 TYPE(xt_stripe), PARAMETER :: stripes(3) &
273 = (/ xt_stripe(0, 3, 5), xt_stripe(1, 3, 5), xt_stripe(14, -3, 5) /)
274 INTEGER(xt_int_kind), PARAMETER :: ref_indices(15) &
275 = (/ 0_xi, 3_xi, 6_xi, 9_xi, 12_xi, &
276 & 1_xi, 4_xi, 7_xi, 10_xi, 13_xi, &
277 & 14_xi, 11_xi, 8_xi, 5_xi, 2_xi /)
278 CALL test_idxvec_from_stripes(stripes, ref_indices)
279 END SUBROUTINE test_stripes5
280
281 SUBROUTINE test_stripes6
282 TYPE(xt_stripe), PARAMETER :: stripes(3) &
283 = (/ xt_stripe(0, 3, 5), xt_stripe(2, 3, 5), xt_stripe(14, -3, 5) /)
284 INTEGER(xt_int_kind), PARAMETER :: ref_indices(15) &
285 = (/ 0_xi, 3_xi, 6_xi, 9_xi, 12_xi, &
286 & 2_xi, 5_xi, 8_xi, 11_xi, 14_xi, &
287 & 14_xi, 11_xi, 8_xi, 5_xi, 2_xi /)
288 CALL test_idxvec_from_stripes(stripes, ref_indices)
289 END SUBROUTINE test_stripes6
290
291 SUBROUTINE test_stripes7
292 TYPE(xt_stripe), PARAMETER :: stripes(4) = (/ xt_stripe(0, -1, 5), &
293 xt_stripe(1, 1, 5), xt_stripe(-5, -1, 5), xt_stripe(6, 1, 5) /)
294 INTEGER(xt_int_kind), PARAMETER :: ref_indices(20) &
295 = (/ 0_xi, -1_xi, -2_xi, -3_xi, -4_xi, &
296 & 1_xi, 2_xi, 3_xi, 4_xi, 5_xi, &
297 & -5_xi, -6_xi, -7_xi, -8_xi, -9_xi, &
298 & 6_xi, 7_xi, 8_xi, 9_xi, 10_xi /)
299 CALL test_idxvec_from_stripes(stripes, ref_indices)
300 END SUBROUTINE test_stripes7
301
302 SUBROUTINE test_get_indices_at_positions(indices, undef_idx, pos)
303 INTEGER(xt_int_kind), INTENT(in) :: indices(:), undef_idx
304 INTEGER, INTENT(in) :: pos(:)
305 INTEGER(xt_int_kind) :: ref_sel_idx(SIZE(pos)), sel_idx(SIZE(pos))
306 INTEGER :: i, num_pos, undef_count, ref_undef_count
307 TYPE(xt_idxlist) :: idxvec
308 CHARACTER(80) :: msg
309 num_pos = SIZE(pos)
310 idxvec = xt_idxvec_new(indices, SIZE(indices))
311 ref_undef_count = 0
312 DO i = 1, num_pos
313 IF (xt_idxlist_get_index_at_position(idxvec, pos(i), ref_sel_idx(i))) &
314 THEN
315 ref_sel_idx(i) = undef_idx
316 ref_undef_count = ref_undef_count + 1
317 END IF
318 END DO
319 undef_count = xt_idxlist_get_indices_at_positions(idxvec, pos, sel_idx, &
320 undef_idx)
321 IF (undef_count /= ref_undef_count) THEN
322 CALL test_abort("test_idxvec_f.f90: (undef_count /= ref_undef_count)", &
323 filename, __line__)
324 END IF
325 DO i = 1, num_pos
326 IF (sel_idx(i) /= ref_sel_idx(i)) THEN
327 WRITE (msg, '(2(a,i0),a)') "test_idxvec_f.f90: (sel_idx(", i, &
328 ") /= ref_sel_idx(", i, "))"
329 CALL test_abort(msg, filename, __line__)
330 END IF
331 END DO
332 CALL xt_idxlist_delete(idxvec)
333 END SUBROUTINE test_get_indices_at_positions
334
335 SUBROUTINE test_get_indices_at_positions1
336 INTEGER(xt_int_kind), PARAMETER :: indices(16) &
337 = (/ 0_xi, 3_xi, 6_xi, 9_xi, 12_xi, 1_xi, 4_xi, 7_xi, &
338 & 10_xi, 13_xi, 14_xi, 11_xi, 8_xi, 5_xi, 2_xi, 1_xi /)
339 INTEGER(xt_int_kind), PARAMETER :: undef_idx = -huge(undef_idx)
340 INTEGER, PARAMETER :: pos(13) &
341 = (/ 0, 2, 7, 9, 11, 100, 11, 200, 9, 300, 7, 400, 5 /)
342 CALL test_get_indices_at_positions(indices, undef_idx, pos)
343 END SUBROUTINE test_get_indices_at_positions1
344
345 SUBROUTINE test_get_indices_at_positions2
346 INTEGER(xt_int_kind), PARAMETER :: indices(16) &
347 = (/ 0_xi, 3_xi, 6_xi, 9_xi, 12_xi, 1_xi, 4_xi, 7_xi, &
348 & 10_xi, 13_xi, 14_xi, 11_xi, 8_xi, 5_xi, 2_xi, 1_xi /)
349 INTEGER(xt_int_kind), PARAMETER :: undef_idx = -huge(undef_idx)
350 INTEGER, PARAMETER :: pos(9) &
351 = (/ 0, 2, 7, 9, 11, 11, 9, 7, 5 /)
352 CALL test_get_indices_at_positions(indices, undef_idx, pos)
353 END SUBROUTINE test_get_indices_at_positions2
354
355 SUBROUTINE test_get_indices_at_positions3
356 INTEGER(xt_int_kind), PARAMETER :: indices(16) &
357 = (/ 0_xi, 3_xi, 6_xi, 9_xi, 12_xi, 1_xi, 4_xi, 7_xi, &
358 & 10_xi, 13_xi, 14_xi, 11_xi, 8_xi, 5_xi, 2_xi, 1_xi /)
359 INTEGER(xt_int_kind), PARAMETER :: undef_idx = -huge(indices(1))
360 INTEGER, PARAMETER :: pos(9) &
361 = (/ 100, 102, 107, 109, 1011, 1011, 109, 107, 105 /)
362 CALL test_get_indices_at_positions(indices, undef_idx, pos)
363 END SUBROUTINE test_get_indices_at_positions3
364
365 SUBROUTINE test_get_positions_of_indices
366 INTEGER(xt_int_kind), PARAMETER :: indices(2) = (/ 0_xi, 2_xi /), &
367 selection(3) = (/ 1_xi, 2_xi, 3_xi /)
368 INTEGER :: i, position, positions(SIZE(selection))
369 INTEGER, PARAMETER :: ref_positions(3) = (/ -1, 1, -1 /)
370 TYPE(xt_idxlist) :: idxvec
371
372 idxvec = xt_idxvec_new(indices, SIZE(indices))
373 IF (.NOT. xt_idxlist_get_position_of_index(idxvec, 1_xt_int_kind, &
374 position)) &
375 CALL test_abort('xt_idxlist_get_position_of_index did not return &
376 &an error', &
377 filename, __line__)
378 IF (.NOT. xt_idxlist_get_position_of_index_off(idxvec, 1_xt_int_kind, &
379 position, 0)) &
380 CALL test_abort('xt_idxlist_get_position_of_index_off did not return &
381 &an error', &
382 filename, __line__)
383 IF (.NOT. xt_idxlist_get_position_of_index_off(idxvec, 0_xt_int_kind, &
384 position, 1)) &
385 CALL test_abort('xt_idxlist_get_position_of_index_off did not return &
386 &an error', &
387 filename, __line__)
388 IF (xt_idxlist_get_positions_of_indices(idxvec, selection, positions, &
389 .false.) /= 2) THEN
390 CALL test_abort('xt_idxlist_get_positions_of_indices did not return &
391 &correct number of matches', &
392 filename, __line__)
393 END IF
394 DO i = 1, SIZE(selection)
395 IF (positions(i) /= ref_positions(i)) &
396 CALL test_abort('xt_idxlist_get_positions_of_indices returned &
397 &incorrect position', &
398 filename, __line__)
399 END DO
400 CALL xt_idxlist_delete(idxvec)
401 END SUBROUTINE test_get_positions_of_indices
402
403 SUBROUTINE test_bounding_box(indices, global_size, global_start_index, &
404 ref_bounds)
405 INTEGER(xt_int_kind), INTENT(in) :: indices(:), global_size(:), &
406 global_start_index
407 TYPE(xt_bounds), INTENT(in) :: ref_bounds(:)
408
409 TYPE(xt_bounds) :: bounds(SIZE(global_size))
410 INTEGER :: i, ndim
411 TYPE(xt_idxlist) :: idxvec
412 CHARACTER(80) :: msg
413
414 ndim = SIZE(global_size)
415 IF (SIZE(ref_bounds) /= ndim) &
416 CALL test_abort('ERROR: inequal dimensions', filename, __line__)
417
418 idxvec = xt_idxvec_new(indices, SIZE(indices))
419
420 bounds = xt_idxlist_get_bounding_box(idxvec, global_size, &
421 global_start_index)
422
423 DO i = 1, ndim
424 IF (bounds(i)%start /= ref_bounds(i)%start) THEN
425 WRITE (0, '(2(a,i0))') 'bounds(', i, ')%start=', bounds(i)%start
426 WRITE (0, '(2(a,i0))') 'ref_bounds(', i, ')%start=', ref_bounds(i)%start
427 WRITE (msg, '(a,i0)') "ERROR: xt_idxlist_get_bounding_box inequal &
428 &starts at i=", i
429 CALL test_abort(msg, filename, __line__)
430 END IF
431 IF (bounds(i)%size /= ref_bounds(i)%size) THEN
432 WRITE (0, '(2(a,i0))') 'bounds(', i, ')%size=', bounds(i)%size
433 WRITE (0, '(2(a,i0))') 'ref_bounds(', i, ')%size=', ref_bounds(i)%size
434 WRITE (msg, '(a,i0)') "ERROR: xt_idxlist_get_bounding_box inequal &
435 &size at i=", i
436 CALL test_abort(msg, filename, __line__)
437 END IF
438 END DO
439 CALL xt_idxlist_delete(idxvec)
440 END SUBROUTINE test_bounding_box
441
442 SUBROUTINE test_bounding_box1
443 INTEGER(xt_int_kind), PARAMETER :: indices(2) = (/ 21_xi, 42_xi /), &
444 global_size(3) = 4_xi, global_start_index = 0_xi
445 TYPE(xt_bounds), PARAMETER :: ref_bounds(3) = xt_bounds(1_xi, 2_xi)
446 CALL test_bounding_box(indices, global_size, global_start_index, ref_bounds)
447 END SUBROUTINE test_bounding_box1
448
449 SUBROUTINE test_bounding_box2
450 INTEGER(xt_int_kind), PARAMETER :: indices(5) &
451 = (/ 45_xi, 35_xi, 32_xi, 48_xi, 33_xi /), &
452 global_size(3) = (/ 5_xi, 4_xi, 3_xi /), global_start_index = 1_xi
453 TYPE(xt_bounds), PARAMETER :: ref_bounds(3) &
454 = (/ xt_bounds(2, 2), xt_bounds(2, 2), xt_bounds(1, 2) /)
455 CALL test_bounding_box(indices, global_size, global_start_index, ref_bounds)
456 END SUBROUTINE test_bounding_box2
457
458 SUBROUTINE test_bounding_box3
459 INTEGER(xt_int_kind), PARAMETER :: indices(1) = (/ -1_xi /), &
460 global_size(3) = 4_xi, global_start_index = 0_xi
461 TYPE(xt_bounds), PARAMETER :: ref_bounds(3) = xt_bounds(0, 0)
462 CALL test_bounding_box(indices(1:0), global_size, global_start_index, &
463 ref_bounds)
464 END SUBROUTINE test_bounding_box3
465
466 SUBROUTINE setup_idxvec(idxlist, index_vector)
467 TYPE(xt_idxlist), INTENT(out) :: idxlist
468 INTEGER(xt_int_kind), INTENT(in) :: index_vector(:)
469
470 idxlist = xt_idxvec_new(index_vector, SIZE(index_vector))
471 CALL check_idxlist(idxlist, index_vector)
472 END SUBROUTINE setup_idxvec
473
474 SUBROUTINE compare_stripes(idxlist, ref_stripes)
475 TYPE(xt_idxlist), INTENT(in) :: idxlist
476 TYPE(xt_stripe), INTENT(in) :: ref_stripes(:)
477
478 TYPE(xt_stripe), ALLOCATABLE :: stripes(:)
479
480 CALL xt_idxlist_get_index_stripes(idxlist, stripes)
481
482 CALL check_stripes(stripes, ref_stripes)
483
484 END SUBROUTINE compare_stripes
485
486END PROGRAM test_idxvec
487!
488! Local Variables:
489! f90-continuation-indent: 5
490! coding: utf-8
491! indent-tabs-mode: nil
492! show-trailing-whitespace: t
493! require-trailing-newline: t
494! End:
495!
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
int xt_idxlist_get_index_at_position(Xt_idxlist idxlist, int position, Xt_int *index)
Definition xt_idxlist.c:176
int xt_idxlist_get_position_of_index_off(Xt_idxlist idxlist, Xt_int index, int *position, int offset)
Definition xt_idxlist.c:306
int xt_idxlist_get_indices_at_positions(Xt_idxlist idxlist, const int *positions, int num_pos, Xt_int *indices, Xt_int undef_idx)
Definition xt_idxlist.c:183
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_idxvec_from_stripes_new(const struct Xt_stripe *stripes, int num_stripes)
Xt_idxlist xt_idxvec_new(const Xt_int *idxlist, int num_indices)
Definition xt_idxvec.c:213