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_idxlist_collection_f
49 USE ftest_common, ONLY: init_mpi, finish_mpi, test_abort
50 USE mpi
51 USE test_idxlist_utils, ONLY: check_idxlist, test_err_count, &
52 idxlist_pack_unpack_copy, check_idxlist_copy
58 IMPLICIT NONE
59 CHARACTER(len=*), PARAMETER :: filename = 'test_idxlist_collection_f.f90'
60 CALL init_mpi
62
63 CALL test_idxlist_collection_pack_unpack
64 CALL test_idxlist_collection_copy
65 CALL test_idxlist_collection_intersection
66 CALL test_idxlist_collection_heterogeneous
67 CALL test_bounding_box1
68 CALL test_bounding_box2
69
71 IF (test_err_count() /= 0) &
72 CALL test_abort("non-zero error count!", filename, __line__)
73 CALL finish_mpi
74
75CONTAINS
76 SUBROUTINE test_idxlist_collection_pack_unpack
77 INTEGER, PARAMETER :: num_indices = 7, num_vec = 2
78 INTEGER(xt_int_kind) :: i, j
79 INTEGER(xt_int_kind), PARAMETER :: index_list(num_indices, num_vec) = &
80 reshape((/ ((int(i, xt_int_kind), i = 1, num_indices), &
81 & j = 1, num_vec) /), &
82 & shape = (/ num_indices, num_vec /))
83 TYPE(xt_idxlist) :: idxlists(num_vec), collectionlist, collectionlist_copy
84 TYPE(xt_stripe),
PARAMETER :: ref_stripes(num_vec) =
xt_stripe(1, 1, 7)
85 INTEGER :: k
86 DO k = 1, num_vec
88 END DO
91 CALL check_idxlist(collectionlist, &
92 reshape(index_list, (/ SIZE(index_list) /)))
93 collectionlist_copy = idxlist_pack_unpack_copy(collectionlist)
94 CALL check_idxlist_copy(collectionlist, collectionlist_copy, &
95 reshape(index_list, (/ SIZE(index_list) /)), ref_stripes)
98 END SUBROUTINE test_idxlist_collection_pack_unpack
99
100 SUBROUTINE test_idxlist_collection_copy
101 INTEGER, PARAMETER :: num_indices = 7, num_vec = 2
102 INTEGER(xt_int_kind) :: i, j
103 INTEGER(xt_int_kind), PARAMETER :: index_list(num_indices, num_vec) = &
104 reshape((/ ((int(num_indices - (j * num_indices + 1 - j - i) &
105 & * (2*j - 1), xt_int_kind), &
106 & i=1, num_indices), j=1,0,-1) /), &
107 & (/ num_indices, num_vec /))
108 TYPE(xt_idxlist) :: idxlists(num_vec), collectionlist, collectionlist_copy
109 TYPE(xt_stripe), PARAMETER :: ref_stripes(num_vec) &
111 INTEGER :: k
112 DO k = 1, num_vec
114 END DO
117 CALL check_idxlist(collectionlist, &
118 reshape(index_list, (/ SIZE(index_list) /)))
119 collectionlist_copy = idxlist_pack_unpack_copy(collectionlist)
120 CALL check_idxlist_copy(collectionlist, collectionlist_copy, &
121 reshape(index_list, (/ SIZE(index_list) /)), ref_stripes)
124 END SUBROUTINE test_idxlist_collection_copy
125
126 SUBROUTINE test_idxlist_collection_intersection
127 INTEGER, PARAMETER :: num_indices = 7, num_lists = 3
128 INTEGER, PARAMETER :: xi = xt_int_kind
129 INTEGER(xt_int_kind), PARAMETER :: index_list(num_indices, num_lists) &
130 = reshape((/ 1_xi, 2_xi, 3_xi, 4_xi, 5_xi, 6_xi, 7_xi, &
131 & 7_xi, 6_xi, 5_xi, 4_xi, 3_xi, 2_xi, 1_xi, &
132 & 2_xi, 6_xi, 1_xi, 4_xi, 7_xi, 3_xi, 0_xi /), &
133 & (/ num_indices, num_lists /)), &
134 sorted_index_list(SIZE(index_list)) &
135 = (/ 0_xi, 1_xi, 1_xi, 1_xi, 2_xi, 2_xi, 2_xi, &
136 & 3_xi, 3_xi, 3_xi, 4_xi, 4_xi, 4_xi, 5_xi, &
137 & 5_xi, 6_xi, 6_xi, 6_xi, 7_xi, 7_xi, 7_xi /)
138 TYPE(xt_idxlist) :: idxlists(num_lists), collectionlist, intersection, &
139 ref_idxvec
140 INTEGER :: i
141
142 DO i = 1, 3
144 END DO
146 DO i = 1, 3
148 END DO
149 CALL check_idxlist(collectionlist, &
150 reshape(index_list, (/ SIZE(index_list) /)))
151 ref_idxvec =
xt_idxvec_new(reshape(index_list, (/
SIZE(index_list) /)), &
152 SIZE(index_list))
154 CALL check_idxlist(intersection, sorted_index_list)
157 CALL check_idxlist(intersection, sorted_index_list)
161
162 END SUBROUTINE test_idxlist_collection_intersection
163
164 SUBROUTINE test_idxlist_collection_heterogeneous
165 INTEGER, PARAMETER :: num_indices = 6, num_lists = 3
166 INTEGER, PARAMETER :: xi = xt_int_kind
167 INTEGER(xt_int_kind), PARAMETER :: &
168 index_list(num_indices) = (/ 1_xi, 3_xi, 5_xi, 7_xi, 9_xi, 11_xi /)
169 TYPE(xt_stripe),
PARAMETER :: stripes(2) = (/
xt_stripe(0, 2, 5), &
171 INTEGER(xt_int_kind), PARAMETER :: local_start(2) = 2
172 INTEGER(xt_int_kind), PARAMETER :: global_size(2) = (/ 10_xi, 10_xi /)
173 INTEGER, PARAMETER :: local_size(2) = 5
174 INTEGER, PARAMETER :: ref_size = num_indices + stripes(1)%nstrides &
175 + stripes(2)%nstrides + local_size(1) * local_size(2)
176 INTEGER(xt_int_kind), PARAMETER :: ref_index_list(ref_size) &
177 = (/ 1_xi, 3_xi, 5_xi, 7_xi, 9_xi, 11_xi, &
178 & 0_xi, 2_xi, 4_xi, 6_xi, 8_xi, 1_xi, 3_xi, 5_xi, 7_xi, 9_xi, &
179 & 22_xi, 23_xi, 24_xi, 25_xi, 26_xi, &
180 & 32_xi, 33_xi, 34_xi, 35_xi, 36_xi, &
181 & 42_xi, 43_xi, 44_xi, 45_xi, 46_xi, &
182 & 52_xi, 53_xi, 54_xi, 55_xi, 56_xi, &
183 & 62_xi, 63_xi, 64_xi, 65_xi, 66_xi /)
184 TYPE(xt_idxlist) :: idxlists(num_lists), collectionlist
185
189 local_start)
190
191
193
195
196
197 CALL check_idxlist(collectionlist, ref_index_list)
198
200
201 END SUBROUTINE test_idxlist_collection_heterogeneous
202
203 SUBROUTINE test_bounding_box1
204 INTEGER, PARAMETER :: ndim=3, num_lists = 2
205 INTEGER(xt_int_kind), PARAMETER :: global_size_bb(ndim) = 4, &
206 global_start_index = 0
207 TYPE(xt_idxlist) :: idxlists(num_lists), collectionlist
208 TYPE(xt_bounds) :: bounds(ndim)
209 INTEGER :: i
210
211 DO i = 1, num_lists
213 END DO
217 global_start_index)
218 IF (any(bounds%size /= 0)) &
219 CALL test_abort("ERROR: non-zero bounding box size", &
220 filename, __line__)
222 END SUBROUTINE test_bounding_box1
223
224 SUBROUTINE test_bounding_box2
225 INTEGER, PARAMETER :: ndim = 3, num_lists = 2, num_indices = 3
226 INTEGER, PARAMETER :: xi = xt_int_kind
227 INTEGER(xt_int_kind), PARAMETER :: indices(num_indices, num_lists) &
228 = reshape( (/ 45_xi, 35_xi, 32_xi, 32_xi, 48_xi, 33_xi /), &
229 & (/ num_indices, num_lists /)), &
230 global_size(ndim) = (/ 5_xi, 4_xi, 3_xi /), &
231 global_start_index = 1
232 TYPE(xt_idxlist) :: idxlists(num_lists), collectionlist
233 TYPE(xt_bounds) :: bounds(ndim)
234 TYPE(xt_bounds),
PARAMETER :: bounds_ref(ndim) = (/
xt_bounds(2, 2), &
236 INTEGER :: i
237
238 DO i = 1, num_lists
240 END DO
243
245 global_start_index)
247 IF (any(bounds /= bounds_ref)) &
248 CALL test_abort("ERROR: unexpected boundaries", filename, __line__)
249 END SUBROUTINE test_bounding_box2
250
251END PROGRAM test_idxlist_collection_f
252
253
254
255
256
257
258
259
260
void xt_initialize(MPI_Comm default_comm)
Xt_idxlist xt_idxempty_new(void)
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])
Xt_idxlist xt_idxlist_get_intersection(Xt_idxlist idxlist_src, Xt_idxlist idxlist_dst)
void xt_idxlist_delete(Xt_idxlist idxlist)
Xt_idxlist xt_idxlist_collection_new(Xt_idxlist *idxlists, int num_idxlists)
Xt_idxlist xt_idxsection_new(Xt_int start, int num_dimensions, const Xt_int global_size[num_dimensions], const int local_size[num_dimensions], const Xt_int local_start[num_dimensions])
Xt_idxlist xt_idxstripes_new(struct Xt_stripe const *stripes, int num_stripes)
Xt_idxlist xt_idxvec_new(const Xt_int *idxlist, int num_indices)