1
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
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
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
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__)
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
137 CALL do_tests(idxstripes, ref_indices)
138
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
157 CALL test_abort("index list length/positions overlap mismatch", &
158 filename, __line__)
159
160 IF (ALLOCATED(pos_ext)) DEALLOCATE(pos_ext)
162
163
166 CALL check_idxlist(idxstripes, ref_indices)
169 END SUBROUTINE stripe_test_general
170
171 SUBROUTINE stripe_test_general1
172 TYPE(xt_stripe),
PARAMETER :: stripes(3) = (/
xt_stripe(0, 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), &
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), &
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), &
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), &
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
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
244 END SUBROUTINE test_intersection
245
246 SUBROUTINE test_intersection0
247 TYPE(xt_stripe),
PARAMETER :: stripes_a(1) = (/
xt_stripe(0, 0, 0) /), &
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), &
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), &
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), &
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) /), &
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), &
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) /), &
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) , &
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), &
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), &
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) /), &
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) /), &
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
358
359 SUBROUTINE test_intersection12
360 TYPE(xt_stripe),
PARAMETER :: stripes_a(1) = (/
xt_stripe(34, 29, 12) /), &
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
368 SUBROUTINE test_intersection13
369 TYPE(xt_stripe), PARAMETER :: &
370 stripes_a(1) = (/
xt_stripe(353, -29, 12) /), &
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) &
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
407 CALL test_abort("unexpected number of indices in intersection!", &
408 filename, __line__)
410 intersection_idx)
411 IF (not_found .OR. intersection_idx /= index_vector(1)) &
412 CALL test_abort("unexpected index in intersection!", &
413 filename, __line__)
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) = (/ &
469 TYPE(xt_idxlist) :: idxlist
470
472 CALL check_idxlist_stripes_pos_ext(idxlist, stripes)
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) = (/ &
514 TYPE(xt_idxlist) :: idxlist
515
517 CALL check_idxlist_stripes_pos_ext(idxlist, stripes)
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) = (/ &
732 TYPE(xt_idxlist) :: idxlist
733
735 CALL check_idxlist_stripes_pos_ext(idxlist, stripes)
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) = (/ &
747 TYPE(xt_idxlist) :: idxlist
748
750 CALL check_idxlist_stripes_pos_ext(idxlist, stripes)
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) = (/ &
761 TYPE(xt_idxlist) :: idxlist
762
764 CALL check_idxlist_stripes_pos_ext(idxlist, stripes)
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
792
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
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
824 IF (num_unmatched /= 0) &
825 CALL test_abort("error in xt_idxlist_get_pos_exts_of_index_stripes", &
826 filename, __line__)
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 &
835 intersection_index)
836 send_pos = pos_ext(i)%start + jsign * j
837 unmatched_in_idxlist &
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
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
863 num_pos = SIZE(pos)
864 ref_undef_count = 0
865 DO ip = 1, num_pos
866 p = pos(ip)
868 ref_sel_idx(ip) = undef_idx
869 ref_undef_count = ref_undef_count + 1
870 END IF
871 END DO
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__)
880 END SUBROUTINE test_get_pos
881
882 SUBROUTINE test_get_pos1
883 TYPE(xt_stripe),
PARAMETER :: stripes(3) = (/
xt_stripe(0, 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), &
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), &
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), &
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), &
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__)
944
946 global_start_index)
947 IF (any(bounds /= bounds_ref)) &
948 CALL test_abort("boundary box doesn't match reference", &
949 filename, __line__)
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), &
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), &
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)
982 IF (ALLOCATED(stripes)) THEN
983 num_stripes = SIZE(stripes)
985 ELSE
986 num_stripes = 0
988 END IF
989 CALL check_idxlist(temp_idxlist, ref_indices)
990
992
993 IF (ALLOCATED(stripes)) DEALLOCATE(stripes)
994
995
996 idxlist_copy = idxlist_pack_unpack_copy(idxlist)
997
998
999 CALL check_idxlist(idxlist_copy, ref_indices)
1000
1002
1003
1005
1006
1007 CALL check_idxlist(idxlist_copy, ref_indices)
1008
1009
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
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)
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) &
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) &
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) &
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) &
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) &
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) &
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) &
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) &
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) &
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) &
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) &
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) &
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) &
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) &
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) &
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) &
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
1172
1173
1174
1175
1176
1177
1178
describes range of positions starting with start up to start + size - 1 i.e. [start,...
void xt_initialize(MPI_Comm default_comm)
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)
#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)