Yet Another eXchange Tool 0.11.4
Loading...
Searching...
No Matches
test_idxstripes_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_idxstripes_f
49 USE ftest_common, ONLY: init_mpi, finish_mpi, test_abort, &
50 run_randomized_tests, init_fortran_random
51 USE mpi
52 USE test_idxlist_utils, ONLY: check_idxlist, test_err_count, &
53 idxlist_pack_unpack_copy
54 USE yaxt, ONLY: xt_initialize, xt_finalize, xt_bounds, xt_pos_ext, &
60 xt_idxlist_get_bounding_box, OPERATOR(/=), &
64 USE iso_c_binding, ONLY: c_int
65 IMPLICIT NONE
66 INTEGER, PARAMETER :: xi = xt_int_kind
67 LOGICAL :: fully_random_tests
68 CHARACTER(len=*), PARAMETER :: filename = 'test_idxstripes_f.f90'
69
70 CALL init_mpi
71 CALL xt_initialize(mpi_comm_world)
72 CALL stripe_test_general1
73 CALL stripe_test_general2
74 CALL stripe_test_general3
75 CALL stripe_test_general4
76 CALL stripe_test_general5
77 CALL stripe_test_general6
78 CALL test_intersection0
79 CALL test_intersection1
80 CALL test_intersection2
81 CALL test_intersection3
82 CALL test_intersection4
83 CALL test_intersection5
84 CALL test_intersection6
85 CALL test_intersection7
86 CALL test_intersection8
87 CALL test_intersection9
88 CALL test_intersection10
89 CALL test_intersection11
90 CALL test_intersection12
91 CALL test_intersection13
92 CALL test_intersection14
93 CALL test_intersection15
94 CALL test_intersection_stripe2vec
95 CALL test_idxlist_stripes_pos_ext1
96 CALL test_idxlist_stripes_pos_ext2
97 CALL test_idxlist_stripes_pos_ext3
98#if SIZEOF_XT_INT > 2
99 CALL test_idxlist_stripes_pos_ext4
100 CALL test_idxlist_stripes_pos_ext5
101#endif
102 CALL test_idxlist_stripes_pos_ext_randomized1(.false.)
103 fully_random_tests = run_randomized_tests()
104 IF (fully_random_tests) &
105 CALL test_idxlist_stripes_pos_ext_randomized1(.true.)
106 CALL test_get_pos1
107 CALL test_get_pos2
108 CALL test_get_pos3
109 CALL test_get_pos4
110 CALL test_stripe_overlap
111 CALL test_stripe_bb1
112 CALL test_stripe_bb2
113 CALL check_pos_ext1
114 CALL check_pos_ext2
115 CALL check_pos_ext3
116 CALL check_pos_ext4
117 CALL check_pos_ext5
118 CALL check_pos_ext6
119 CALL check_pos_ext7
120 CALL check_pos_ext8
121 IF (test_err_count() /= 0) &
122 CALL test_abort("non-zero error count!", filename, __line__)
123 CALL xt_finalize
124 CALL finish_mpi
125
126CONTAINS
127 SUBROUTINE stripe_test_general(stripes, ref_indices)
128 TYPE(xt_stripe), INTENT(in) :: stripes(:)
129 INTEGER(xt_int_kind), INTENT(in) :: ref_indices(:)
130
131 TYPE(xt_idxlist) :: idxstripes, idxvec
132 INTEGER :: num_ext, num_unmatched, num_pos, i
133 INTEGER(c_int) :: ext_size
134 TYPE(xt_pos_ext), ALLOCATABLE :: pos_ext(:)
135
136 idxstripes = xt_idxstripes_new(stripes, SIZE(stripes))
137 CALL do_tests(idxstripes, ref_indices)
138
139 num_unmatched = xt_idxlist_get_pos_exts_of_index_stripes(idxstripes, &
140 stripes, pos_ext, .true.)
141 IF (num_unmatched /= 0) &
142 CALL test_abort("stripes not found", filename, __line__)
143
144 num_pos = 0
145 IF (ALLOCATED(pos_ext)) THEN
146 num_ext = SIZE(pos_ext)
147 ELSE
148 num_ext = 0
149 END IF
150 DO i = 1, num_ext
151 ext_size = pos_ext(i)%size
152 IF (num_pos /= pos_ext(i)%start) &
153 CALL test_abort("position/start mismatch", filename, __line__)
154 num_pos = num_pos + ext_size
155 END DO
156 IF (num_pos /= xt_idxlist_get_num_indices(idxstripes)) &
157 CALL test_abort("index list length/positions overlap mismatch", &
158 filename, __line__)
159
160 IF (ALLOCATED(pos_ext)) DEALLOCATE(pos_ext)
161 CALL xt_idxlist_delete(idxstripes)
162
163 ! test recreation of stripes from reference vector
164 idxvec = xt_idxvec_new(ref_indices)
165 idxstripes = xt_idxstripes_from_idxlist_new(idxvec)
166 CALL check_idxlist(idxstripes, ref_indices)
167 CALL xt_idxlist_delete(idxvec)
168 CALL xt_idxlist_delete(idxstripes)
169 END SUBROUTINE stripe_test_general
170
171 SUBROUTINE stripe_test_general1
172 TYPE(xt_stripe), PARAMETER :: stripes(3) = (/ xt_stripe(0, 1, 5), &
173 xt_stripe(10, 1, 5), xt_stripe(20, 1, 5) /);
174 INTEGER(xt_int_kind), PARAMETER :: ref_indices(15) &
175 = (/ 0_xi, 1_xi, 2_xi, 3_xi, 4_xi, &
176 & 10_xi, 11_xi, 12_xi, 13_xi, 14_xi, &
177 & 20_xi, 21_xi, 22_xi, 23_xi, 24_xi /)
178 CALL stripe_test_general(stripes, ref_indices)
179 END SUBROUTINE stripe_test_general1
180
181 SUBROUTINE stripe_test_general2
182 TYPE(xt_stripe), PARAMETER :: stripes(3) = (/ xt_stripe(0, 1, 5), &
183 xt_stripe(10, 2, 5), xt_stripe(20, 3, 5) /)
184 INTEGER(xt_int_kind), PARAMETER :: ref_indices(15) &
185 = (/ 0_xi, 1_xi, 2_xi, 3_xi, 4_xi, &
186 & 10_xi, 12_xi, 14_xi, 16_xi, 18_xi, &
187 & 20_xi, 23_xi, 26_xi, 29_xi, 32_xi /)
188 CALL stripe_test_general(stripes, ref_indices)
189 END SUBROUTINE stripe_test_general2
190
191 SUBROUTINE stripe_test_general3
192 TYPE(xt_stripe), PARAMETER :: stripes(2) = (/ xt_stripe(0, 6, 5), &
193 xt_stripe(1, 3, 5) /)
194 INTEGER(xt_int_kind), PARAMETER :: ref_indices(10) &
195 = (/ 0_xi, 6_xi, 12_xi, 18_xi, 24_xi, &
196 & 1_xi, 4_xi, 7_xi, 10_xi, 13_xi /)
197 CALL stripe_test_general(stripes, ref_indices)
198 END SUBROUTINE stripe_test_general3
199
200 SUBROUTINE stripe_test_general4
201 TYPE(xt_stripe), PARAMETER :: stripes(2) = (/ xt_stripe(0, -1, 5), &
202 xt_stripe(1, 1, 5) /)
203 INTEGER(xt_int_kind), PARAMETER :: ref_indices(10) &
204 = (/ 0_xi, -1_xi, -2_xi, -3_xi, -4_xi, &
205 & 1_xi, 2_xi, 3_xi, 4_xi, 5_xi /)
206 CALL stripe_test_general(stripes, ref_indices)
207 END SUBROUTINE stripe_test_general4
208
209 SUBROUTINE stripe_test_general5
210 TYPE(xt_stripe), PARAMETER :: stripes(2) = (/ xt_stripe(9, -2, 5), &
211 xt_stripe(0, 2, 5) /)
212 INTEGER(xt_int_kind), PARAMETER :: ref_indices(10) &
213 = (/ 9_xi, 7_xi, 5_xi, 3_xi, 1_xi, &
214 & 0_xi, 2_xi, 4_xi, 6_xi, 8_xi /)
215 CALL stripe_test_general(stripes, ref_indices)
216 END SUBROUTINE stripe_test_general5
217
218 SUBROUTINE stripe_test_general6
219 TYPE(xt_stripe), PARAMETER :: stripes(1) = (/ xt_stripe(179, -2, 0) /)
220 INTEGER(xt_int_kind), PARAMETER :: ref_indices(1) = (/ 0_xi /)
221 CALL stripe_test_general(stripes, ref_indices(1:0))
222 END SUBROUTINE stripe_test_general6
223
224 SUBROUTINE test_intersection(stripes_a, stripes_b, ref_indices_a, ref_indices_b)
225 TYPE(xt_stripe), INTENT(in) :: stripes_a(:), stripes_b(:)
226 INTEGER(xt_int_kind), INTENT(in) :: ref_indices_a(:)
227 INTEGER(xt_int_kind), OPTIONAL, INTENT(in) :: ref_indices_b(:)
228 TYPE(xt_idxlist) :: idxstripes_a, idxstripes_b, intersection(2)
229
230 idxstripes_a = xt_idxstripes_new(stripes_a)
231 idxstripes_b = xt_idxstripes_new(stripes_b)
232 intersection(1) = xt_idxlist_get_intersection(idxstripes_a, idxstripes_b)
233 intersection(2) = xt_idxlist_get_intersection(idxstripes_b, idxstripes_a)
234 CALL do_tests(intersection(1), ref_indices_a)
235 IF (PRESENT(ref_indices_b)) THEN
236 CALL do_tests(intersection(2), ref_indices_b)
237 ELSE
238 CALL do_tests(intersection(2), ref_indices_a)
239 END IF
240 CALL xt_idxlist_delete(intersection(2))
241 CALL xt_idxlist_delete(intersection(1))
242 CALL xt_idxlist_delete(idxstripes_a)
243 CALL xt_idxlist_delete(idxstripes_b)
244 END SUBROUTINE test_intersection
245
246 SUBROUTINE test_intersection0
247 TYPE(xt_stripe), PARAMETER :: stripes_a(1) = (/ xt_stripe(0, 0, 0) /), &
248 stripes_b(1) = (/ xt_stripe(1, 1, 8) /)
249 INTEGER(xt_int_kind), PARAMETER :: ref_indices(1) = (/ 0_xi /)
250 CALL test_intersection(stripes_a(1:0), stripes_b, ref_indices(1:0))
251 END SUBROUTINE test_intersection0
252
253 SUBROUTINE test_intersection1
254 TYPE(xt_stripe), PARAMETER :: stripes_a(2) = (/ xt_stripe(0, 1, 4), &
255 xt_stripe(6, 1, 4) /), &
256 stripes_b(1) = (/ xt_stripe(1, 1, 8) /)
257 INTEGER(xt_int_kind), PARAMETER :: ref_indices(6) &
258 = (/ 1_xi, 2_xi, 3_xi, 6_xi, 7_xi, 8_xi /)
259 CALL test_intersection(stripes_a, stripes_b, ref_indices)
260 END SUBROUTINE test_intersection1
261
262 SUBROUTINE test_intersection2
263 TYPE(xt_stripe), PARAMETER :: stripes_a(3) = (/ xt_stripe(0, 1, 4), &
264 xt_stripe(6, 1, 4), xt_stripe(11, 1, 4) /), &
265 stripes_b(2) = (/ xt_stripe(1, 1, 7), xt_stripe(9, 1, 5) /)
266 INTEGER(xt_int_kind), PARAMETER :: ref_indices(9) &
267 = (/ 1_xi, 2_xi, 3_xi, 6_xi, 7_xi, 9_xi, 11_xi, 12_xi, 13_xi /)
268 CALL test_intersection(stripes_a, stripes_b, ref_indices)
269 END SUBROUTINE test_intersection2
270
271 SUBROUTINE test_intersection3
272 TYPE(xt_stripe), PARAMETER :: stripes_a(2) = (/ xt_stripe(0, 1, 3), &
273 xt_stripe(8, 1, 3) /), &
274 stripes_b(2) = (/ xt_stripe(3, 1, 5), xt_stripe(11, 1, 3) /)
275 INTEGER(xt_int_kind), PARAMETER :: ref_indices(1) = (/ -1_xi /)
276 CALL test_intersection(stripes_a, stripes_b, ref_indices(1:0))
277 END SUBROUTINE test_intersection3
278
279 SUBROUTINE test_intersection4
280 TYPE(xt_stripe), PARAMETER :: stripes_a(1) = (/ xt_stripe(0, 1, 10) /), &
281 stripes_b(2) = (/ xt_stripe(0, 2, 5), xt_stripe(9, -2, 5) /)
282 INTEGER(xt_int_kind), PARAMETER :: ref_indices(10) &
283 = (/ 0_xi, 1_xi, 2_xi, 3_xi, 4_xi, 5_xi, 6_xi, 7_xi, 8_xi, 9_xi /)
284 CALL test_intersection(stripes_a, stripes_b, ref_indices)
285 END SUBROUTINE test_intersection4
286
287 SUBROUTINE test_intersection5
288 TYPE(xt_stripe), PARAMETER :: stripes_a(2) = (/ xt_stripe(0, 3, 5), &
289 xt_stripe(1, 7, 5) /), &
290 stripes_b(2) = (/ xt_stripe(0, 2, 7), xt_stripe(24, -1, 10) /)
291 INTEGER(xt_int_kind), PARAMETER :: ref_indices(6) &
292 = (/ 0_xi, 6_xi, 8_xi, 12_xi, 15_xi, 22_xi /)
293 CALL test_intersection(stripes_a, stripes_b, ref_indices)
294 END SUBROUTINE test_intersection5
295
296 SUBROUTINE test_intersection6
297 TYPE(xt_stripe), PARAMETER :: stripes_a(1) = (/ xt_stripe(0, 1, 10) /), &
298 stripes_b(2) = (/ xt_stripe(5, 1, 5), xt_stripe(4, -1, 5) /)
299 INTEGER(xt_int_kind), PARAMETER :: ref_indices(10) &
300 = (/ 0_xi, 1_xi, 2_xi, 3_xi, 4_xi, 5_xi, 6_xi, 7_xi, 8_xi, 9_xi /)
301 CALL test_intersection(stripes_a, stripes_b, ref_indices)
302 END SUBROUTINE test_intersection6
303
304 SUBROUTINE test_intersection7
305 TYPE(xt_stripe), PARAMETER :: stripes_a(2) = (/ xt_stripe(0, 1, 10) , &
306 xt_stripe(20, 1, 5) /), &
307 stripes_b(2) = (/ xt_stripe(3, 1, 5), xt_stripe(17, 1, 5) /)
308 INTEGER(xt_int_kind), PARAMETER :: ref_indices(7) &
309 = (/ 3_xi, 4_xi, 5_xi, 6_xi, 7_xi, 20_xi, 21_xi /)
310 CALL test_intersection(stripes_a, stripes_b, ref_indices)
311 END SUBROUTINE test_intersection7
312
313 SUBROUTINE test_intersection8
314 TYPE(xt_stripe), PARAMETER :: stripes_a(10) = (/ xt_stripe(0, 1, 2), &
315 xt_stripe(3, 1, 2), xt_stripe(5, 1, 2), xt_stripe(8, 1, 2), &
316 xt_stripe(10, 1, 2), xt_stripe(14, 1, 2), xt_stripe(17, 1, 2), &
317 xt_stripe(20, 1, 2), xt_stripe(23, 1, 2), xt_stripe(25, 1, 2) /), &
318 stripes_b(5) = (/ xt_stripe(5, 1, 3), xt_stripe(8, 1, 2), &
319 xt_stripe(19, 1, 1), xt_stripe(20, 1, 2), xt_stripe(30, 1, 2) /)
320 INTEGER(xt_int_kind), PARAMETER :: ref_indices(6) &
321 = (/ 5_xi, 6_xi, 8_xi, 9_xi, 20_xi, 21_xi /)
322 CALL test_intersection(stripes_a, stripes_b, ref_indices)
323 END SUBROUTINE test_intersection8
324
325 SUBROUTINE test_intersection9
326 TYPE(xt_stripe), PARAMETER :: stripes_a(3) = (/ xt_stripe(0, 1, 5), &
327 xt_stripe(1, 1, 5), xt_stripe(2, 1, 5) /), &
328 stripes_b(1) = (/ xt_stripe(-2, 1, 10) /)
329#ifndef __G95__
330 INTEGER(xi) :: i
331 INTEGER(xt_int_kind), PARAMETER :: ref_indices_a(7) &
332 = (/ (i, i=0_xi,6_xi) /), &
333#else
334 INTEGER :: i
335 INTEGER(xt_int_kind), PARAMETER :: ref_indices_a(7) &
336 = (/ (int(i, xi), i=0_xi,6_xi) /), &
337#endif
338 ref_indices_b(15) = (/ 0_xi, 1_xi, 1_xi, 2_xi, 2_xi, 2_xi, 3_xi, &
339 & 3_xi, 3_xi, 4_xi, 4_xi, 4_xi, 5_xi, 5_xi, 6_xi /)
340 CALL test_intersection(stripes_a, stripes_b, ref_indices_a, ref_indices_b)
341 END SUBROUTINE test_intersection9
342
343 SUBROUTINE test_intersection10
344 TYPE(xt_stripe), PARAMETER :: stripes_a(1) = (/ xt_stripe(0, 2, 5) /), &
345 stripes_b(1) = (/ xt_stripe(1, 2, 5) /)
346 INTEGER(xt_int_kind), PARAMETER :: dummy(1) = (/ -1_xi /)
347 CALL test_intersection(stripes_a, stripes_b, dummy(1:0))
348 END SUBROUTINE test_intersection10
349
350 SUBROUTINE test_intersection11
351 TYPE(xt_stripe), PARAMETER :: stripes_a(1) = (/ xt_stripe(0, 5, 20) /), &
352 stripes_b(1) = (/ xt_stripe(1, 7, 15) /)
353 INTEGER(xt_int_kind), PARAMETER :: ref_indices(3) = (/ 15_xi, 50_xi, 85_xi /)
354 CALL test_intersection(stripes_a, stripes_b, ref_indices)
355 END SUBROUTINE test_intersection11
356
357 ! both ranges overlap in range but have no
358 ! indices in common because of stride
359 SUBROUTINE test_intersection12
360 TYPE(xt_stripe), PARAMETER :: stripes_a(1) = (/ xt_stripe(34, 29, 12) /), &
361 stripes_b(1) = (/ xt_stripe(36, 7, 2) /)
362 INTEGER(xt_int_kind), PARAMETER :: dummy(1) = (/ -1_xi /)
363
364 CALL test_intersection(stripes_a, stripes_b, dummy(1:0))
365 END SUBROUTINE test_intersection12
366
367 ! same as test_intersection12 but with negative stride
368 SUBROUTINE test_intersection13
369 TYPE(xt_stripe), PARAMETER :: &
370 stripes_a(1) = (/ xt_stripe(353, -29, 12) /), &
371 stripes_b(1) = (/ xt_stripe(36, 7, 2) /)
372 INTEGER(xt_int_kind), PARAMETER :: dummy(1) = (/ -1_xi /)
373
374 CALL test_intersection(stripes_a, stripes_b, dummy(1:0))
375 END SUBROUTINE test_intersection13
376
377 SUBROUTINE test_intersection14
378 TYPE(xt_stripe), PARAMETER :: &
379 stripes_a(1) = (/ xt_stripe(95, -29, 2) /), &
380 stripes_b(1) = (/ xt_stripe(81, 14, 2) /)
381 INTEGER(xt_int_kind), PARAMETER :: ref_indices(1) = (/ 95_xi /)
382
383 CALL test_intersection(stripes_a, stripes_b, ref_indices)
384 END SUBROUTINE test_intersection14
385
386 SUBROUTINE test_intersection15
387 TYPE(xt_stripe), PARAMETER :: &
388 stripes_a(1) = (/ xt_stripe(546, 14, 2) /), &
389 stripes_b(1) = (/ xt_stripe(354, 206, 2) /)
390 INTEGER(xt_int_kind), PARAMETER :: ref_indices(1) = (/ 560_xi /)
391
392 CALL test_intersection(stripes_a, stripes_b, ref_indices)
393 END SUBROUTINE test_intersection15
394
395 SUBROUTINE test_intersection_stripe2vec
396 INTEGER, PARAMETER :: num_stripes = 3
397 TYPE(xt_stripe), PARAMETER :: stripes(num_stripes) &
398 = (/ xt_stripe(4, 1, 1), xt_stripe(5, 1, 1), xt_stripe(10, -10, 2) /)
399 TYPE(xt_idxlist) :: idxvec_a, idxvec_b, intersection
400 INTEGER(xt_int_kind), PARAMETER :: index_vector(1) = (/ 5_xi /)
401 INTEGER(xt_int_kind) :: intersection_idx
402 LOGICAL :: not_found
403 idxvec_a = xt_idxvec_from_stripes_new(stripes)
404 idxvec_b = xt_idxvec_new(index_vector)
405 intersection = xt_idxlist_get_intersection(idxvec_a, idxvec_b)
406 IF (xt_idxlist_get_num_indices(intersection) /= 1) &
407 CALL test_abort("unexpected number of indices in intersection!", &
408 filename, __line__)
409 not_found = xt_idxlist_get_index_at_position(intersection, 0, &
410 intersection_idx)
411 IF (not_found .OR. intersection_idx /= index_vector(1)) &
412 CALL test_abort("unexpected index in intersection!", &
413 filename, __line__)
414 CALL xt_idxlist_delete(intersection)
415 CALL xt_idxlist_delete(idxvec_a)
416 CALL xt_idxlist_delete(idxvec_b)
417 END SUBROUTINE test_intersection_stripe2vec
418
419 SUBROUTINE test_idxlist_stripes_pos_ext1
420 INTEGER, PARAMETER :: num_indices = 223
421 INTEGER(xt_int_kind), PARAMETER :: index_vector(num_indices) = (/ &
422 3375_xi, 3376_xi, 3379_xi, 3380_xi, 3381_xi, 3387_xi, 3388_xi, &
423 3389_xi, 3390_xi, 3391_xi, 3392_xi, 3393_xi, 3421_xi, 3422_xi, &
424 3423_xi, 3424_xi, 3425_xi, 3426_xi, 3427_xi, 3444_xi, 3458_xi, &
425 3459_xi, 3461_xi, 3462_xi, 3463_xi, 3464_xi, 3465_xi, 3466_xi, &
426 3467_xi, 3468_xi, 3469_xi, 3470_xi, 3471_xi, 3472_xi, 3473_xi, &
427 3474_xi, 3475_xi, 3476_xi, 3477_xi, 3478_xi, 3479_xi, 3480_xi, &
428 3529_xi, 3606_xi, 3607_xi, 3608_xi, 3611_xi, 3612_xi, 3613_xi, &
429 3614_xi, 3617_xi, 3620_xi, 3621_xi, 3622_xi, 3623_xi, 3624_xi, &
430 3625_xi, 3626_xi, 3627_xi, 3628_xi, 3629_xi, 3630_xi, 3631_xi, &
431 3684_xi, 3685_xi, 3686_xi, 3687_xi, 3688_xi, 3689_xi, 3690_xi, &
432 3691_xi, 3692_xi, 3693_xi, 3694_xi, 3695_xi, 3696_xi, 3697_xi, &
433 3698_xi, 3699_xi, 3700_xi, 3701_xi, 3702_xi, 3703_xi, 3704_xi, &
434 3705_xi, 3706_xi, 3707_xi, 3708_xi, 3709_xi, 3713_xi, 3714_xi, &
435 3715_xi, 3716_xi, 3717_xi, 3718_xi, 3719_xi, 3720_xi, 3721_xi, &
436 3722_xi, 3723_xi, 3724_xi, 3725_xi, 3726_xi, 3727_xi, 3728_xi, &
437 3729_xi, 3730_xi, 3731_xi, 3741_xi, 3742_xi, 3931_xi, 3932_xi, &
438 3374_xi, 3382_xi, 3385_xi, 3394_xi, 3404_xi, 3408_xi, 3412_xi, &
439 3440_xi, 3443_xi, 3457_xi, 3481_xi, 3483_xi, 3527_xi, 3619_xi, &
440 3735_xi, 3743_xi, 3925_xi, 3930_xi, 3377_xi, 3378_xi, 3383_xi, &
441 3384_xi, 3386_xi, 3395_xi, 3397_xi, 3398_xi, 3400_xi, 3402_xi, &
442 3403_xi, 3407_xi, 3409_xi, 3410_xi, 3413_xi, 3420_xi, 3441_xi, &
443 3442_xi, 3445_xi, 3448_xi, 3449_xi, 3451_xi, 3460_xi, 3482_xi, &
444 3519_xi, 3520_xi, 3526_xi, 3528_xi, 3530_xi, 3592_xi, 3593_xi, &
445 3595_xi, 3596_xi, 3597_xi, 3609_xi, 3610_xi, 3615_xi, 3616_xi, &
446 3618_xi, 3644_xi, 3710_xi, 3711_xi, 3712_xi, 3732_xi, 3733_xi, &
447 3736_xi, 3737_xi, 3748_xi, 3749_xi, 3753_xi, 3754_xi, 3759_xi, &
448 3760_xi, 3766_xi, 3767_xi, 3919_xi, 3920_xi, 3924_xi, 3926_xi, &
449 3933_xi, 3934_xi, 2589_xi, 2602_xi, 2680_xi, 3326_xi, 3340_xi, &
450 3341_xi, 3396_xi, 3401_xi, 3411_xi, 3414_xi, 3418_xi, 3446_xi, &
451 3447_xi, 3450_xi, 3515_xi, 3521_xi, 3525_xi, 3582_xi, 3590_xi, &
452 3591_xi, 3594_xi, 3642_xi, 3734_xi, 3738_xi, 3747_xi, 3750_xi, &
453 3761_xi, 3765_xi, 3865_xi, 3918_xi, 3923_xi, 3935_xi /)
454 INTEGER, PARAMETER :: num_stripes = 26
455 TYPE(xt_stripe), PARAMETER :: stripes(num_stripes) = (/ &
456 xt_stripe(3326, 14, 2), xt_stripe(3341, 33, 1), &
457 xt_stripe(3374, 1, 25), xt_stripe(3400, 1, 5), &
458 xt_stripe(3407, 1, 8), xt_stripe(3418, 2, 1), &
459 xt_stripe(3420, 1, 8), xt_stripe(3440, 1, 12), &
460 xt_stripe(3457, 1, 27), xt_stripe(3515, 4, 1), &
461 xt_stripe(3519, 1, 3), xt_stripe(3525, 1, 6), &
462 xt_stripe(3582, 8, 1), xt_stripe(3590, 1, 8), &
463 xt_stripe(3606, 1, 26), xt_stripe(3642, 2, 2), &
464 xt_stripe(3684, 1, 55), xt_stripe(3741, 1, 3), &
465 xt_stripe(3747, 1, 4), xt_stripe(3753, 1, 2), &
466 xt_stripe(3759, 1, 3), xt_stripe(3765, 1, 3), &
467 xt_stripe(3865, 53, 1), xt_stripe(3918, 1, 3), &
468 xt_stripe(3923, 1, 4), xt_stripe(3930, 1, 6) /)
469 TYPE(xt_idxlist) :: idxlist
470
471 idxlist = xt_idxvec_new(index_vector, num_indices)
472 CALL check_idxlist_stripes_pos_ext(idxlist, stripes)
473 CALL xt_idxlist_delete(idxlist)
474 END SUBROUTINE test_idxlist_stripes_pos_ext1
475
476 SUBROUTINE test_idxlist_stripes_pos_ext2
477 INTEGER, PARAMETER :: num_indices = 201
478 INTEGER(xt_int_kind), PARAMETER :: index_vector(num_indices) = (/ &
479 & 178_xi, 179_xi, 180_xi, 181_xi, 182_xi, 183_xi, 184_xi, &
480 & 186_xi, 187_xi, 188_xi, 189_xi, 190_xi, 194_xi, 195_xi, &
481 & 196_xi, 197_xi, 198_xi, 199_xi, 200_xi, 201_xi, 202_xi, &
482 & 203_xi, 204_xi, 205_xi, 206_xi, 207_xi, 208_xi, 209_xi, &
483 & 210_xi, 211_xi, 212_xi, 217_xi, 223_xi, 426_xi, 428_xi, &
484 & 429_xi, 430_xi, 434_xi, 435_xi, 436_xi, 437_xi, 438_xi, &
485 & 439_xi, 440_xi, 442_xi, 443_xi, 444_xi, 445_xi, 446_xi, &
486 & 447_xi, 448_xi, 449_xi, 450_xi, 451_xi, 452_xi, 453_xi, &
487 & 454_xi, 455_xi, 456_xi, 457_xi, 458_xi, 670_xi, 671_xi, &
488 & 672_xi, 673_xi, 674_xi, 675_xi, 676_xi, 677_xi, 682_xi, &
489 & 684_xi, 685_xi, 686_xi, 687_xi, 688_xi, 689_xi, 690_xi, &
490 & 692_xi, 695_xi, 703_xi, 704_xi, 705_xi, 706_xi, 707_xi, &
491 & 894_xi, 895_xi, 896_xi, 897_xi, 898_xi, 899_xi, 900_xi, &
492 & 901_xi, 906_xi, 907_xi, 908_xi, 913_xi, 915_xi, 921_xi, &
493 & 922_xi, 923_xi, 924_xi, 925_xi, 926_xi, 927_xi, 1096_xi, &
494 & 1097_xi, 1098_xi, 1099_xi, 1100_xi, 1101_xi, 1102_xi, 1103_xi, &
495 & 1107_xi, 1108_xi, 1109_xi, 1110_xi, 1111_xi, 1113_xi, 1114_xi, &
496 & 1119_xi, 1120_xi, 1121_xi, 2095_xi, 2096_xi, 2097_xi, 2098_xi, &
497 & 2100_xi, 2102_xi, 2103_xi, 2104_xi, 2105_xi, 2107_xi, 2108_xi, &
498 & 2109_xi, 2110_xi, 2112_xi, 2118_xi, 2120_xi, 2121_xi, 2122_xi, &
499 & 2123_xi, 2124_xi, 2125_xi, 2127_xi, 2128_xi, 2129_xi, 2130_xi, &
500 & 2134_xi, 2140_xi, 2141_xi, 2142_xi, 2143_xi, 2145_xi, 2148_xi, &
501 & 2149_xi, 2151_xi, 2152_xi, 2153_xi, 2154_xi, 2155_xi, 2156_xi, &
502 & 683_xi, 691_xi, 903_xi, 914_xi, 1105_xi, 1115_xi, 2099_xi, &
503 & 2106_xi, 2111_xi, 2115_xi, 2126_xi, 2132_xi, 2139_xi, 2144_xi, &
504 & 2147_xi, 2150_xi, 2305_xi, 427_xi, 465_xi, 466_xi, 678_xi, &
505 & 693_xi, 902_xi, 909_xi, 1104_xi, 1112_xi, 2101_xi, 2113_xi, &
506 & 2114_xi, 2116_xi, 2117_xi, 2119_xi, 2131_xi, 2136_xi, 2138_xi, &
507 & 2146_xi, 2297_xi, 2302_xi, 2304_xi, 2307_xi /)
508 integer, PARAMETER :: num_stripes = 8
509 TYPE(xt_stripe), PARAMETER :: stripes(num_stripes) = (/ &
510 xt_stripe(670, 1, 9), xt_stripe(682, 1, 12), &
511 xt_stripe(695, 8, 1), xt_stripe(703, 1, 5), &
512 xt_stripe(894, 1, 10), xt_stripe(906, 1, 4), &
513 xt_stripe(913, 1, 3), xt_stripe(921, 1, 7) /)
514 TYPE(xt_idxlist) :: idxlist
515
516 idxlist = xt_idxvec_new(index_vector)
517 CALL check_idxlist_stripes_pos_ext(idxlist, stripes)
518 CALL xt_idxlist_delete(idxlist)
519 END SUBROUTINE test_idxlist_stripes_pos_ext2
520
521 SUBROUTINE test_idxlist_stripes_pos_ext3
522 INTEGER, PARAMETER :: num_indices = 1144
523 INTEGER(xt_int_kind), PARAMETER :: index_vector(num_indices) = (/ &
524 2055_xi, 2056_xi, 2060_xi, 2193_xi, 2199_xi, 2203_xi, 2211_xi, 2212_xi, &
525 2278_xi, 2281_xi, 2311_xi, 2312_xi, 2316_xi, 2317_xi, 2322_xi, 2332_xi, &
526 2447_xi, 2448_xi, 2452_xi, 2585_xi, 2591_xi, 2595_xi, 2603_xi, 2604_xi, &
527 2670_xi, 2673_xi, 2703_xi, 2704_xi, 2708_xi, 2709_xi, 2714_xi, 2724_xi, &
528 2839_xi, 2840_xi, 2844_xi, 2977_xi, 2983_xi, 2987_xi, 2995_xi, 2996_xi, &
529 3062_xi, 3065_xi, 3095_xi, 3096_xi, 3100_xi, 3101_xi, 3106_xi, 3116_xi, &
530 3231_xi, 3232_xi, 3236_xi, 3369_xi, 3375_xi, 3379_xi, 3387_xi, 3388_xi, &
531 3454_xi, 3457_xi, 3487_xi, 3488_xi, 3492_xi, 3493_xi, 3498_xi, 3508_xi, &
532 3623_xi, 3624_xi, 3628_xi, 3761_xi, 3767_xi, 3771_xi, 3779_xi, 3780_xi, &
533 3846_xi, 3849_xi, 3879_xi, 3880_xi, 3884_xi, 3885_xi, 3890_xi, 3900_xi, &
534 3997_xi, 4001_xi, 4002_xi, 4053_xi, 4057_xi, 4084_xi, 4085_xi, 4092_xi, &
535 4102_xi, 4188_xi, 4192_xi, 4201_xi, 4373_xi, 4377_xi, 4378_xi, 4429_xi, &
536 4433_xi, 4460_xi, 4461_xi, 4468_xi, 4478_xi, 4564_xi, 4568_xi, 4577_xi, &
537 4749_xi, 4753_xi, 4754_xi, 4805_xi, 4809_xi, 4836_xi, 4837_xi, 4844_xi, &
538 4854_xi, 4945_xi, 4953_xi, 5125_xi, 5129_xi, 5130_xi, 5181_xi, 5185_xi, &
539 5212_xi, 5213_xi, 5220_xi, 5230_xi, 5321_xi, 5329_xi, 5501_xi, 5505_xi, &
540 5506_xi, 5557_xi, 5561_xi, 5588_xi, 5589_xi, 5596_xi, 5606_xi, 5697_xi, &
541 5705_xi, 162_xi, 163_xi, 166_xi, 168_xi, 171_xi, 172_xi, 173_xi, &
542 177_xi, 181_xi, 362_xi, 363_xi, 367_xi, 369_xi, 375_xi, 378_xi, &
543 382_xi, 383_xi, 386_xi, 570_xi, 571_xi, 574_xi, 576_xi, 579_xi, &
544 580_xi, 581_xi, 585_xi, 589_xi, 758_xi, 759_xi, 763_xi, 765_xi, &
545 769_xi, 774_xi, 775_xi, 778_xi, 962_xi, 963_xi, 966_xi, 968_xi, &
546 971_xi, 972_xi, 973_xi, 977_xi, 981_xi, 1150_xi, 1151_xi, 1155_xi, &
547 1157_xi, 1161_xi, 1166_xi, 1167_xi, 1170_xi, 1354_xi, 1355_xi, 1358_xi, &
548 1360_xi, 1363_xi, 1364_xi, 1365_xi, 1369_xi, 1373_xi, 1542_xi, 1543_xi, &
549 1547_xi, 1549_xi, 1553_xi, 1558_xi, 1559_xi, 1562_xi, 1746_xi, 1747_xi, &
550 1750_xi, 1752_xi, 1755_xi, 1756_xi, 1757_xi, 1761_xi, 1918_xi, 1919_xi, &
551 1923_xi, 1925_xi, 1929_xi, 1934_xi, 1935_xi, 1938_xi, 1988_xi, 1989_xi, &
552 2024_xi, 2025_xi, 2032_xi, 2033_xi, 2036_xi, 2038_xi, 2039_xi, 2048_xi, &
553 2049_xi, 2053_xi, 2054_xi, 2057_xi, 2058_xi, 2061_xi, 2076_xi, 2077_xi, &
554 2091_xi, 2092_xi, 2093_xi, 2095_xi, 2097_xi, 2126_xi, 2127_xi, 2144_xi, &
555 2145_xi, 2149_xi, 2150_xi, 2156_xi, 2198_xi, 2204_xi, 2205_xi, 2207_xi, &
556 2245_xi, 2253_xi, 2254_xi, 2256_xi, 2268_xi, 2269_xi, 2277_xi, 2279_xi, &
557 2280_xi, 2283_xi, 2287_xi, 2298_xi, 2299_xi, 2307_xi, 2308_xi, 2309_xi, &
558 2310_xi, 2333_xi, 2334_xi, 2380_xi, 2381_xi, 2416_xi, 2417_xi, 2424_xi, &
559 2425_xi, 2428_xi, 2430_xi, 2431_xi, 2440_xi, 2441_xi, 2445_xi, 2446_xi, &
560 2449_xi, 2450_xi, 2453_xi, 2468_xi, 2469_xi, 2483_xi, 2484_xi, 2485_xi, &
561 2487_xi, 2489_xi, 2518_xi, 2519_xi, 2536_xi, 2537_xi, 2541_xi, 2542_xi, &
562 2548_xi, 2590_xi, 2596_xi, 2597_xi, 2599_xi, 2637_xi, 2645_xi, 2646_xi, &
563 2648_xi, 2660_xi, 2661_xi, 2669_xi, 2671_xi, 2672_xi, 2675_xi, 2679_xi, &
564 2690_xi, 2691_xi, 2699_xi, 2700_xi, 2701_xi, 2702_xi, 2725_xi, 2726_xi, &
565 2772_xi, 2773_xi, 2808_xi, 2809_xi, 2816_xi, 2817_xi, 2820_xi, 2822_xi, &
566 2823_xi, 2832_xi, 2833_xi, 2837_xi, 2838_xi, 2841_xi, 2842_xi, 2845_xi, &
567 2860_xi, 2861_xi, 2875_xi, 2876_xi, 2877_xi, 2879_xi, 2881_xi, 2910_xi, &
568 2911_xi, 2928_xi, 2929_xi, 2933_xi, 2934_xi, 2940_xi, 2982_xi, 2988_xi, &
569 2989_xi, 2991_xi, 3029_xi, 3037_xi, 3038_xi, 3040_xi, 3052_xi, 3053_xi, &
570 3061_xi, 3063_xi, 3064_xi, 3067_xi, 3071_xi, 3082_xi, 3083_xi, 3091_xi, &
571 3092_xi, 3093_xi, 3094_xi, 3117_xi, 3118_xi, 3164_xi, 3165_xi, 3200_xi, &
572 3201_xi, 3208_xi, 3209_xi, 3212_xi, 3214_xi, 3215_xi, 3224_xi, 3225_xi, &
573 3229_xi, 3230_xi, 3233_xi, 3234_xi, 3237_xi, 3252_xi, 3253_xi, 3267_xi, &
574 3268_xi, 3269_xi, 3271_xi, 3273_xi, 3302_xi, 3303_xi, 3320_xi, 3321_xi, &
575 3325_xi, 3326_xi, 3332_xi, 3374_xi, 3380_xi, 3381_xi, 3383_xi, 3421_xi, &
576 3429_xi, 3430_xi, 3432_xi, 3444_xi, 3445_xi, 3453_xi, 3455_xi, 3456_xi, &
577 3459_xi, 3463_xi, 3474_xi, 3475_xi, 3483_xi, 3484_xi, 3485_xi, 3486_xi, &
578 3509_xi, 3510_xi, 3556_xi, 3557_xi, 3592_xi, 3593_xi, 3600_xi, 3601_xi, &
579 3604_xi, 3606_xi, 3607_xi, 3616_xi, 3617_xi, 3621_xi, 3622_xi, 3625_xi, &
580 3626_xi, 3629_xi, 3644_xi, 3645_xi, 3659_xi, 3660_xi, 3661_xi, 3663_xi, &
581 3665_xi, 3694_xi, 3695_xi, 3712_xi, 3713_xi, 3717_xi, 3718_xi, 3724_xi, &
582 3766_xi, 3772_xi, 3773_xi, 3775_xi, 3813_xi, 3821_xi, 3822_xi, 3824_xi, &
583 3836_xi, 3837_xi, 3845_xi, 3847_xi, 3848_xi, 3851_xi, 3855_xi, 3866_xi, &
584 3867_xi, 3875_xi, 3876_xi, 3877_xi, 3878_xi, 3901_xi, 3902_xi, 3948_xi, &
585 3949_xi, 3984_xi, 3985_xi, 3992_xi, 3993_xi, 3996_xi, 3998_xi, 3999_xi, &
586 4008_xi, 4009_xi, 4013_xi, 4014_xi, 4017_xi, 4018_xi, 4021_xi, 4036_xi, &
587 4037_xi, 4051_xi, 4052_xi, 4054_xi, 4055_xi, 4058_xi, 4090_xi, 4091_xi, &
588 4093_xi, 4108_xi, 4109_xi, 4112_xi, 4113_xi, 4114_xi, 4158_xi, 4164_xi, &
589 4165_xi, 4193_xi, 4199_xi, 4200_xi, 4212_xi, 4213_xi, 4222_xi, 4223_xi, &
590 4225_xi, 4227_xi, 4231_xi, 4242_xi, 4243_xi, 4250_xi, 4251_xi, 4271_xi, &
591 4272_xi, 4274_xi, 4324_xi, 4325_xi, 4360_xi, 4361_xi, 4368_xi, 4369_xi, &
592 4372_xi, 4374_xi, 4375_xi, 4384_xi, 4385_xi, 4389_xi, 4390_xi, 4393_xi, &
593 4394_xi, 4397_xi, 4412_xi, 4413_xi, 4427_xi, 4428_xi, 4430_xi, 4431_xi, &
594 4434_xi, 4466_xi, 4467_xi, 4469_xi, 4484_xi, 4485_xi, 4488_xi, 4489_xi, &
595 4490_xi, 4534_xi, 4540_xi, 4541_xi, 4569_xi, 4575_xi, 4576_xi, 4588_xi, &
596 4589_xi, 4598_xi, 4599_xi, 4601_xi, 4603_xi, 4607_xi, 4618_xi, 4619_xi, &
597 4626_xi, 4627_xi, 4647_xi, 4648_xi, 4650_xi, 4700_xi, 4701_xi, 4736_xi, &
598 4737_xi, 4744_xi, 4745_xi, 4748_xi, 4750_xi, 4751_xi, 4760_xi, 4761_xi, &
599 4765_xi, 4766_xi, 4769_xi, 4770_xi, 4773_xi, 4788_xi, 4789_xi, 4803_xi, &
600 4804_xi, 4806_xi, 4807_xi, 4810_xi, 4842_xi, 4843_xi, 4845_xi, 4860_xi, &
601 4861_xi, 4864_xi, 4865_xi, 4866_xi, 4910_xi, 4916_xi, 4917_xi, 4951_xi, &
602 4952_xi, 4964_xi, 4965_xi, 4974_xi, 4975_xi, 4977_xi, 4979_xi, 4983_xi, &
603 4994_xi, 4995_xi, 5002_xi, 5003_xi, 5023_xi, 5024_xi, 5026_xi, 5076_xi, &
604 5077_xi, 5112_xi, 5113_xi, 5120_xi, 5121_xi, 5124_xi, 5126_xi, 5127_xi, &
605 5136_xi, 5137_xi, 5141_xi, 5142_xi, 5145_xi, 5146_xi, 5149_xi, 5164_xi, &
606 5165_xi, 5179_xi, 5180_xi, 5182_xi, 5183_xi, 5186_xi, 5218_xi, 5219_xi, &
607 5221_xi, 5236_xi, 5237_xi, 5240_xi, 5241_xi, 5242_xi, 5286_xi, 5292_xi, &
608 5293_xi, 5327_xi, 5328_xi, 5340_xi, 5341_xi, 5350_xi, 5351_xi, 5353_xi, &
609 5355_xi, 5359_xi, 5370_xi, 5371_xi, 5378_xi, 5379_xi, 5399_xi, 5400_xi, &
610 5402_xi, 5452_xi, 5453_xi, 5488_xi, 5489_xi, 5496_xi, 5497_xi, 5500_xi, &
611 5502_xi, 5503_xi, 5512_xi, 5513_xi, 5517_xi, 5518_xi, 5521_xi, 5522_xi, &
612 5525_xi, 5540_xi, 5541_xi, 5555_xi, 5556_xi, 5558_xi, 5559_xi, 5562_xi, &
613 5594_xi, 5595_xi, 5597_xi, 5612_xi, 5613_xi, 5616_xi, 5617_xi, 5618_xi, &
614 5662_xi, 5668_xi, 5669_xi, 5703_xi, 5704_xi, 5716_xi, 5717_xi, 5726_xi, &
615 5727_xi, 5729_xi, 5731_xi, 5735_xi, 5746_xi, 5747_xi, 5754_xi, 5755_xi, &
616 5775_xi, 5776_xi, 5778_xi, 5958_xi, 5959_xi, 5962_xi, 5964_xi, 5967_xi, &
617 5968_xi, 5971_xi, 5973_xi, 6154_xi, 6155_xi, 6159_xi, 6161_xi, 6167_xi, &
618 6170_xi, 6172_xi, 6173_xi, 6350_xi, 6351_xi, 6354_xi, 6356_xi, 6359_xi, &
619 6360_xi, 6363_xi, 6530_xi, 6531_xi, 6535_xi, 6537_xi, 6543_xi, 6546_xi, &
620 6548_xi, 6549_xi, 6726_xi, 6727_xi, 6730_xi, 6732_xi, 6735_xi, 6736_xi, &
621 6739_xi, 6906_xi, 6907_xi, 6911_xi, 6913_xi, 6919_xi, 6922_xi, 6924_xi, &
622 6925_xi, 7102_xi, 7103_xi, 7106_xi, 7108_xi, 7111_xi, 7112_xi, 7115_xi, &
623 7282_xi, 7283_xi, 7287_xi, 7289_xi, 7295_xi, 7298_xi, 7300_xi, 7301_xi, &
624 7478_xi, 7479_xi, 7482_xi, 7484_xi, 7487_xi, 7488_xi, 7491_xi, 7646_xi, &
625 7647_xi, 7651_xi, 7653_xi, 7657_xi, 7660_xi, 7661_xi, 130_xi, 161_xi, &
626 169_xi, 170_xi, 336_xi, 361_xi, 366_xi, 384_xi, 538_xi, 569_xi, &
627 577_xi, 578_xi, 736_xi, 757_xi, 762_xi, 776_xi, 930_xi, 961_xi, &
628 969_xi, 970_xi, 1128_xi, 1149_xi, 1154_xi, 1168_xi, 1322_xi, 1353_xi, &
629 1361_xi, 1362_xi, 1520_xi, 1541_xi, 1546_xi, 1560_xi, 1714_xi, 1745_xi, &
630 1753_xi, 1754_xi, 1896_xi, 1917_xi, 1922_xi, 1936_xi, 1985_xi, 2019_xi, &
631 2031_xi, 2035_xi, 2040_xi, 2044_xi, 2052_xi, 2059_xi, 2062_xi, 2071_xi, &
632 2087_xi, 2090_xi, 2094_xi, 2140_xi, 2148_xi, 2153_xi, 2157_xi, 2206_xi, &
633 2257_xi, 2263_xi, 2267_xi, 2284_xi, 2288_xi, 2293_xi, 2295_xi, 2305_xi, &
634 2306_xi, 2377_xi, 2411_xi, 2423_xi, 2427_xi, 2432_xi, 2436_xi, 2444_xi, &
635 2451_xi, 2454_xi, 2463_xi, 2479_xi, 2482_xi, 2486_xi, 2532_xi, 2540_xi, &
636 2545_xi, 2549_xi, 2598_xi, 2649_xi, 2655_xi, 2659_xi, 2676_xi, 2680_xi, &
637 2685_xi, 2687_xi, 2697_xi, 2698_xi, 2769_xi, 2803_xi, 2815_xi, 2819_xi, &
638 2824_xi, 2828_xi, 2836_xi, 2843_xi, 2846_xi, 2855_xi, 2871_xi, 2874_xi, &
639 2878_xi, 2924_xi, 2932_xi, 2937_xi, 2941_xi, 2990_xi, 3041_xi, 3047_xi, &
640 3051_xi, 3068_xi, 3072_xi, 3077_xi, 3079_xi, 3089_xi, 3090_xi, 3161_xi, &
641 3195_xi, 3207_xi, 3211_xi, 3216_xi, 3220_xi, 3228_xi, 3235_xi, 3238_xi, &
642 3247_xi, 3263_xi, 3266_xi, 3270_xi, 3316_xi, 3324_xi, 3329_xi, 3333_xi, &
643 3382_xi, 3433_xi, 3439_xi, 3443_xi, 3460_xi, 3464_xi, 3469_xi, 3471_xi, &
644 3481_xi, 3482_xi, 3553_xi, 3587_xi, 3599_xi, 3603_xi, 3608_xi, 3612_xi, &
645 3620_xi, 3627_xi, 3630_xi, 3639_xi, 3655_xi, 3658_xi, 3662_xi, 3708_xi, &
646 3716_xi, 3721_xi, 3725_xi, 3774_xi, 3825_xi, 3831_xi, 3835_xi, 3852_xi, &
647 3856_xi, 3861_xi, 3863_xi, 3873_xi, 3874_xi, 3945_xi, 3979_xi, 3991_xi, &
648 3995_xi, 4000_xi, 4004_xi, 4012_xi, 4019_xi, 4022_xi, 4031_xi, 4033_xi, &
649 4047_xi, 4050_xi, 4104_xi, 4106_xi, 4115_xi, 4207_xi, 4221_xi, 4228_xi, &
650 4232_xi, 4237_xi, 4249_xi, 4252_xi, 4321_xi, 4355_xi, 4367_xi, 4371_xi, &
651 4376_xi, 4380_xi, 4388_xi, 4395_xi, 4398_xi, 4407_xi, 4409_xi, 4423_xi, &
652 4426_xi, 4480_xi, 4482_xi, 4491_xi, 4583_xi, 4597_xi, 4604_xi, 4608_xi, &
653 4613_xi, 4625_xi, 4628_xi, 4697_xi, 4731_xi, 4743_xi, 4747_xi, 4752_xi, &
654 4756_xi, 4764_xi, 4771_xi, 4774_xi, 4783_xi, 4785_xi, 4799_xi, 4802_xi, &
655 4856_xi, 4858_xi, 4867_xi, 4959_xi, 4973_xi, 4980_xi, 4984_xi, 4989_xi, &
656 5001_xi, 5004_xi, 5073_xi, 5107_xi, 5119_xi, 5123_xi, 5128_xi, 5132_xi, &
657 5140_xi, 5147_xi, 5150_xi, 5159_xi, 5161_xi, 5175_xi, 5178_xi, 5232_xi, &
658 5234_xi, 5243_xi, 5335_xi, 5349_xi, 5356_xi, 5360_xi, 5365_xi, 5377_xi, &
659 5380_xi, 5449_xi, 5483_xi, 5495_xi, 5499_xi, 5504_xi, 5508_xi, 5516_xi, &
660 5523_xi, 5526_xi, 5535_xi, 5537_xi, 5551_xi, 5554_xi, 5608_xi, 5610_xi, &
661 5619_xi, 5711_xi, 5725_xi, 5732_xi, 5736_xi, 5741_xi, 5753_xi, 5756_xi, &
662 5930_xi, 5957_xi, 5965_xi, 5966_xi, 6128_xi, 6153_xi, 6158_xi, 6174_xi, &
663 6322_xi, 6349_xi, 6357_xi, 6358_xi, 6504_xi, 6529_xi, 6534_xi, 6550_xi, &
664 6698_xi, 6725_xi, 6733_xi, 6734_xi, 6880_xi, 6905_xi, 6910_xi, 6926_xi, &
665 7074_xi, 7101_xi, 7109_xi, 7110_xi, 7256_xi, 7281_xi, 7286_xi, 7302_xi, &
666 7450_xi, 7477_xi, 7485_xi, 7486_xi, 7624_xi, 7645_xi, 7650_xi, 7662_xi /)
667 INTEGER, PARAMETER :: num_stripes = 187
668 TYPE(xt_stripe), PARAMETER :: stripes(num_stripes) = (/ &
669 xt_stripe(173, 408, 2), xt_stripe(973, 392, 3), xt_stripe(1985, 4, 2), &
670 xt_stripe(2044, 4, 2), xt_stripe(2049, 3, 1), xt_stripe(2052, 1, 9), &
671 xt_stripe(2062, 131, 2), xt_stripe(2198, 1, 2), xt_stripe(2203, 1, 5), &
672 xt_stripe(2211, 1, 2), xt_stripe(2263, 4, 1), xt_stripe(2267, 1, 3), &
673 xt_stripe(2277, 1, 5), xt_stripe(2283, 1, 2), xt_stripe(2287, 1, 2), &
674 xt_stripe(2293, 2, 2), xt_stripe(2298, 1, 2), xt_stripe(2305, 1, 8), &
675 xt_stripe(2316, 1, 2), xt_stripe(2322, 10, 1), xt_stripe(2332, 1, 3), &
676 xt_stripe(2377, 4, 2), xt_stripe(2436, 4, 2), xt_stripe(2441, 3, 1), &
677 xt_stripe(2444, 1, 9), xt_stripe(2454, 131, 2), xt_stripe(2590, 1, 2), &
678 xt_stripe(2595, 1, 5), xt_stripe(2603, 1, 2), xt_stripe(2655, 4, 1), &
679 xt_stripe(2659, 1, 3), xt_stripe(2669, 1, 5), xt_stripe(2675, 1, 2), &
680 xt_stripe(2679, 1, 2), xt_stripe(2685, 2, 2), xt_stripe(2690, 1, 2), &
681 xt_stripe(2697, 1, 8), xt_stripe(2708, 1, 2), xt_stripe(2714, 10, 1), &
682 xt_stripe(2724, 1, 3), xt_stripe(2769, 4, 2), xt_stripe(2828, 4, 2), &
683 xt_stripe(2833, 3, 1), xt_stripe(2836, 1, 9), xt_stripe(2846, 131, 2), &
684 xt_stripe(2982, 1, 2), xt_stripe(2987, 1, 5), xt_stripe(2995, 1, 2), &
685 xt_stripe(3047, 4, 1), xt_stripe(3051, 1, 3), xt_stripe(3061, 1, 5), &
686 xt_stripe(3067, 1, 2), xt_stripe(3071, 1, 2), xt_stripe(3077, 2, 2), &
687 xt_stripe(3082, 1, 2), xt_stripe(3089, 1, 8), xt_stripe(3100, 1, 2), &
688 xt_stripe(3106, 10, 1), xt_stripe(3116, 1, 3), xt_stripe(3161, 4, 2), &
689 xt_stripe(3220, 4, 2), xt_stripe(3225, 3, 1), xt_stripe(3228, 1, 9), &
690 xt_stripe(3238, 131, 2), xt_stripe(3374, 1, 2), xt_stripe(3379, 1, 5), &
691 xt_stripe(3387, 1, 2), xt_stripe(3439, 4, 1), xt_stripe(3443, 1, 3), &
692 xt_stripe(3453, 1, 5), xt_stripe(3459, 1, 2), xt_stripe(3463, 1, 2), &
693 xt_stripe(3469, 2, 2), xt_stripe(3474, 1, 2), xt_stripe(3481, 1, 8), &
694 xt_stripe(3492, 1, 2), xt_stripe(3498, 10, 1), xt_stripe(3508, 1, 3), &
695 xt_stripe(3553, 4, 2), xt_stripe(3612, 4, 2), xt_stripe(3617, 3, 1), &
696 xt_stripe(3620, 1, 9), xt_stripe(3630, 131, 2), xt_stripe(3766, 1, 2), &
697 xt_stripe(3771, 1, 5), xt_stripe(3779, 1, 2), xt_stripe(3831, 4, 1), &
698 xt_stripe(3835, 1, 3), xt_stripe(3845, 1, 5), xt_stripe(3851, 1, 2), &
699 xt_stripe(3855, 1, 2), xt_stripe(3861, 2, 2), xt_stripe(3866, 1, 2), &
700 xt_stripe(3873, 1, 8), xt_stripe(3884, 1, 2), xt_stripe(3890, 10, 1), &
701 xt_stripe(3900, 1, 3), xt_stripe(3945, 3, 2), xt_stripe(3979, 5, 2), &
702 xt_stripe(3985, 6, 1), xt_stripe(3991, 1, 3), xt_stripe(3995, 2, 1), &
703 xt_stripe(3997, 1, 6), xt_stripe(4031, 2, 2), xt_stripe(4036, 1, 2), &
704 xt_stripe(4047, 3, 1), xt_stripe(4050, 1, 6), xt_stripe(4057, 1, 2), &
705 xt_stripe(4084, 1, 2), xt_stripe(4090, 1, 4), xt_stripe(4102, 2, 4), &
706 xt_stripe(4109, 3, 1), xt_stripe(4112, 1, 4), xt_stripe(4188, 4, 2), &
707 xt_stripe(4193, 6, 1), xt_stripe(4199, 1, 3), xt_stripe(4321, 3, 2), &
708 xt_stripe(4355, 5, 2), xt_stripe(4361, 6, 1), xt_stripe(4367, 1, 3), &
709 xt_stripe(4371, 2, 1), xt_stripe(4373, 1, 6), xt_stripe(4407, 2, 2), &
710 xt_stripe(4412, 1, 2), xt_stripe(4423, 3, 1), xt_stripe(4426, 1, 6), &
711 xt_stripe(4433, 1, 2), xt_stripe(4460, 1, 2), xt_stripe(4466, 1, 4), &
712 xt_stripe(4478, 2, 4), xt_stripe(4485, 3, 1), xt_stripe(4488, 1, 4), &
713 xt_stripe(4564, 4, 2), xt_stripe(4569, 6, 1), xt_stripe(4575, 1, 3), &
714 xt_stripe(4697, 3, 2), xt_stripe(4731, 5, 2), xt_stripe(4737, 6, 1), &
715 xt_stripe(4743, 1, 3), xt_stripe(4747, 2, 1), xt_stripe(4749, 1, 6), &
716 xt_stripe(4783, 2, 2), xt_stripe(4788, 1, 2), xt_stripe(4799, 3, 1), &
717 xt_stripe(4802, 1, 6), xt_stripe(4809, 1, 2), xt_stripe(4836, 1, 2), &
718 xt_stripe(4842, 1, 4), xt_stripe(4854, 2, 4), xt_stripe(4861, 3, 1), &
719 xt_stripe(4864, 1, 4), xt_stripe(4945, 6, 1), xt_stripe(4951, 1, 3), &
720 xt_stripe(5107, 5, 2), xt_stripe(5113, 6, 1), xt_stripe(5119, 1, 3), &
721 xt_stripe(5123, 2, 1), xt_stripe(5125, 1, 6), xt_stripe(5159, 2, 2), &
722 xt_stripe(5164, 1, 2), xt_stripe(5175, 3, 1), xt_stripe(5178, 1, 6), &
723 xt_stripe(5185, 1, 2), xt_stripe(5212, 1, 2), xt_stripe(5218, 1, 4), &
724 xt_stripe(5230, 2, 4), xt_stripe(5237, 3, 1), xt_stripe(5240, 1, 4), &
725 xt_stripe(5321, 6, 1), xt_stripe(5327, 1, 3), xt_stripe(5483, 5, 2), &
726 xt_stripe(5489, 6, 1), xt_stripe(5495, 1, 3), xt_stripe(5499, 2, 1), &
727 xt_stripe(5501, 1, 6), xt_stripe(5535, 2, 2), xt_stripe(5540, 1, 2), &
728 xt_stripe(5551, 3, 1), xt_stripe(5554, 1, 6), xt_stripe(5561, 1, 2), &
729 xt_stripe(5588, 1, 2), xt_stripe(5594, 1, 4), xt_stripe(5606, 2, 4), &
730 xt_stripe(5613, 3, 1), xt_stripe(5616, 1, 4), xt_stripe(5697, 6, 1), &
731 xt_stripe(5703, 1, 3) /)
732 TYPE(xt_idxlist) :: idxlist
733
734 idxlist = xt_idxvec_new(index_vector)
735 CALL check_idxlist_stripes_pos_ext(idxlist, stripes)
736 CALL xt_idxlist_delete(idxlist)
737 END SUBROUTINE test_idxlist_stripes_pos_ext3
738
739#if SIZEOF_XT_INT > 2
740 SUBROUTINE test_idxlist_stripes_pos_ext4
741 INTEGER, PARAMETER :: num_indices = 3
742 INTEGER(xt_int_kind), PARAMETER :: index_vector(num_indices) &
743 = (/ 328669_xi, 30608_xi, 38403_xi /)
744 INTEGER, PARAMETER :: num_stripes = 1
745 TYPE(xt_stripe), PARAMETER :: stripes(num_stripes) = (/ &
746 xt_stripe(30608_xi, 7795_xi, 2)/)
747 TYPE(xt_idxlist) :: idxlist
748
749 idxlist = xt_idxvec_new(index_vector)
750 CALL check_idxlist_stripes_pos_ext(idxlist, stripes)
751 CALL xt_idxlist_delete(idxlist)
752 END SUBROUTINE test_idxlist_stripes_pos_ext4
753
754 SUBROUTINE test_idxlist_stripes_pos_ext5
755 INTEGER, PARAMETER :: num_indices = 3
756 INTEGER(xt_int_kind), PARAMETER :: index_vector(num_indices) &
757 = (/ 679605_xi, 726349_xi, 726346_xi /)
758 INTEGER, PARAMETER :: num_stripes = 1
759 TYPE(xt_stripe), PARAMETER :: stripes(num_stripes) = (/ &
760 xt_stripe(679605_xi, 46741_xi, 2)/)
761 TYPE(xt_idxlist) :: idxlist
762
763 idxlist = xt_idxvec_new(index_vector)
764 CALL check_idxlist_stripes_pos_ext(idxlist, stripes)
765 CALL xt_idxlist_delete(idxlist)
766 END SUBROUTINE test_idxlist_stripes_pos_ext5
767#endif
768
769 SUBROUTINE test_idxlist_stripes_pos_ext_randomized1(full_random)
770 LOGICAL, INTENT(in) :: full_random
771 INTEGER, PARAMETER :: num_iterations=128, &
772 max_num_indices=1024, max_index=1024
773
774 INTEGER :: i, iteration, num_indices
775 INTEGER(xt_int_kind), ALLOCATABLE :: indices(:)
776 REAL, ALLOCATABLE :: rvals(:)
777 TYPE(xt_idxlist) :: idxlist
778 TYPE(xt_stripe), ALLOCATABLE :: stripes(:)
779 TYPE(xt_stripe) :: stripes_dummy(1)
780
781 CALL init_fortran_random(full_random)
782 ALLOCATE(indices(max_num_indices), rvals(max_num_indices))
783 DO iteration = 1, num_iterations
784 CALL random_number(rvals(1))
785 num_indices = nint(rvals(1) * real(max_num_indices))
786
787 CALL random_number(rvals(1:num_indices))
788 DO i = 1, num_indices
789 indices(i) = nint(rvals(i)*real((2*max_index)-max_index), xt_int_kind)
790 END DO
791 idxlist = xt_idxvec_new(indices(1:num_indices))
792
793 CALL xt_idxlist_get_index_stripes(idxlist, stripes)
794 IF (ALLOCATED(stripes) .EQV. num_indices == 0) &
795 CALL test_abort("get index stripes returned values for empty list", &
796 filename, __line__)
797 IF (num_indices > 0) THEN
798 CALL check_idxlist_stripes_pos_ext(idxlist, stripes)
799 ELSE
800 CALL check_idxlist_stripes_pos_ext(idxlist, stripes_dummy(1:0))
801 END IF
802
803 CALL xt_idxlist_delete(idxlist)
804 END DO
805 END SUBROUTINE test_idxlist_stripes_pos_ext_randomized1
806
807 SUBROUTINE check_idxlist_stripes_pos_ext(idxlist, stripes)
808 TYPE(xt_idxlist), INTENT(in) :: idxlist
809 TYPE(xt_stripe), INTENT(in) :: stripes(:)
810
811 TYPE(xt_pos_ext), ALLOCATABLE :: pos_ext(:)
812 INTEGER :: num_stripes, num_ext, num_unmatched
813 INTEGER :: abs_pos_ext_size, jsign, i, j, k, send_pos
814 INTEGER(xt_int_kind) :: intersection_index, orig_index
815 LOGICAL, PARAMETER :: single_match_only = .true.
816 LOGICAL :: unmatched_in_intersection, unmatched_in_idxlist
817 TYPE(xt_idxlist) :: intersection
818 num_stripes = SIZE(stripes)
819
821 idxlist, num_stripes, stripes, num_ext, pos_ext, single_match_only)
822
823 ! testing of results
824 IF (num_unmatched /= 0) &
825 CALL test_abort("error in xt_idxlist_get_pos_exts_of_index_stripes", &
826 filename, __line__)
827 intersection = xt_idxvec_from_stripes_new(stripes)
828 k = 0
829 DO i = 1, num_ext
830 abs_pos_ext_size = int(abs(pos_ext(i)%size))
831 jsign = merge(1, -1, pos_ext(i)%size >= 0)
832 DO j = 0, abs_pos_ext_size-1
833 unmatched_in_intersection &
834 = xt_idxlist_get_index_at_position(intersection, k, &
835 intersection_index)
836 send_pos = pos_ext(i)%start + jsign * j
837 unmatched_in_idxlist &
838 = xt_idxlist_get_index_at_position(idxlist, send_pos, orig_index)
839 IF (unmatched_in_intersection .OR. unmatched_in_idxlist &
840 .OR. intersection_index /= orig_index) THEN
841 WRITE (0, '(4(a,i0))') "intersection pos ", k, &
842 " index ", intersection_index, &
843 " orig pos ", send_pos, &
844 " index ", orig_index
845 CALL test_abort("error in xt_idxlist_get_pos_exts_of_index_stripes", &
846 filename, __line__)
847 END IF
848 k = k + 1
849 END DO
850 END DO
851 CALL xt_idxlist_delete(intersection)
852 END SUBROUTINE check_idxlist_stripes_pos_ext
853
854 SUBROUTINE test_get_pos(stripes, pos)
855 TYPE(xt_stripe), INTENT(in) :: stripes(:)
856 INTEGER, INTENT(in) :: pos(:)
857 INTEGER(xt_int_kind), PARAMETER :: dummy = 1_xi
858 INTEGER(xt_int_kind) :: ref_sel_idx(SIZE(pos)), sel_idx(SIZE(pos))
859 INTEGER(xt_int_kind), PARAMETER :: undef_idx = -huge(dummy)
860 INTEGER :: num_pos, ip, p, ref_undef_count, undef_count
861 TYPE(xt_idxlist) :: idxlist
862 idxlist = xt_idxstripes_new(stripes)
863 num_pos = SIZE(pos)
864 ref_undef_count = 0
865 DO ip = 1, num_pos
866 p = pos(ip)
867 IF (xt_idxlist_get_index_at_position(idxlist, p, ref_sel_idx(ip))) THEN
868 ref_sel_idx(ip) = undef_idx
869 ref_undef_count = ref_undef_count + 1
870 END IF
871 END DO
872 undef_count = xt_idxlist_get_indices_at_positions(idxlist, pos, sel_idx, &
873 undef_idx)
874 IF (undef_count /= ref_undef_count) &
875 CALL test_abort("inequal undef count!", filename, __line__)
876 IF (any(sel_idx /= ref_sel_idx)) &
877 CALL test_abort("incorrect index returned for position!", &
878 filename, __line__)
879 CALL xt_idxlist_delete(idxlist)
880 END SUBROUTINE test_get_pos
881
882 SUBROUTINE test_get_pos1
883 TYPE(xt_stripe), PARAMETER :: stripes(3) = (/ xt_stripe(0, 1, 5), &
884 xt_stripe(10, 1, 5), xt_stripe(20, -1, 5) /)
885 INTEGER, PARAMETER :: pos(13) = &
886 (/ 0, 2, 7, 9, 11, &
887 & 100, 11, 200, 9, 300, &
888 & 18, 400, 5 /)
889 call test_get_pos(stripes, pos)
890 END SUBROUTINE test_get_pos1
891
892 SUBROUTINE test_get_pos2
893 TYPE(xt_stripe), PARAMETER :: stripes(4) = (/ xt_stripe(0, 1, 3), &
894 xt_stripe(10, 1, 2), xt_stripe(20, -1, 6), xt_stripe(30, -1, 7) /)
895 INTEGER, PARAMETER :: pos(19) = &
896 (/ -1, 0, 1, 2, 3, 4, 23, 5, 6, 7, &
897 & 8, 9, 10, 11, 12, 0, 2, 100, 2000 /)
898 call test_get_pos(stripes, pos)
899 END SUBROUTINE test_get_pos2
900
901 SUBROUTINE test_get_pos3
902 TYPE(xt_stripe), PARAMETER :: stripes(4) = (/ xt_stripe(0, 1, 3), &
903 xt_stripe(10, 1, 2), xt_stripe(20, -1, 6), xt_stripe(30, -1, 7) /)
904 INTEGER, PARAMETER :: pos(13) = &
905 (/ 4, 7, 2, 5, 9, 0, 10, 6, 11, 8, &
906 & 12, 1, 3 /)
907 call test_get_pos(stripes, pos)
908 END SUBROUTINE test_get_pos3
909
910 SUBROUTINE test_get_pos4
911 TYPE(xt_stripe), PARAMETER :: stripes(3) = (/ xt_stripe(0, 1, 5), &
912 xt_stripe(10, 1, 5), xt_stripe(20, -1, 5) /)
913 INTEGER, PARAMETER :: pos(7) = &
914 (/ -10, 200, 700, 90, 90, 18, 141 /)
915 CALL test_get_pos(stripes, pos)
916 END SUBROUTINE test_get_pos4
917
918 SUBROUTINE test_stripe_overlap
919 TYPE(xt_stripe), PARAMETER :: stripes(2) = (/ xt_stripe(0, 1, 5), &
920 xt_stripe(1, 1, 5) /)
921#ifndef __G95__
922 INTEGER(xi) :: i, j
923 INTEGER(xt_int_kind), PARAMETER :: ref_indices(10) &
924 = (/ ((i + j, i=0,4), j = 0, 1) /)
925#else
926 INTEGER :: i, j
927 INTEGER(xt_int_kind), PARAMETER :: ref_indices(10) &
928 = (/ ((int(i + j, xi), i=0,4), j = 0, 1) /)
929#endif
930 CALL stripe_test_general(stripes, ref_indices)
931 END SUBROUTINE test_stripe_overlap
932
933 SUBROUTINE test_stripe_bb(stripes, global_size, global_start_index, bounds_ref)
934 TYPE(xt_stripe), INTENT(in) :: stripes(:)
935 INTEGER(xt_int_kind), INTENT(in) :: global_size(:), global_start_index
936 TYPE(xt_bounds), INTENT(in) :: bounds_ref(:)
937
938 TYPE(xt_bounds) :: bounds(SIZE(global_size))
939 TYPE(xt_idxlist) :: idxstripes
940
941 IF (SIZE(global_size) /= SIZE(bounds_ref)) &
942 CALL test_abort("size mismatch for bounding-box", filename, __line__)
943 idxstripes = xt_idxstripes_new(stripes, SIZE(stripes))
944
945 bounds = xt_idxlist_get_bounding_box(idxstripes, global_size, &
946 global_start_index)
947 IF (any(bounds /= bounds_ref)) &
948 CALL test_abort("boundary box doesn't match reference", &
949 filename, __line__)
950 CALL xt_idxlist_delete(idxstripes)
951 END SUBROUTINE test_stripe_bb
952
953 SUBROUTINE test_stripe_bb1
954 TYPE(xt_stripe), PARAMETER :: stripes(1) = (/ xt_stripe(-1, -1, -1) /)
955 INTEGER(xt_int_kind), PARAMETER :: global_size(3) = 4_xi, &
956 global_start_index = 0
957 TYPE(xt_bounds), PARAMETER :: bounds_ref(3) = xt_bounds(0, 0)
958 CALL test_stripe_bb(stripes(1:0), global_size, global_start_index, bounds_ref)
959 END SUBROUTINE test_stripe_bb1
960
961 SUBROUTINE test_stripe_bb2
962 TYPE(xt_stripe), PARAMETER :: stripes(3) = (/ xt_stripe(47, -12, 2), &
963 xt_stripe(32, 12, 2), xt_stripe(36, 12, 2) /)
964 INTEGER(xt_int_kind), PARAMETER :: global_size(3) = (/ 5_xi, 4_xi, 3_xi /), &
965 global_start_index = 1
966 TYPE(xt_bounds), PARAMETER :: bounds_ref(3) = (/ xt_bounds(2, 2), &
967 xt_bounds(2, 2), xt_bounds(1, 2) /)
968 CALL test_stripe_bb(stripes, global_size, global_start_index, bounds_ref)
969 END SUBROUTINE test_stripe_bb2
970
971 SUBROUTINE do_tests(idxlist, ref_indices)
972 TYPE(xt_idxlist), INTENT(in) :: idxlist
973 INTEGER(xt_int_kind), INTENT(in) :: ref_indices(:)
974
975 TYPE(xt_stripe), ALLOCATABLE :: stripes(:)
976 TYPE(xt_stripe), PARAMETER :: dummy(1) = (/ xt_stripe(0,0,0) /)
977 INTEGER :: num_stripes
978 TYPE(xt_idxlist) :: temp_idxlist, idxlist_copy
979
980 CALL check_idxlist(idxlist, ref_indices)
981 CALL xt_idxlist_get_index_stripes(idxlist, stripes)
982 IF (ALLOCATED(stripes)) THEN
983 num_stripes = SIZE(stripes)
984 temp_idxlist = xt_idxvec_from_stripes_new(stripes, num_stripes)
985 ELSE
986 num_stripes = 0
987 temp_idxlist = xt_idxvec_from_stripes_new(dummy, num_stripes)
988 END IF
989 CALL check_idxlist(temp_idxlist, ref_indices)
990
991 CALL xt_idxlist_delete(temp_idxlist)
992
993 IF (ALLOCATED(stripes)) DEALLOCATE(stripes)
994
995 ! test packing and unpacking
996 idxlist_copy = idxlist_pack_unpack_copy(idxlist)
997
998 ! check copy
999 CALL check_idxlist(idxlist_copy, ref_indices)
1000
1001 CALL xt_idxlist_delete(idxlist_copy)
1002
1003 ! test copying
1004 idxlist_copy = xt_idxlist_copy(idxlist)
1005
1006 ! check copy
1007 CALL check_idxlist(idxlist_copy, ref_indices)
1008
1009 ! clean up
1010 CALL xt_idxlist_delete(idxlist_copy)
1011 END SUBROUTINE do_tests
1012
1013 SUBROUTINE check_pos_ext(stripes, search_stripes, ref_pos_ext, &
1014 single_match_only, ref_unmatched, test_desc)
1015 TYPE(xt_stripe), INTENT(in) :: stripes(:), search_stripes(:)
1016 TYPE(xt_pos_ext), intent(in) :: ref_pos_ext(:)
1017 LOGICAL, INTENT(in) :: single_match_only
1018 INTEGER, INTENT(in) :: ref_unmatched
1019 CHARACTER(len=*) :: test_desc
1020
1021 INTEGER :: num_search_stripes, num_ref_pos_ext, num_ext, &
1022 unmatched
1023 TYPE(xt_idxlist) :: idxstripes
1024 TYPE(xt_pos_ext), ALLOCATABLE :: pos_ext(:)
1025
1026 num_search_stripes = SIZE(search_stripes)
1027 num_ref_pos_ext = SIZE(ref_pos_ext)
1028
1029 idxstripes = xt_idxstripes_new(stripes)
1030 unmatched = xt_idxlist_get_pos_exts_of_index_stripes(idxstripes, &
1031 num_search_stripes, search_stripes, &
1032 num_ext, pos_ext, single_match_only)
1033 IF (unmatched /= ref_unmatched) &
1034 CALL test_abort("error in number of unmatched indices for " &
1035 // test_desc, filename, __line__)
1036 IF (num_ext < 0 .OR. num_ext /= num_ref_pos_ext) &
1037 CALL test_abort("error finding " // test_desc, filename, __line__)
1038 IF (any(pos_ext /= ref_pos_ext)) &
1039 CALL test_abort("incorrect position extent length found in "&
1040 // test_desc, filename, __line__)
1041 DEALLOCATE(pos_ext)
1042 CALL xt_idxlist_delete(idxstripes)
1043 END SUBROUTINE check_pos_ext
1044
1045 SUBROUTINE check_pos_ext1
1046 INTEGER, PARAMETER :: num_stripes = 1, num_ref_pos_ext = 1, &
1047 num_ref_unmatched = 0
1048
1049 TYPE(Xt_stripe), PARAMETER :: stripes(num_stripes) &
1050 = (/ xt_stripe(1_xi, 1_xi, 10) /), &
1051 search_stripes(1) = (/ xt_stripe(10_xi, -1_xi, 5) /)
1052
1053 TYPE(xt_pos_ext), PARAMETER :: ref_pos_ext(num_ref_pos_ext) &
1054 = (/ xt_pos_ext(9, -5) /)
1055
1056 CALL check_pos_ext(stripes, search_stripes, ref_pos_ext, .true., &
1057 num_ref_unmatched, "simple inverted stripe")
1058 END SUBROUTINE check_pos_ext1
1059
1060 SUBROUTINE check_pos_ext2
1061 INTEGER, PARAMETER :: num_stripes = 1, num_ref_pos_ext = 1, &
1062 num_ref_unmatched = 5
1063
1064 TYPE(Xt_stripe), PARAMETER :: stripes(num_stripes) &
1065 = (/ xt_stripe(1_xi, 1_xi, 10) /), &
1066 search_stripes(2) = xt_stripe(10_xi, -1_xi, 5)
1067
1068 TYPE(xt_pos_ext), PARAMETER :: ref_pos_ext(num_ref_pos_ext) &
1069 = (/ xt_pos_ext(9, -5) /)
1070
1071 CALL check_pos_ext(stripes, search_stripes, ref_pos_ext, .true., &
1072 num_ref_unmatched, "simple inverted stripe")
1073 END SUBROUTINE check_pos_ext2
1074
1075 SUBROUTINE check_pos_ext3
1076 INTEGER, PARAMETER :: num_stripes = 2, num_ref_pos_ext = 1, &
1077 num_ref_unmatched = 4
1078
1079 TYPE(Xt_stripe), PARAMETER :: stripes(num_stripes) &
1080 = (/ xt_stripe(1_xi, 1_xi, 10), xt_stripe(15_xi, 1_xi, 10) /), &
1081 search_stripes(1) = xt_stripe(10_xi, 1_xi, 6)
1082
1083 TYPE(xt_pos_ext), PARAMETER :: ref_pos_ext(num_ref_pos_ext) &
1084 = (/ xt_pos_ext(9, 2) /)
1085
1086 CALL check_pos_ext(stripes, search_stripes, ref_pos_ext, .true., &
1087 num_ref_unmatched, "search inc stripe over inc gap")
1088 END SUBROUTINE check_pos_ext3
1089
1090 SUBROUTINE check_pos_ext4
1091 INTEGER, PARAMETER :: num_stripes = 2, num_ref_pos_ext = 1, &
1092 num_ref_unmatched = 4
1093
1094 TYPE(Xt_stripe), PARAMETER :: stripes(num_stripes) &
1095 = (/ xt_stripe(25_xi, -1_xi, 11), xt_stripe(10_xi, -1_xi, 10) /), &
1096 search_stripes(1) = xt_stripe(10_xi, 1_xi, 6)
1097
1098 TYPE(xt_pos_ext), PARAMETER :: ref_pos_ext(num_ref_pos_ext) &
1099 = (/ xt_pos_ext(11, -2) /)
1100
1101 CALL check_pos_ext(stripes, search_stripes, ref_pos_ext, .true., &
1102 num_ref_unmatched, "search inc stripe over dec gap")
1103 END SUBROUTINE check_pos_ext4
1104
1105 SUBROUTINE check_pos_ext5
1106 INTEGER, PARAMETER :: num_stripes = 2, num_ref_pos_ext = 1, &
1107 num_ref_unmatched = 4
1108
1109 TYPE(Xt_stripe), PARAMETER :: stripes(num_stripes) &
1110 = (/ xt_stripe(25_xi, -1_xi, 11), xt_stripe(10_xi, -1_xi, 10) /), &
1111 search_stripes(1) = xt_stripe(15_xi, -1_xi, 6)
1112
1113 TYPE(xt_pos_ext), PARAMETER :: ref_pos_ext(num_ref_pos_ext) &
1114 = (/ xt_pos_ext(10, 2) /)
1115
1116 CALL check_pos_ext(stripes, search_stripes, ref_pos_ext, .true., &
1117 num_ref_unmatched, "search dec stripe over dec gap")
1118 END SUBROUTINE check_pos_ext5
1119
1120 SUBROUTINE check_pos_ext6
1121 INTEGER, PARAMETER :: num_stripes = 2, num_ref_pos_ext = 1, &
1122 num_ref_unmatched = 4
1123
1124 TYPE(Xt_stripe), PARAMETER :: stripes(num_stripes) &
1125 = (/ xt_stripe(1_xi, 1_xi, 10), xt_stripe(15_xi, 1_xi, 10) /), &
1126 search_stripes(1) = xt_stripe(15_xi, -1_xi, 6)
1127
1128 TYPE(xt_pos_ext), PARAMETER :: ref_pos_ext(num_ref_pos_ext) &
1129 = (/ xt_pos_ext(10, -2) /)
1130
1131 CALL check_pos_ext(stripes, search_stripes, ref_pos_ext, .true., &
1132 num_ref_unmatched, "search dec stripe over inc gap")
1133 END SUBROUTINE check_pos_ext6
1134
1135 SUBROUTINE check_pos_ext7
1136 INTEGER, PARAMETER :: num_stripes = 3, num_ref_pos_ext = 1, &
1137 num_ref_unmatched = 8
1138
1139 TYPE(Xt_stripe), PARAMETER :: stripes(num_stripes) &
1140 = (/ xt_stripe(1_xi, 1_xi, 10), xt_stripe(15_xi, 1_xi, 10), &
1141 & xt_stripe(29_xi, 1_xi, 10) /), &
1142 search_stripes(1) = xt_stripe(32_xi, -1_xi, 30)
1143
1144 TYPE(xt_pos_ext), PARAMETER :: ref_pos_ext(num_ref_pos_ext) &
1145 = (/ xt_pos_ext(23, -22) /)
1146
1147 CALL check_pos_ext(stripes, search_stripes, ref_pos_ext, .true., &
1148 num_ref_unmatched, "search dec stripe over 2 inc gap")
1149 END SUBROUTINE check_pos_ext7
1150
1151 SUBROUTINE check_pos_ext8
1152 INTEGER, PARAMETER :: num_stripes = 5, num_ref_pos_ext = 5, &
1153 num_ref_unmatched = 0
1154
1155 TYPE(Xt_stripe), PARAMETER :: stripes(num_stripes) &
1156 = (/ xt_stripe(1_xi, 1_xi, 10), xt_stripe(15_xi, 1_xi, 10), &
1157 & xt_stripe(29_xi, 1_xi, 10), xt_stripe(14_xi, -1_xi, 4), &
1158 & xt_stripe(28_xi, -1_xi, 4) /), &
1159 search_stripes(1) = xt_stripe(32_xi, -1_xi, 30)
1160
1161 TYPE(xt_pos_ext), PARAMETER :: ref_pos_ext(num_ref_pos_ext) &
1162 = (/ xt_pos_ext(23, -4), xt_pos_ext(34, 4), xt_pos_ext(19, -10), &
1163 & xt_pos_ext(30, 4), xt_pos_ext(9, -8) /)
1164
1165 CALL check_pos_ext(stripes, search_stripes, ref_pos_ext, .true., &
1166 num_ref_unmatched, "search dec stripe over jumbled stripes")
1167 END SUBROUTINE check_pos_ext8
1168
1169END PROGRAM test_idxstripes_f
1170!
1171! Local Variables:
1172! f90-continuation-indent: 5
1173! coding: utf-8
1174! indent-tabs-mode: nil
1175! show-trailing-whitespace: t
1176! require-trailing-newline: t
1177! End:
1178!
describes range of positions starting with start up to start + size - 1 i.e. [start,...
Definition xt_core_f.f90:94
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_index_at_position(Xt_idxlist idxlist, int position, Xt_int *index)
Definition xt_idxlist.c:176
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
int xt_idxlist_get_pos_exts_of_index_stripes(Xt_idxlist idxlist, int num_stripes, const struct Xt_stripe stripes[num_stripes], int *num_ext, struct Xt_pos_ext **pos_ext, int single_match_only)
Definition xt_idxlist.c:262
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
void xt_idxlist_delete(Xt_idxlist idxlist)
Definition xt_idxlist.c:75
#define xt_idxlist_get_num_indices(idxlist)
Xt_idxlist xt_idxstripes_from_idxlist_new(Xt_idxlist idxlist_src)
Xt_idxlist xt_idxstripes_new(struct Xt_stripe const *stripes, int num_stripes)
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