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