Yet Another eXchange Tool  0.9.0
test_idxsection_f.f90
1 
12 !
13 ! Keywords:
14 ! Maintainer: Jörg Behrens <behrens@dkrz.de>
15 ! Moritz Hanke <hanke@dkrz.de>
16 ! Thomas Jahns <jahns@dkrz.de>
17 ! URL: https://doc.redmine.dkrz.de/yaxt/html/
18 !
19 ! Redistribution and use in source and binary forms, with or without
20 ! modification, are permitted provided that the following conditions are
21 ! met:
22 !
23 ! Redistributions of source code must retain the above copyright notice,
24 ! this list of conditions and the following disclaimer.
25 !
26 ! Redistributions in binary form must reproduce the above copyright
27 ! notice, this list of conditions and the following disclaimer in the
28 ! documentation and/or other materials provided with the distribution.
29 !
30 ! Neither the name of the DKRZ GmbH nor the names of its contributors
31 ! may be used to endorse or promote products derived from this software
32 ! without specific prior written permission.
33 !
34 ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
35 ! IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
36 ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
37 ! PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
38 ! OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
39 ! EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
40 ! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
41 ! PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
42 ! LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
43 ! NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
44 ! SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
45 !
46 PROGRAM test_idxsection
47  USE mpi
48  USE yaxt, ONLY: xt_initialize, xt_finalize, xt_idxlist, &
49  xt_int_kind, xt_bounds, xt_stripe, &
54  xt_idxsection_new, xt_idxvec_new, OPERATOR(/=), OPERATOR(==)
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
58  IMPLICIT NONE
59  INTEGER, PARAMETER :: xi = xt_int_kind
60  CHARACTER(len=*), PARAMETER :: filename = 'test_idxsection_f.f90'
61 
62  CALL init_mpi
63  CALL xt_initialize(mpi_comm_world)
64 
65  CALL test_1d_section
66  CALL test_2d_section
67  CALL test_3d_section
68  CALL test_4d_section
69  CALL test_2d_simple
70  CALL test_1d_intersection1
71  CALL test_1d_intersection2
72  CALL test_2d_intersection1
73  CALL test_2d_1
74  CALL test_2d_2
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
84  CALL test_bb1
85  CALL test_bb2
86  CALL test_bb3
87 
88  IF (test_err_count() /= 0) &
89  CALL test_abort("non-zero error count!", filename, __line__)
90  CALL xt_finalize
91  CALL finish_mpi
92 
93 CONTAINS
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
103 
104  ! create index section
105  idxsection = xt_idxsection_new(start, global_size, local_size, local_start)
106 
107  ! testing
108  CALL do_tests(idxsection, ref_indices, ref_stripes)
109 
110  ! clean up
111  CALL xt_idxlist_delete(idxsection)
112  END SUBROUTINE test_1d_section
113 
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
125 
126  ! create index section
127  idxsection = xt_idxsection_new(start, global_size, local_size, local_start)
128 
129  ! testing
130  CALL do_tests(idxsection, ref_indices, ref_stripes)
131 
132  ! clean up
133  CALL xt_idxlist_delete(idxsection)
134  END SUBROUTINE test_2d_section
135 
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
149 
150  ! create index section
151  idxsection = xt_idxsection_new(start, global_size, local_size, local_start)
152 
153  ! testing
154  CALL do_tests(idxsection, ref_indices, ref_stripes)
155 
156  ! clean up
157  CALL xt_idxlist_delete(idxsection)
158  END SUBROUTINE test_3d_section
159 
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 /), &
168 #ifdef __xlC__
169  ref_indices(36) = &
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 /)
176 #else
177  ref_indices(36) &
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) /)
180 #endif
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
186 
187  ! create index section
188  idxsection = xt_idxsection_new(start, global_size, local_size, local_start)
189 
190  ! testing
191  CALL do_tests(idxsection, ref_indices, ref_stripes)
192 
193  ! clean up
194  CALL xt_idxlist_delete(idxsection)
195  END SUBROUTINE test_4d_section
196 
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 /), &
204  ref_indices(12) &
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
208 
209  ! create index section
210  idxsection = xt_idxsection_new(start, global_size, local_size, local_start)
211 
212  ! testing
213  CALL check_idxlist(idxsection, ref_indices)
214 
215  CALL xt_idxlist_delete(idxsection)
216  END SUBROUTINE test_2d_simple
217 
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
227  idxsection(1) = xt_idxsection_new(start_a, global_size_a, local_size_a, &
228  local_start_a)
229  idxsection(2) = xt_idxsection_new(start_b, global_size_b, local_size_b, &
230  local_start_b)
231  intersection = xt_idxlist_get_intersection(idxsection(1), idxsection(2))
232  CALL xt_idxlist_delete(idxsection(2))
233  CALL xt_idxlist_delete(idxsection(1))
234  CALL do_tests(intersection, ref_indices, ref_stripes)
235  CALL xt_idxlist_delete(intersection)
236  END SUBROUTINE test_intersection
237 
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
250 
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
262 
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
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
285  idxsection = xt_idxsection_new(start, n, global_size, local_size, &
286  local_start)
287  CALL check_idxlist(idxsection, ref_indices)
288  CALL xt_idxlist_delete(idxsection)
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
298  idxsection = xt_idxsection_new(start, n, global_size, local_size, &
299  local_start)
300  CALL check_idxlist(idxsection, ref_indices)
301  CALL xt_idxlist_delete(idxsection)
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
315  idxsection = xt_idxsection_new(start, n, global_size, local_size, &
316  local_start)
317  num_found = xt_idxlist_get_positions_of_indices(idxsection, selection, &
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__)
327  CALL xt_idxlist_delete(idxsection)
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
343  idxsection = xt_idxsection_new(start, n, global_size, local_size, &
344  local_start)
345  num_found = xt_idxlist_get_positions_of_indices(idxsection, selection, &
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
356  notfound = xt_idxlist_get_position_of_index(idxsection, selection(i), p)
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
363  CALL xt_idxlist_delete(idxsection)
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 
376  idxsection = xt_idxsection_new(start, n, global_size, local_size, &
377  local_start)
378  sel_idxlist = xt_idxvec_new(sel_idx)
379  inter_idxlist = xt_idxlist_get_intersection(idxsection, sel_idxlist)
380  CALL xt_idxlist_delete(sel_idxlist)
381  CALL xt_idxlist_delete(idxsection)
382  CALL check_idxlist(inter_idxlist, ref_inter_idx)
383  CALL xt_idxlist_delete(inter_idxlist)
384  END SUBROUTINE test_other_intersection
385 
386  ! test 2D section with arbitrary size signs
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  ! iterate through all sign combinations of -/+ for local and global
432  ! and for x and y, giving 2^2^2 combinations
433  DO i = 0, 15
434  ! create index section
435 
436  idxsection = xt_idxsection_new(start, n, global_size(:, i/4 + 1), &
437  local_size(:, mod(i, 4) + 1), local_start)
438 
439  ! testing
440  CALL check_idxlist(idxsection, ref_indices(:, i + 1))
441 
442  ! clean up
443  CALL xt_idxlist_delete(idxsection)
444  END DO
445  END SUBROUTINE test_signed_sizes1
446 
447  ! test 2D section with arbitrary size signs
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  ! iterate through all sign combinations of -/+ for local and global
475  INTEGER, PARAMETER :: local_size(n, 4) = reshape( &
476  (/ 2, 3, 2, -3, -2, 3, -2, -3 /), (/ n, 4 /) )
477  ! iterate through all sign combinations of -/+ for local and global
478  ! and for x and y, giving 2^2^2 combinations
479  DO i = 0, 15
480  ! create index section
481 
482  idxsection = xt_idxsection_new(start, n, global_size(:, i/4 + 1), &
483  local_size(:, mod(i, 4) + 1), local_start)
484 
485  ! testing
486  CALL check_idxlist(idxsection, ref_indices(:, i + 1))
487 
488  ! clean up
489  CALL xt_idxlist_delete(idxsection)
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  ! create index section
543  idxsection_a = xt_idxsection_new(start, n, global_size(:, i/4 + 1), &
544  local_size(:, mod(i, 4) + 1), local_start)
545  idxsection_b = xt_idxsection_new(start, n, global_size(:, j/4 + 1), &
546  local_size(:, mod(j, 4) + 1), local_start)
547  ! create reference index vectors
548  idxvec_a = xt_idxvec_new(indices(:, i+1))
549  idxvec_b = xt_idxvec_new(indices(:, j+1))
550 
551  ! testing
552  idxsection_intersection = xt_idxlist_get_intersection(idxsection_a, &
553  idxsection_b)
554  idxsection_intersection_other &
555  = xt_idxlist_get_intersection(idxsection_a, idxvec_b)
556  idxvec_intersection = xt_idxlist_get_intersection(idxvec_a, idxvec_b)
557 
558  CALL check_idxlist(idxsection_intersection, &
559  xt_idxlist_get_indices_const(idxvec_intersection))
560  CALL check_idxlist(idxsection_intersection_other, &
561  xt_idxlist_get_indices_const(idxvec_intersection))
562 
563  ! clean up
564 
565  CALL xt_idxlist_delete(idxsection_a)
566  CALL xt_idxlist_delete(idxsection_b)
567  CALL xt_idxlist_delete(idxvec_a)
568  CALL xt_idxlist_delete(idxvec_b)
569  CALL xt_idxlist_delete(idxsection_intersection)
570  CALL xt_idxlist_delete(idxsection_intersection_other)
571  CALL xt_idxlist_delete(idxvec_intersection)
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  ! create index section
601  idxsection = xt_idxsection_new(start, n, global_size, &
602  local_size, local_start)
603 
604  ! testing
605  CALL check_idxlist(idxsection, ref_indices)
606 
607  ! check get_positions_of_indices
608  if (xt_idxlist_get_positions_of_indices(idxsection, indices, positions, &
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  ! clean up
620  CALL xt_idxlist_delete(idxsection)
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
629  idxsection = xt_idxsection_new(start, SIZE(global_size), global_size, &
630  local_size, local_start)
631  CALL check_idxlist(idxsection, ref_indices)
632  CALL xt_idxlist_delete(idxsection)
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))
671  idxsection = xt_idxsection_new(start, SIZE(global_size), global_size, &
672  local_size, local_start)
673  bounds = xt_idxlist_get_bounding_box(idxsection, global_bb_size, bb_start)
674  IF (any(bounds /= ref_bb)) &
675  CALL test_abort("bounding box mismatch", filename, __line__)
676  CALL xt_idxlist_delete(idxsection)
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) = &
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
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) = &
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
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
725  CALL xt_idxlist_get_index_stripes(idxlist, stripes)
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  ! test packing and unpacking
736  idxlist_copy = idxlist_pack_unpack_copy(idxlist)
737  ! check copy
738  CALL check_idxlist(idxlist_copy, ref_indices)
739 
740  CALL xt_idxlist_delete(idxlist_copy)
741 
742  ! test copying
743  idxlist_copy = xt_idxlist_copy(idxlist)
744 
745  ! check copy
746  CALL check_idxlist(idxlist_copy, ref_indices)
747 
748  ! clean up
749  CALL xt_idxlist_delete(idxlist_copy)
750  END SUBROUTINE do_tests
751 
752 END PROGRAM test_idxsection
753 !
754 ! Local Variables:
755 ! f90-continuation-indent: 5
756 ! coding: utf-8
757 ! indent-tabs-mode: nil
758 ! show-trailing-whitespace: t
759 ! require-trailing-newline: t
760 ! End:
761 !
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
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
const Xt_int * xt_idxlist_get_indices_const(Xt_idxlist idxlist)
Definition: xt_idxlist.c:108
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_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)
Definition: xt_idxvec.c:163