Yet Another eXchange Tool  0.9.0
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://doc.redmine.dkrz.de/yaxt/html/
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 PROGRAM test_idxvec
48  USE mpi
49  USE yaxt, ONLY: xt_initialize, xt_finalize, xt_idxlist, xt_idxvec_new, &
51  xt_int_kind, xt_stripe, xt_idxlist_get_intersection, &
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
60  IMPLICIT NONE
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'
65 
66  CALL init_mpi
67  CALL xt_initialize(mpi_comm_world)
68 
69  CALL test_idxvec_pack_unpack
70  CALL test_copying
71  CALL test_repeated_equal_indices
72  CALL test_positions
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
78  CALL test_stripes1
79  CALL test_stripes2
80  CALL test_stripes3
81  CALL test_stripes4
82  CALL test_stripes5
83  CALL test_stripes6
84  CALL test_stripes7
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
92 
93  IF (test_err_count() /= 0) &
94  CALL test_abort("non-zero error count!", filename, __line__)
95  CALL xt_finalize
96  CALL finish_mpi
97 CONTAINS
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)
102 
103  idxvector_copy = idxlist_pack_unpack_copy(idxvector)
104 
105  CALL check_idxlist(idxvector_copy, index_vector)
106 
107  intersection = xt_idxlist_get_intersection(idxvector, idxvector_copy)
108 
109  CALL check_idxlist(intersection, index_vector)
110 
111  CALL compare_stripes(idxvector, ref_stripes)
112 
113  CALL xt_idxlist_delete(idxvector)
114  CALL xt_idxlist_delete(idxvector_copy)
115  CALL xt_idxlist_delete(intersection)
116 
117  END SUBROUTINE test_idxvec_pack_unpack
118 
119  SUBROUTINE test_copying
120  TYPE(xt_idxlist) :: idxvector, idxvector_copy
121  CALL setup_idxvec(idxvector, index_vector)
122  idxvector_copy = xt_idxlist_copy(idxvector)
123  CALL check_idxlist(idxvector_copy, index_vector)
124  CALL xt_idxlist_delete(idxvector)
125  CALL xt_idxlist_delete(idxvector_copy)
126  END SUBROUTINE test_copying
127 
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)
133  CALL xt_idxlist_delete(idxvector)
134  END SUBROUTINE test_repeated_equal_indices
135 
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
151  INTEGER :: notfound
152  CALL setup_idxvec(idxvector, index_vector)
153  notfound = xt_idxlist_get_positions_of_indices(idxvector, &
154  intersection_vector, intersection_pos, single_match_only)
155  IF (notfound /= 0) &
156  CALL test_abort('expected indices not found!', filename, __line__)
157  CALL check_offsets(intersection_pos, ref_intersection_pos)
158  CALL xt_idxlist_delete(idxvector)
159  END SUBROUTINE test_positions
160 
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(:)
165  ! note: instead of declaring this as the move intuitive idxvector(2),
166  ! two distinct variables are used to remain compatible with NAG 5.2
167  TYPE(xt_idxlist) :: idxvector1, idxvector2, intersection
168  CALL setup_idxvec(idxvector1, index_vector_a)
169  CALL setup_idxvec(idxvector2, index_vector_b)
170  intersection = xt_idxlist_get_intersection(idxvector1, idxvector2)
171  CALL check_idxlist(intersection, ref_intersection_indices)
172  CALL xt_idxlist_delete(intersection)
173  CALL xt_idxlist_delete(idxvector2)
174  CALL xt_idxlist_delete(idxvector1)
175  END SUBROUTINE test_intersection
176 
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
185 
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
194 
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
203 
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
212 
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
221 
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(:)
225 
226  TYPE(xt_idxlist) :: idxvec
227  idxvec = xt_idxvec_from_stripes_new(stripes)
228  CALL check_idxlist(idxvec, ref_indices)
229  CALL xt_idxlist_delete(idxvec)
230  END SUBROUTINE test_idxvec_from_stripes
231 
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
239 
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
249 
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
259 
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
269 
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
279 
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
289 
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
300 
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
307  CHARACTER(80) :: msg
308  num_pos = SIZE(pos)
309  idxvec = xt_idxvec_new(indices, SIZE(indices))
310  ref_undef_count = 0
311  DO i = 1, num_pos
312  IF (xt_idxlist_get_index_at_position(idxvec, pos(i), ref_sel_idx(i))) &
313  THEN
314  ref_sel_idx(i) = undef_idx
315  ref_undef_count = ref_undef_count + 1
316  END IF
317  END DO
318  undef_count = xt_idxlist_get_indices_at_positions(idxvec, pos, sel_idx, &
319  undef_idx)
320  IF (undef_count /= ref_undef_count) THEN
321  CALL test_abort("test_idxvec_f.f90: (undef_count /= ref_undef_count)", &
322  filename, __line__)
323  END IF
324  DO i = 1, num_pos
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__)
329  END IF
330  END DO
331  CALL xt_idxlist_delete(idxvec)
332  END SUBROUTINE test_get_indices_at_positions
333 
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
343 
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
353 
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
363 
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
370 
371  idxvec = xt_idxvec_new(indices, SIZE(indices))
372  IF (.NOT. xt_idxlist_get_position_of_index(idxvec, 1_xt_int_kind, &
373  position)) &
374  CALL test_abort('xt_idxlist_get_position_of_index did not return &
375  &an error', &
376  filename, __line__)
377  IF (.NOT. xt_idxlist_get_position_of_index_off(idxvec, 1_xt_int_kind, &
378  position, 0)) &
379  CALL test_abort('xt_idxlist_get_position_of_index_off did not return &
380  &an error', &
381  filename, __line__)
382  IF (.NOT. xt_idxlist_get_position_of_index_off(idxvec, 0_xt_int_kind, &
383  position, 1)) &
384  CALL test_abort('xt_idxlist_get_position_of_index_off did not return &
385  &an error', &
386  filename, __line__)
387  IF (xt_idxlist_get_positions_of_indices(idxvec, selection, positions, &
388  .false.) /= 2) THEN
389  CALL test_abort('xt_idxlist_get_positions_of_indices did not return &
390  &correct number of matches', &
391  filename, __line__)
392  END IF
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', &
397  filename, __line__)
398  END DO
399  CALL xt_idxlist_delete(idxvec)
400  END SUBROUTINE test_get_positions_of_indices
401 
402  SUBROUTINE test_bounding_box(indices, global_size, global_start_index, &
403  ref_bounds)
404  INTEGER(xt_int_kind), INTENT(in) :: indices(:), global_size(:), &
405  global_start_index
406  TYPE(xt_bounds), INTENT(in) :: ref_bounds(:)
407 
408  TYPE(xt_bounds) :: bounds(SIZE(global_size))
409  INTEGER :: i, ndim
410  TYPE(xt_idxlist) :: idxvec
411  CHARACTER(80) :: msg
412 
413  ndim = SIZE(global_size)
414  IF (SIZE(ref_bounds) /= ndim) &
415  CALL test_abort('ERROR: inequal dimensions', filename, __line__)
416 
417  idxvec = xt_idxvec_new(indices, SIZE(indices))
418 
419  bounds = xt_idxlist_get_bounding_box(idxvec, global_size, &
420  global_start_index)
421 
422  DO i = 1, ndim
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 &
427  &starts at i=", i
428  CALL test_abort(msg, filename, __line__)
429  END IF
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 &
434  &size at i=", i
435  CALL test_abort(msg, filename, __line__)
436  END IF
437  END DO
438  CALL xt_idxlist_delete(idxvec)
439  END SUBROUTINE test_bounding_box
440 
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
447 
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
456 
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, &
462  ref_bounds)
463  END SUBROUTINE test_bounding_box3
464 
465  SUBROUTINE setup_idxvec(idxlist, index_vector)
466  TYPE(xt_idxlist), INTENT(out) :: idxlist
467  INTEGER(xt_int_kind), INTENT(in) :: index_vector(:)
468 
469  idxlist = xt_idxvec_new(index_vector, SIZE(index_vector))
470  CALL check_idxlist(idxlist, index_vector)
471  END SUBROUTINE setup_idxvec
472 
473  SUBROUTINE compare_stripes(idxlist, ref_stripes)
474  TYPE(xt_idxlist), INTENT(in) :: idxlist
475  TYPE(xt_stripe), INTENT(in) :: ref_stripes(:)
476 
477  TYPE(xt_stripe), ALLOCATABLE :: stripes(:)
478 
479  CALL xt_idxlist_get_index_stripes(idxlist, stripes)
480 
481  CALL check_stripes(stripes, ref_stripes)
482 
483  END SUBROUTINE compare_stripes
484 
485 END PROGRAM test_idxvec
486 !
487 ! Local Variables:
488 ! f90-continuation-indent: 5
489 ! coding: utf-8
490 ! indent-tabs-mode: nil
491 ! show-trailing-whitespace: t
492 ! require-trailing-newline: t
493 ! End:
494 !
Definition: yaxt.f90:49
void xt_initialize(MPI_Comm default_comm)
Definition: xt_init.c:70
void xt_finalize(void)
Definition: xt_init.c:89
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:203
int xt_idxlist_get_index_at_position(Xt_idxlist idxlist, int position, Xt_int *index)
Definition: xt_idxlist.c:158
int xt_idxlist_get_position_of_index_off(Xt_idxlist idxlist, Xt_int index, int *position, int offset)
Definition: xt_idxlist.c:264
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:165
void xt_idxlist_get_index_stripes(Xt_idxlist idxlist, struct Xt_stripe **stripes, int *num_stripes)
Definition: xt_idxlist.c:118
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:332
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:93
int xt_idxlist_get_position_of_index(Xt_idxlist idxlist, Xt_int index, int *position)
Definition: xt_idxlist.c:196
void xt_idxlist_delete(Xt_idxlist idxlist)
Definition: xt_idxlist.c:74
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:163