Yet Another eXchange Tool  DO_NOT_EDIT_HERE
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, &
50  xt_idxlist_copy, xt_idxlist_get_index_stripes, xt_idxlist_delete, &
51  xt_idxlist_get_intersection, xt_idxlist_get_positions_of_indices, &
52  xt_idxlist_get_position_of_index, xt_idxlist_get_indices_const, &
53  xt_idxlist_get_bounding_box, &
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 
61  CALL init_mpi
62  CALL xt_initialize(mpi_comm_world)
63 
64  CALL test_1d_section
65  CALL test_2d_section
66  CALL test_3d_section
67  CALL test_4d_section
68  CALL test_2d_simple
69  CALL test_1d_intersection1
70  CALL test_1d_intersection2
71  CALL test_2d_intersection1
72  CALL test_2d_1
73  CALL test_2d_2
74  CALL test_get_positions1
75  CALL test_get_positions2
76  CALL test_other_intersection
77  CALL test_signed_sizes1
78  CALL test_signed_sizes2
79  CALL test_signed_size_positions
80  CALL test_section_with_stride1
81  CALL test_section_with_stride2
82  CALL test_bb1
83  CALL test_bb2
84 
85  IF (test_err_count() /= 0) &
86  CALL test_abort("non-zero error count!", &
87  __file__, &
88  __line__)
89  CALL xt_finalize
90  CALL finish_mpi
91 
92 CONTAINS
93  SUBROUTINE test_1d_section
94  INTEGER(xt_int_kind), PARAMETER :: start = 0_xi
95  INTEGER, PARAMETER :: num_dimensions = 1
96  INTEGER(xt_int_kind), PARAMETER :: global_size(num_dimensions) = 10_xi, &
97  local_start(num_dimensions) = 3_xi, &
98  ref_indices(5) = (/ 3_xi, 4_xi, 5_xi, 6_xi, 7_xi /)
99  INTEGER, PARAMETER :: local_size(num_dimensions) = 5
100  TYPE(xt_stripe), PARAMETER :: ref_stripes(1) = xt_stripe(3, 1, 5)
101  TYPE(xt_idxlist) :: idxsection
102 
103  ! create index section
104  idxsection = xt_idxsection_new(start, global_size, local_size, local_start)
105 
106  ! testing
107  CALL do_tests(idxsection, ref_indices, ref_stripes)
108 
109  ! clean up
110  CALL xt_idxlist_delete(idxsection)
111  END SUBROUTINE test_1d_section
112 
113  SUBROUTINE test_2d_section
114  INTEGER(xt_int_kind), PARAMETER :: start = 0_xi
115  INTEGER, PARAMETER :: num_dimensions = 2
116  INTEGER(xt_int_kind), PARAMETER :: global_size(num_dimensions) &
117  = (/ 5_xi, 6_xi /), &
118  local_start(num_dimensions) = (/ 1_xi, 2_xi /), &
119  ref_indices(6) = (/ 8_xi, 9_xi, 14_xi, 15_xi, 20_xi, 21_xi /)
120  INTEGER, PARAMETER :: local_size(num_dimensions) = (/ 3, 2 /)
121  TYPE(xt_stripe), PARAMETER :: ref_stripes(3) = (/ xt_stripe(8, 1, 2), &
122  xt_stripe(14, 1, 2), xt_stripe(20, 1, 2) /)
123  TYPE(xt_idxlist) :: idxsection
124 
125  ! create index section
126  idxsection = xt_idxsection_new(start, global_size, local_size, local_start)
127 
128  ! testing
129  CALL do_tests(idxsection, ref_indices, ref_stripes)
130 
131  ! clean up
132  CALL xt_idxlist_delete(idxsection)
133  END SUBROUTINE test_2d_section
134 
135  SUBROUTINE test_3d_section
136  INTEGER(xt_int_kind), PARAMETER :: start = 0_xi
137  INTEGER, PARAMETER :: num_dimensions = 3
138  INTEGER(xt_int_kind), PARAMETER :: global_size(num_dimensions) = 4_xi, &
139  local_start(num_dimensions) = (/ 0_xi, 1_xi, 1_xi /), &
140  ref_indices(16) = (/ 5_xi, 6_xi, 9_xi, 10_xi, 21_xi, 22_xi, 25_xi, &
141  26_xi, 37_xi, 38_xi, 41_xi, 42_xi, 53_xi, 54_xi, 57_xi, 58_xi /)
142  INTEGER, PARAMETER :: local_size(num_dimensions) = (/ 4, 2, 2 /)
143  TYPE(xt_stripe), PARAMETER :: ref_stripes(8) = (/ xt_stripe(5, 1, 2), &
144  xt_stripe(9, 1, 2), xt_stripe(21, 1, 2), xt_stripe(25, 1, 2), &
145  xt_stripe(37, 1, 2), xt_stripe(41, 1, 2), xt_stripe(53, 1, 2), &
146  xt_stripe(57, 1, 2) /)
147  TYPE(xt_idxlist) :: idxsection
148 
149  ! create index section
150  idxsection = xt_idxsection_new(start, global_size, local_size, local_start)
151 
152  ! testing
153  CALL do_tests(idxsection, ref_indices, ref_stripes)
154 
155  ! clean up
156  CALL xt_idxlist_delete(idxsection)
157  END SUBROUTINE test_3d_section
158 
159  SUBROUTINE test_4d_section
160  INTEGER(xt_int_kind), PARAMETER :: start = 0_xi
161  INTEGER, PARAMETER :: num_dimensions = 4
162  INTEGER(xt_int_kind) :: i, j, k, l
163  INTEGER(xt_int_kind), PARAMETER :: global_size(num_dimensions) &
164  = (/ 3_xi, 4_xi, 4_xi, 3_xi /), &
165  local_start(num_dimensions) &
166  = (/ 0_xi, 1_xi, 1_xi, 1_xi /), &
167 #ifdef __xlC__
168  ref_indices(36) = &
169  (/ 16_xi,17_xi,19_xi,20_xi,22_xi,23_xi, &
170  28_xi,29_xi,31_xi,32_xi,34_xi,35_xi, &
171  40_xi,41_xi,43_xi,44_xi,46_xi,47_xi, &
172  64_xi,65_xi,67_xi,68_xi,70_xi,71_xi, &
173  76_xi,77_xi,79_xi,80_xi,82_xi,83_xi, &
174  88_xi,89_xi,91_xi,92_xi,94_xi,95_xi /)
175 #else
176  ref_indices(36) &
177  = (/ ((((16_xi + i + j*3_xi + k*12_xi + l*48_xi, &
178  & i=0_xi,1_xi), j=0_xi,2_xi), k=0_xi,2_xi), l=0_xi,1_xi) /)
179 #endif
180  INTEGER, PARAMETER :: local_size(num_dimensions) = (/ 2, 3, 3, 2 /)
181  TYPE(xt_stripe), PARAMETER :: ref_stripes(18) &
182  = (/ (((xt_stripe(16_xi + j*3_xi + k*12_xi + l*48_xi, 1_xi, 2), &
183  & j = 0_xi,2_xi), k=0_xi,2_xi), l=0_xi,1_xi) /)
184  TYPE(xt_idxlist) :: idxsection
185 
186  ! create index section
187  idxsection = xt_idxsection_new(start, global_size, local_size, local_start)
188 
189  ! testing
190  CALL do_tests(idxsection, ref_indices, ref_stripes)
191 
192  ! clean up
193  CALL xt_idxlist_delete(idxsection)
194  END SUBROUTINE test_4d_section
195 
196  SUBROUTINE test_2d_simple
197  INTEGER(xt_int_kind), PARAMETER :: start = 0_xi
198  INTEGER, PARAMETER :: num_dimensions = 2
199  INTEGER(xt_int_kind) :: i, j
200  INTEGER(xt_int_kind), PARAMETER :: global_size(num_dimensions) &
201  = (/ 5_xi, 10_xi /), &
202  local_start(num_dimensions) = (/ 1_xi, 2_xi /), &
203  ref_indices(12) &
204  = (/ ((12_xi + i + j*10_xi, i=0_xi,3_xi), j=0_xi,2_xi) /)
205  INTEGER, PARAMETER :: local_size(num_dimensions) = (/ 3, 4 /)
206  TYPE(xt_idxlist) :: idxsection
207 
208  ! create index section
209  idxsection = xt_idxsection_new(start, global_size, local_size, local_start)
210 
211  ! testing
212  CALL check_idxlist(idxsection, ref_indices)
213 
214  CALL xt_idxlist_delete(idxsection)
215  END SUBROUTINE test_2d_simple
216 
217  SUBROUTINE test_intersection(&
218  start_a, global_size_a, local_size_a, local_start_a, &
219  start_b, global_size_b, local_size_b, local_start_b, &
220  ref_indices, ref_stripes)
221  INTEGER(xt_int_kind), INTENT(in) :: start_a, start_b, global_size_a(:), &
222  global_size_b(:), local_start_a(:), local_start_b(:), ref_indices(:)
223  INTEGER, INTENT(in) :: local_size_a(:), local_size_b(:)
224  TYPE(xt_stripe), INTENT(in) :: ref_stripes(:)
225  TYPE(xt_idxlist) :: idxsection(2), intersection
226  idxsection(1) = xt_idxsection_new(start_a, global_size_a, local_size_a, &
227  local_start_a)
228  idxsection(2) = xt_idxsection_new(start_b, global_size_b, local_size_b, &
229  local_start_b)
230  intersection = xt_idxlist_get_intersection(idxsection(1), idxsection(2))
231  CALL xt_idxlist_delete(idxsection(2))
232  CALL xt_idxlist_delete(idxsection(1))
233  CALL do_tests(intersection, ref_indices, ref_stripes)
234  CALL xt_idxlist_delete(intersection)
235  END SUBROUTINE test_intersection
236 
237  SUBROUTINE test_1d_intersection1
238  INTEGER(xt_int_kind), PARAMETER :: start=0_xi, &
239  global_size_a(1) = 10_xi, global_size_b(1) = 15_xi, &
240  local_start_a(1) = 4_xi, local_start_b(1) = 7_xi, &
241  ref_indices(2) = (/ 7_xi, 8_xi /)
242  INTEGER, PARAMETER :: local_size_a(1) = 5, local_size_b(1) = 6
243  TYPE(xt_stripe), PARAMETER :: ref_stripes(1) = (/ xt_stripe(7, 1, 2) /)
244  CALL test_intersection(&
245  start, global_size_a, local_size_a, local_start_a, &
246  start, global_size_b, local_size_b, local_start_b, &
247  ref_indices, ref_stripes)
248  END SUBROUTINE test_1d_intersection1
249 
250  SUBROUTINE test_1d_intersection2
251  INTEGER(xt_int_kind), PARAMETER :: start=0_xi, global_size_a(1) = 10_xi, &
252  global_size_b(1) = 10_xi, local_start_a(1) = 3_xi, &
253  local_start_b(1) = 4_xi, ref_indices(1) = (/ -1_xi /)
254  INTEGER, PARAMETER :: local_size_a(1) = 1, local_size_b(1) = 5
255  TYPE(xt_stripe), PARAMETER :: ref_stripes(1) = (/ xt_stripe(-1, -1, -1) /)
256  CALL test_intersection(&
257  start, global_size_a, local_size_a, local_start_a, &
258  start, global_size_b, local_size_b, local_start_b, &
259  ref_indices(1:0), ref_stripes(1:0))
260  END SUBROUTINE test_1d_intersection2
261 
262  SUBROUTINE test_2d_intersection1
263  INTEGER, PARAMETER :: n = 2
264  INTEGER(xt_int_kind), PARAMETER :: start=0_xi, &
265  global_size_a(n) = 6_xi, global_size_b(n) = 6_xi, &
266  local_start_a(n) = 1_xi, local_start_b(n) = (/ 3_xi, 2_xi /), &
267  ref_indices(2) = (/ 20_xi, 26_xi /)
268  INTEGER, PARAMETER :: local_size_a(n) = (/ 4, 2 /), local_size_b(n) = 3
269  TYPE(xt_stripe), PARAMETER :: ref_stripes(2) = (/ xt_stripe(20, 1, 1), &
270  xt_stripe(26, 1, 1) /)
271  CALL test_intersection(&
272  start, global_size_a, local_size_a, local_start_a, &
273  start, global_size_b, local_size_b, local_start_b, &
274  ref_indices, ref_stripes)
275  END SUBROUTINE test_2d_intersection1
276 
277  SUBROUTINE test_2d_1
278  INTEGER, PARAMETER :: n = 2
279  INTEGER(xt_int_kind), PARAMETER :: start=0_xi, &
280  global_size(n) = 4, local_start(n) = (/ 0_xi, 2_xi /), &
281  ref_indices(4) = (/ 2_xi, 3_xi, 6_xi, 7_xi /)
282  INTEGER, PARAMETER :: local_size(n) = 2
283  TYPE(xt_idxlist) :: idxsection
284  idxsection = xt_idxsection_new(start, n, global_size, local_size, &
285  local_start)
286  CALL check_idxlist(idxsection, ref_indices)
287  CALL xt_idxlist_delete(idxsection)
288  END SUBROUTINE test_2d_1
289 
290  SUBROUTINE test_2d_2
291  INTEGER, PARAMETER :: n = 2
292  INTEGER(xt_int_kind), PARAMETER :: start=1_xi, &
293  global_size(n) = 4_xi, local_start(n) = (/ 0_xi, 2_xi /), &
294  ref_indices(4) = (/ 3_xi, 4_xi, 7_xi, 8_xi /)
295  INTEGER, PARAMETER :: local_size(n) = 2
296  TYPE(xt_idxlist) :: idxsection
297  idxsection = xt_idxsection_new(start, n, global_size, local_size, &
298  local_start)
299  CALL check_idxlist(idxsection, ref_indices)
300  CALL xt_idxlist_delete(idxsection)
301  END SUBROUTINE test_2d_2
302 
303  SUBROUTINE test_get_positions1
304  INTEGER, PARAMETER :: n = 2, num_selection = 6
305  INTEGER(xt_int_kind), PARAMETER :: start=0_xi, &
306  global_size(n) = 4_xi, local_start(n) = (/ 0_xi, 2_xi /)
307  INTEGER, PARAMETER :: local_size(n) = 2
308  INTEGER(xt_int_kind), PARAMETER :: selection(num_selection) &
309  = (/ 1_xi, 2_xi, 5_xi, 6_xi, 7_xi, 8_xi /)
310  INTEGER, PARAMETER :: ref_positions(num_selection) &
311  = (/ 1*0 - 1, 2*0 + 0, 5*0 - 1, 6*0 + 2, 7*0 + 3, 8*0 - 1 /)
312  INTEGER :: positions(num_selection), num_found
313  TYPE(xt_idxlist) :: idxsection
314  idxsection = xt_idxsection_new(start, n, global_size, local_size, &
315  local_start)
316  num_found = xt_idxlist_get_positions_of_indices(idxsection, selection, &
317  positions, .false.)
318  IF (num_found /= 3) &
319  CALL test_abort("xt_idxlist_get_positions_of_indices &
320  &returned incorrect num_unmatched", &
321  __file__, &
322  __line__)
323  IF (any(positions /= ref_positions)) &
324  CALL test_abort("xt_idxlist_get_positions_of_indices &
325  &returned incorrect position", &
326  __file__, &
327  __line__)
328  CALL xt_idxlist_delete(idxsection)
329  END SUBROUTINE test_get_positions1
330 
331  SUBROUTINE test_get_positions2
332  INTEGER, PARAMETER :: n = 2, num_selection = 9
333  INTEGER(xt_int_kind), PARAMETER :: start=0_xi, &
334  global_size(n) = 4_xi, local_start(n) = (/ 0_xi, 2_xi /)
335  INTEGER, PARAMETER :: local_size(n) = 2
336  INTEGER(xt_int_kind), PARAMETER :: selection(num_selection) &
337  = (/ 2_xi, 1_xi, 5_xi, 7_xi, 6_xi, 7_xi, 7_xi, 6_xi, 8_xi /)
338  INTEGER, PARAMETER :: ref_positions(num_selection) &
339  = (/ 2*0 + 0, 1*0 - 1, 5*0 - 1, 7*0 + 3, 6*0 + 2, 7*0 + 3, 7*0 + 3, &
340  & 6*0 + 2, 8*0 - 1 /)
341  integer :: positions(num_selection), num_found, i, p
342  LOGICAL :: notfound
343  TYPE(xt_idxlist) :: idxsection
344  idxsection = xt_idxsection_new(start, n, global_size, local_size, &
345  local_start)
346  num_found = xt_idxlist_get_positions_of_indices(idxsection, selection, &
347  positions, .false.)
348  IF (num_found /= 3) &
349  CALL test_abort("xt_idxlist_get_position_of_indices &
350  &returned incorrect num_unmatched", &
351  __file__, &
352  __line__)
353  IF (any(positions /= ref_positions)) &
354  CALL test_abort("xt_idxlist_get_position_of_indices &
355  &returned incorrect position", &
356  __file__, &
357  __line__)
358  DO i = 1, num_selection
359  notfound = xt_idxlist_get_position_of_index(idxsection, selection(i), p)
360  IF (p /= ref_positions(i) &
361  .OR. (notfound .AND. ref_positions(i) /= -1)) &
362  CALL test_abort("xt_idxlist_get_position_of_index &
363  &returned incorrect position", &
364  __file__, &
365  __line__)
366  END DO
367  CALL xt_idxlist_delete(idxsection)
368  END SUBROUTINE test_get_positions2
369 
370  SUBROUTINE test_other_intersection
371  INTEGER, PARAMETER :: n = 2, num_sel_idx = 9
372  INTEGER(xt_int_kind), PARAMETER :: start=0_xi, &
373  global_size(n) = 4_xi, local_start(n) = (/ 0_xi, 2_xi /), &
374  sel_idx(num_sel_idx) &
375  = (/ 2_xi, 1_xi, 5_xi, 7_xi, 6_xi, 7_xi, 7_xi, 6_xi, 8_xi /), &
376  ref_inter_idx(6) = (/ 2_xi, 6_xi, 6_xi, 7_xi, 7_xi, 7_xi /)
377  INTEGER, PARAMETER :: local_size(n) = 2
378  TYPE(xt_idxlist) :: idxsection, sel_idxlist, inter_idxlist
379 
380  idxsection = xt_idxsection_new(start, n, global_size, local_size, &
381  local_start)
382  sel_idxlist = xt_idxvec_new(sel_idx)
383  inter_idxlist = xt_idxlist_get_intersection(idxsection, sel_idxlist)
384  CALL xt_idxlist_delete(sel_idxlist)
385  CALL xt_idxlist_delete(idxsection)
386  CALL check_idxlist(inter_idxlist, ref_inter_idx)
387  CALL xt_idxlist_delete(inter_idxlist)
388  END SUBROUTINE test_other_intersection
389 
390  ! test 2D section with arbitrary size signs
391  SUBROUTINE test_signed_sizes1
392  INTEGER :: i
393  TYPE(xt_idxlist) :: idxsection
394  INTEGER, PARAMETER :: n = 2
395  INTEGER(xt_int_kind), PARAMETER :: start = 0, &
396  global_size(n, 4) = reshape( &
397  (/ 5_xi, 10_xi, 5_xi,-10_xi, -5_xi, 10_xi, -5_xi, -10_xi /), &
398  (/ n, 4 /) ), &
399  local_start(2) = (/ 1_xi, 2_xi /), &
400  ref_indices(12, 16) = reshape( &
401  (/ 12_xi, 13_xi, 14_xi, 15_xi, 22_xi, 23_xi, 24_xi, 25_xi, 32_xi, &
402  & 33_xi, 34_xi, 35_xi, &
403  & 15_xi, 14_xi, 13_xi, 12_xi, 25_xi, 24_xi, 23_xi, 22_xi, 35_xi, &
404  & 34_xi, 33_xi, 32_xi, &
405  & 32_xi, 33_xi, 34_xi, 35_xi, 22_xi, 23_xi, 24_xi, 25_xi, 12_xi, &
406  & 13_xi, 14_xi, 15_xi, &
407  & 35_xi, 34_xi, 33_xi, 32_xi, 25_xi, 24_xi, 23_xi, 22_xi, 15_xi, &
408  & 14_xi, 13_xi, 12_xi, &
409  & 17_xi, 16_xi, 15_xi, 14_xi, 27_xi, 26_xi, 25_xi, 24_xi, 37_xi, &
410  & 36_xi, 35_xi, 34_xi, &
411  & 14_xi, 15_xi, 16_xi, 17_xi, 24_xi, 25_xi, 26_xi, 27_xi, 34_xi, &
412  & 35_xi, 36_xi, 37_xi, &
413  & 37_xi, 36_xi, 35_xi, 34_xi, 27_xi, 26_xi, 25_xi, 24_xi, 17_xi, &
414  & 16_xi, 15_xi, 14_xi, &
415  & 34_xi, 35_xi, 36_xi, 37_xi, 24_xi, 25_xi, 26_xi, 27_xi, 14_xi, &
416  & 15_xi, 16_xi, 17_xi, &
417  & 32_xi, 33_xi, 34_xi, 35_xi, 22_xi, 23_xi, 24_xi, 25_xi, 12_xi, &
418  & 13_xi, 14_xi, 15_xi, &
419  & 35_xi, 34_xi, 33_xi, 32_xi, 25_xi, 24_xi, 23_xi, 22_xi, 15_xi, &
420  & 14_xi, 13_xi, 12_xi, &
421  & 12_xi, 13_xi, 14_xi, 15_xi, 22_xi, 23_xi, 24_xi, 25_xi, 32_xi, &
422  & 33_xi, 34_xi, 35_xi, &
423  & 15_xi, 14_xi, 13_xi, 12_xi, 25_xi, 24_xi, 23_xi, 22_xi, 35_xi, &
424  & 34_xi, 33_xi, 32_xi, &
425  & 37_xi, 36_xi, 35_xi, 34_xi, 27_xi, 26_xi, 25_xi, 24_xi, 17_xi, &
426  & 16_xi, 15_xi, 14_xi, &
427  & 34_xi, 35_xi, 36_xi, 37_xi, 24_xi, 25_xi, 26_xi, 27_xi, 14_xi, &
428  & 15_xi, 16_xi, 17_xi, &
429  & 17_xi, 16_xi, 15_xi, 14_xi, 27_xi, 26_xi, 25_xi, 24_xi, 37_xi, &
430  & 36_xi, 35_xi, 34_xi, &
431  & 14_xi, 15_xi, 16_xi, 17_xi, 24_xi, 25_xi, 26_xi, 27_xi, 34_xi, &
432  & 35_xi, 36_xi, 37_xi /), (/ 12, 16 /) )
433  INTEGER, PARAMETER :: local_size(n, 4) = reshape( &
434  (/ 3, 4, 3, -4, -3, 4, -3, -4 /), (/ n, 4 /) )
435  ! iterate through all sign combinations of -/+ for local and global
436  ! and for x and y, giving 2^2^2 combinations
437  DO i = 0, 15
438  ! create index section
439 
440  idxsection = xt_idxsection_new(start, n, global_size(:, i/4 + 1), &
441  local_size(:, mod(i, 4) + 1), local_start)
442 
443  ! testing
444  CALL check_idxlist(idxsection, ref_indices(:, i + 1))
445 
446  ! clean up
447  CALL xt_idxlist_delete(idxsection)
448  END DO
449  END SUBROUTINE test_signed_sizes1
450 
451  ! test 2D section with arbitrary size signs
452  SUBROUTINE test_signed_sizes2
453  INTEGER :: i
454  TYPE(xt_idxlist) :: idxsection
455  INTEGER, PARAMETER :: n = 2
456  INTEGER(xt_int_kind), PARAMETER :: start = 0, &
457  global_size(n, 4) = reshape( &
458  (/ 5_xi, 6_xi, 5_xi,-6_xi, -5_xi, 6_xi, -5_xi, -6_xi /), &
459  (/ n, 4 /) ), &
460  local_start(2) = (/ 1_xi, 2_xi /), &
461  ref_indices(6, 16) = reshape( &
462  (/ 8_xi, 9_xi, 10_xi, 14_xi, 15_xi, 16_xi, &
463  & 10_xi, 9_xi, 8_xi, 16_xi, 15_xi, 14_xi, &
464  & 14_xi, 15_xi, 16_xi, 8_xi, 9_xi, 10_xi, &
465  & 16_xi, 15_xi, 14_xi, 10_xi, 9_xi, 8_xi, &
466  & 9_xi, 8_xi, 7_xi, 15_xi, 14_xi, 13_xi, &
467  & 7_xi, 8_xi, 9_xi, 13_xi, 14_xi, 15_xi, &
468  & 15_xi, 14_xi, 13_xi, 9_xi, 8_xi, 7_xi, &
469  & 13_xi, 14_xi, 15_xi, 7_xi, 8_xi, 9_xi, &
470  & 20_xi, 21_xi, 22_xi, 14_xi, 15_xi, 16_xi, &
471  & 22_xi, 21_xi, 20_xi, 16_xi, 15_xi, 14_xi, &
472  & 14_xi, 15_xi, 16_xi, 20_xi, 21_xi, 22_xi, &
473  & 16_xi, 15_xi, 14_xi, 22_xi, 21_xi, 20_xi, &
474  & 21_xi, 20_xi, 19_xi, 15_xi, 14_xi, 13_xi, &
475  & 19_xi, 20_xi, 21_xi, 13_xi, 14_xi, 15_xi, &
476  & 15_xi, 14_xi, 13_xi, 21_xi, 20_xi, 19_xi, &
477  & 13_xi, 14_xi, 15_xi, 19_xi, 20_xi, 21_xi /), (/ 6, 16 /) )
478  ! iterate through all sign combinations of -/+ for local and global
479  INTEGER, PARAMETER :: local_size(n, 4) = reshape( &
480  (/ 2, 3, 2, -3, -2, 3, -2, -3 /), (/ n, 4 /) )
481  ! iterate through all sign combinations of -/+ for local and global
482  ! and for x and y, giving 2^2^2 combinations
483  DO i = 0, 15
484  ! create index section
485 
486  idxsection = xt_idxsection_new(start, n, global_size(:, i/4 + 1), &
487  local_size(:, mod(i, 4) + 1), local_start)
488 
489  ! testing
490  CALL check_idxlist(idxsection, ref_indices(:, i + 1))
491 
492  ! clean up
493  CALL xt_idxlist_delete(idxsection)
494  END DO
495  END SUBROUTINE test_signed_sizes2
496 
497  SUBROUTINE test_signed_size_intersections
498  INTEGER, PARAMETER :: n = 2
499  INTEGER(xt_int_kind), PARAMETER :: start = 0, &
500  global_size(n, 4) = reshape( &
501  (/ 5_xi, 10_xi, 5_xi,-10_xi, -5_xi, 10_xi, -5_xi, -10_xi /), &
502  (/ n, 4 /) ), &
503  local_start(2) = (/ 1_xi, 2_xi /), &
504  indices(12, 16) = reshape( &
505  (/ 12_xi, 13_xi, 14_xi, 15_xi, 22_xi, 23_xi, 24_xi, 25_xi, 32_xi, &
506  & 33_xi, 34_xi, 35_xi, &
507  & 15_xi, 14_xi, 13_xi, 12_xi, 25_xi, 24_xi, 23_xi, 22_xi, 35_xi, &
508  & 34_xi, 33_xi, 32_xi, &
509  & 32_xi, 33_xi, 34_xi, 35_xi, 22_xi, 23_xi, 24_xi, 25_xi, 12_xi, &
510  & 13_xi, 14_xi, 15_xi, &
511  & 35_xi, 34_xi, 33_xi, 32_xi, 25_xi, 24_xi, 23_xi, 22_xi, 15_xi, &
512  & 14_xi, 13_xi, 12_xi, &
513  & 17_xi, 16_xi, 15_xi, 14_xi, 27_xi, 26_xi, 25_xi, 24_xi, 37_xi, &
514  & 36_xi, 35_xi, 34_xi, &
515  & 14_xi, 15_xi, 16_xi, 17_xi, 24_xi, 25_xi, 26_xi, 27_xi, 34_xi, &
516  & 35_xi, 36_xi, 37_xi, &
517  & 37_xi, 36_xi, 35_xi, 34_xi, 27_xi, 26_xi, 25_xi, 24_xi, 17_xi, &
518  & 16_xi, 15_xi, 14_xi, &
519  & 34_xi, 35_xi, 36_xi, 37_xi, 24_xi, 25_xi, 26_xi, 27_xi, 14_xi, &
520  & 15_xi, 16_xi, 17_xi, &
521  & 32_xi, 33_xi, 34_xi, 35_xi, 22_xi, 23_xi, 24_xi, 25_xi, 12_xi, &
522  & 13_xi, 14_xi, 15_xi, &
523  & 35_xi, 34_xi, 33_xi, 32_xi, 25_xi, 24_xi, 23_xi, 22_xi, 15_xi, &
524  & 14_xi, 13_xi, 12_xi, &
525  & 12_xi, 13_xi, 14_xi, 15_xi, 22_xi, 23_xi, 24_xi, 25_xi, 32_xi, &
526  & 33_xi, 34_xi, 35_xi, &
527  & 15_xi, 14_xi, 13_xi, 12_xi, 25_xi, 24_xi, 23_xi, 22_xi, 35_xi, &
528  & 34_xi, 33_xi, 32_xi, &
529  & 37_xi, 36_xi, 35_xi, 34_xi, 27_xi, 26_xi, 25_xi, 24_xi, 17_xi, &
530  & 16_xi, 15_xi, 14_xi, &
531  & 34_xi, 35_xi, 36_xi, 37_xi, 24_xi, 25_xi, 26_xi, 27_xi, 14_xi, &
532  & 15_xi, 16_xi, 17_xi, &
533  & 17_xi, 16_xi, 15_xi, 14_xi, 27_xi, 26_xi, 25_xi, 24_xi, 37_xi, &
534  & 36_xi, 35_xi, 34_xi, &
535  & 14_xi, 15_xi, 16_xi, 17_xi, 24_xi, 25_xi, 26_xi, 27_xi, 34_xi, &
536  & 35_xi, 36_xi, 37_xi /), (/ 12, 16 /) )
537  INTEGER, PARAMETER :: local_size(n, 4) = reshape( &
538  (/ 3, 4, 3, -4, -3, 4, -3, -4 /), (/ n, 4 /) )
539  INTEGER :: i, j
540  TYPE(xt_idxlist) :: idxsection_a, idxsection_b, &
541  idxvec_a, idxvec_b, idxsection_intersection, &
542  idxsection_intersection_other, idxvec_intersection
543 
544  DO i = 0, 15
545  DO j = 0, 15
546  ! create index section
547  idxsection_a = xt_idxsection_new(start, n, global_size(:, i/4 + 1), &
548  local_size(:, mod(i, 4) + 1), local_start)
549  idxsection_b = xt_idxsection_new(start, n, global_size(:, j/4 + 1), &
550  local_size(:, mod(j, 4) + 1), local_start)
551  ! create reference index vectors
552  idxvec_a = xt_idxvec_new(indices(:, i))
553  idxvec_b = xt_idxvec_new(indices(:, j))
554 
555  ! testing
556  idxsection_intersection = xt_idxlist_get_intersection(idxsection_a, &
557  idxsection_b)
558  idxsection_intersection_other &
559  = xt_idxlist_get_intersection(idxsection_a, idxvec_b)
560  idxvec_intersection = xt_idxlist_get_intersection(idxvec_a, idxvec_b)
561 
562  CALL check_idxlist(idxsection_intersection, &
563  xt_idxlist_get_indices_const(idxvec_intersection))
564  CALL check_idxlist(idxsection_intersection_other, &
565  xt_idxlist_get_indices_const(idxvec_intersection))
566 
567  ! clean up
568 
569  CALL xt_idxlist_delete(idxsection_a)
570  CALL xt_idxlist_delete(idxsection_b)
571  CALL xt_idxlist_delete(idxvec_a)
572  CALL xt_idxlist_delete(idxvec_b)
573  CALL xt_idxlist_delete(idxsection_intersection)
574  CALL xt_idxlist_delete(idxsection_intersection_other)
575  CALL xt_idxlist_delete(idxvec_intersection)
576  END DO
577  END DO
578  END SUBROUTINE test_signed_size_intersections
579 
580  SUBROUTINE test_signed_size_positions
581  TYPE(xt_idxlist) :: idxsection
582  INTEGER, PARAMETER :: n = 2, num_pos = 34
583  INTEGER :: positions(num_pos)
584 
585  INTEGER(xt_int_kind), PARAMETER :: start = 0, &
586  global_size(n) = (/ -5_xi, 6_xi /), &
587  local_start(n) = (/ 1_xi, 2_xi /), &
588  ref_indices(6) = (/ 16_xi, 15_xi, 14_xi, 22_xi, 21_xi, 20_xi /), &
589  indices(num_pos) = &
590  (/ -1_xi, 0_xi, 1_xi, 2_xi, 3_xi, &
591  & 4_xi, 5_xi, 6_xi, 7_xi, 8_xi, &
592  & 9_xi, 10_xi, 11_xi, 12_xi, 13_xi, &
593  & 14_xi, 15_xi, 14_xi, 16_xi, 17_xi, &
594  & 18_xi, 19_xi, 20_xi, 20_xi, 21_xi, &
595  & 22_xi, 23_xi, 24_xi, 25_xi, 26_xi, &
596  & 27_xi, 28_xi, 29_xi, 30_xi /)
597  INTEGER, PARAMETER :: local_size(n) = (/ -2, -3 /)
598  INTEGER, PARAMETER :: ref_positions(num_pos) = &
599  (/ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, &
600  & -1, -1, -1, -1, -1, 2, 1, -1, 0, -1, &
601  & -1, -1, 5, -1, 4, 3, -1, -1, -1, -1, &
602  & -1, -1, -1, -1 /)
603 
604  ! create index section
605  idxsection = xt_idxsection_new(start, n, global_size, &
606  local_size, local_start)
607 
608  ! testing
609  CALL check_idxlist(idxsection, ref_indices)
610 
611  ! check get_positions_of_indices
612  if (xt_idxlist_get_positions_of_indices(idxsection, indices, positions, &
613  .true.) /= 28) &
614  CALL test_abort("error in xt_idxlist_get_positions_of_indices &
615  &(wrong number of unmatched indices)", &
616  __file__, &
617  __line__)
618 
619  IF (any(ref_positions /= positions)) &
620  call test_abort("error in xt_idxlist_get_positions_of_indices &
621  &(wrong position)", &
622  __file__, &
623  __line__)
624 
625  ! clean up
626  CALL xt_idxlist_delete(idxsection)
627  END SUBROUTINE test_signed_size_positions
628 
629  SUBROUTINE test_section_with_stride(start, global_size, local_size, &
630  local_start, ref_indices)
631  INTEGER(xt_int_kind), INTENT(in) :: start, global_size(:), &
632  local_start(:), ref_indices(:)
633  INTEGER, INTENT(in) :: local_size(:)
634  TYPE(xt_idxlist) :: idxsection
635  idxsection = xt_idxsection_new(start, SIZE(global_size), global_size, &
636  local_size, local_start)
637  CALL check_idxlist(idxsection, ref_indices)
638  CALL xt_idxlist_delete(idxsection)
639  END SUBROUTINE test_section_with_stride
640 
641  SUBROUTINE test_section_with_stride1
642  INTEGER, PARAMETER :: num_dimensions = 3
643  INTEGER(xt_int_kind), PARAMETER :: start = 0_xi, &
644  global_size(num_dimensions) = (/ 5_xi, 5_xi, 2_xi /), &
645  local_start(num_dimensions) = (/ 2_xi, 0_xi, 1_xi /), &
646  ref_indices(12) = &
647  (/ 21_xi, 23_xi, 25_xi, 27_xi, &
648  & 31_xi, 33_xi, 35_xi, 37_xi, &
649  & 41_xi, 43_xi, 45_xi, 47_xi /)
650  INTEGER, PARAMETER :: local_size(num_dimensions) = (/ 3, 4, 1 /)
651  CALL test_section_with_stride(start, global_size, local_size, local_start, &
652  ref_indices)
653  END SUBROUTINE test_section_with_stride1
654 
655  SUBROUTINE test_section_with_stride2
656  INTEGER, PARAMETER :: num_dimensions = 4
657  INTEGER(xt_int_kind), PARAMETER :: start = 0_xi, &
658  global_size(num_dimensions) = (/ 3_xi, 2_xi, 5_xi, 2_xi /), &
659  local_start(num_dimensions) = (/ 0_xi, 1_xi, 1_xi, 0_xi /), &
660  ref_indices(12) = &
661  (/ 12_xi, 14_xi, 16_xi, 18_xi, &
662  & 32_xi, 34_xi, 36_xi, 38_xi, &
663  & 52_xi, 54_xi, 56_xi, 58_xi /)
664  INTEGER, PARAMETER :: local_size(num_dimensions) = (/ 3, 1, 4, 1 /)
665  CALL test_section_with_stride(start, global_size, local_size, local_start, &
666  ref_indices)
667  END SUBROUTINE test_section_with_stride2
668 
669  SUBROUTINE check_bb(start, global_size, local_size, &
670  local_start, bb_start, global_bb_size, ref_bb)
671  INTEGER(xt_int_kind), INTENT(in) :: start, global_size(:), local_start(:), &
672  bb_start, global_bb_size(:)
673  INTEGER, INTENT(in) :: local_size(:)
674  TYPE(xt_bounds), INTENT(in) :: ref_bb(:)
675  TYPE(xt_idxlist) :: idxsection
676  TYPE(xt_bounds) :: bounds(size(global_bb_size))
677  idxsection = xt_idxsection_new(start, SIZE(global_size), global_size, &
678  local_size, local_start)
679  bounds = xt_idxlist_get_bounding_box(idxsection, global_bb_size, bb_start)
680  IF (any(bounds /= ref_bb)) &
681  CALL test_abort("bounding box mismatch", &
682  __file__, &
683  __line__)
684  CALL xt_idxlist_delete(idxsection)
685  END SUBROUTINE check_bb
686 
687  SUBROUTINE test_bb1
688  INTEGER, PARAMETER :: num_dimensions = 3
689  INTEGER(xt_int_kind), PARAMETER :: start = 0_xi, &
690  global_size(num_dimensions) = 4_xi, &
691  local_start(num_dimensions) = (/ 2_xi, 0_xi, 1_xi /)
692  INTEGER, PARAMETER :: local_size(num_dimensions) = 0
693  TYPE(xt_bounds), PARAMETER :: ref_bb(num_dimensions) = xt_bounds(0, 0)
694  CALL check_bb(start, global_size, local_size, local_start, start, &
695  int(global_size, xt_int_kind), ref_bb)
696  END SUBROUTINE test_bb1
697 
698  SUBROUTINE test_bb2
699  INTEGER, PARAMETER :: num_dimensions = 3
700  INTEGER(xt_int_kind), PARAMETER :: start = 1_xi, &
701  global_size(num_dimensions) = (/ 5_xi, 4_xi, 3_xi /), &
702  local_start(num_dimensions) = (/ 2_xi, 2_xi, 1_xi /)
703  INTEGER, PARAMETER :: local_size(num_dimensions) = 2
704  TYPE(xt_bounds), PARAMETER :: ref_bb(num_dimensions) = &
705  (/ xt_bounds(2, 2), xt_bounds(2, 2), xt_bounds(1, 2) /)
706  CALL check_bb(start, global_size, local_size, local_start, start, &
707  int(global_size, xt_int_kind), ref_bb)
708  END SUBROUTINE test_bb2
709 
710  SUBROUTINE test_bb3
711  INTEGER, PARAMETER :: num_dimensions = 4, bb_ndim = 3
712  INTEGER(xt_int_kind), PARAMETER :: start = 1_xi, &
713  global_size(num_dimensions) = (/ 5_xi, 2_xi, 2_xi, 3_xi /), &
714  local_start(num_dimensions) = (/ 2_xi, 0_xi, 1_xi, 1_xi /), &
715  global_bb_size(bb_ndim) = (/ 5_xi, 4_xi, 3_xi /)
716  INTEGER, PARAMETER :: local_size(num_dimensions) = (/ 2, 2, 1, 2 /)
717  TYPE(xt_bounds), PARAMETER :: ref_bb(bb_ndim) = &
718  (/ xt_bounds(2, 2), xt_bounds(1, 3), xt_bounds(1, 2) /)
719  CALL check_bb(start, global_size, local_size, local_start, start, &
720  global_bb_size, ref_bb)
721  END SUBROUTINE test_bb3
722 
723  SUBROUTINE do_tests(idxlist, ref_indices, ref_stripes)
724  TYPE(xt_idxlist), INTENT(in) :: idxlist
725  INTEGER(xt_int_kind), INTENT(in) :: ref_indices(:)
726  TYPE(xt_stripe), OPTIONAL, INTENT(in) :: ref_stripes(:)
727 
728  TYPE(xt_stripe), ALLOCATABLE :: stripes(:)
729  TYPE(xt_idxlist) :: idxlist_copy
730 
731  CALL check_idxlist(idxlist, ref_indices)
732  IF (PRESENT(ref_stripes)) THEN
733  CALL xt_idxlist_get_index_stripes(idxlist, stripes)
734  IF (ALLOCATED(stripes)) THEN
735  CALL check_stripes(stripes, ref_stripes)
736  DEALLOCATE(stripes)
737  ELSE
738  IF (SIZE(ref_stripes) /= 0) &
739  CALL test_abort("failed to reproduce stripes", &
740  __file__, &
741  __line__)
742  END IF
743  END IF
744 
745  ! test packing and unpacking
746  idxlist_copy = idxlist_pack_unpack_copy(idxlist)
747  ! check copy
748  CALL check_idxlist(idxlist_copy, ref_indices)
749 
750  CALL xt_idxlist_delete(idxlist_copy)
751 
752  ! test copying
753  idxlist_copy = xt_idxlist_copy(idxlist)
754 
755  ! check copy
756  CALL check_idxlist(idxlist_copy, ref_indices)
757 
758  ! clean up
759  CALL xt_idxlist_delete(idxlist_copy)
760  END SUBROUTINE do_tests
761 
762 END PROGRAM test_idxsection
763 !
764 ! Local Variables:
765 ! f90-continuation-indent: 5
766 ! coding: utf-8
767 ! indent-tabs-mode: nil
768 ! show-trailing-whitespace: t
769 ! require-trailing-newline: t
770 ! End:
771 !
Generated by   doxygen 1.8.13