47 PROGRAM test_idxlist_collection_f
48 USE ftest_common,
ONLY: init_mpi, finish_mpi, test_abort
50 USE test_idxlist_utils,
ONLY: check_idxlist, test_err_count, &
51 idxlist_pack_unpack_copy, check_idxlist_copy
58 CHARACTER(len=*),
PARAMETER :: filename =
'test_idxlist_collection_f.f90'
62 CALL test_idxlist_collection_pack_unpack
63 CALL test_idxlist_collection_copy
64 CALL test_idxlist_collection_intersection
65 CALL test_idxlist_collection_heterogeneous
66 CALL test_bounding_box1
67 CALL test_bounding_box2
70 IF (test_err_count() /= 0) &
71 CALL test_abort(
"non-zero error count!", filename, __line__)
75 SUBROUTINE test_idxlist_collection_pack_unpack
76 INTEGER,
PARAMETER :: num_indices = 7, num_vec = 2
77 INTEGER(xt_int_kind) :: i, j
78 INTEGER(xt_int_kind),
PARAMETER :: index_list(num_indices, num_vec) = &
79 reshape((/ ((int(i, xt_int_kind), i = 1, num_indices), &
80 & j = 1, num_vec) /), &
81 & shape = (/ num_indices, num_vec /))
82 TYPE(xt_idxlist) :: idxlists(num_vec), collectionlist, collectionlist_copy
83 TYPE(xt_stripe),
PARAMETER :: ref_stripes(num_vec) = xt_stripe(1, 1, 7)
90 CALL check_idxlist(collectionlist, &
91 reshape(index_list, (/
SIZE(index_list) /)))
92 collectionlist_copy = idxlist_pack_unpack_copy(collectionlist)
93 CALL check_idxlist_copy(collectionlist, collectionlist_copy, &
94 reshape(index_list, (/
SIZE(index_list) /)), ref_stripes)
97 END SUBROUTINE test_idxlist_collection_pack_unpack
99 SUBROUTINE test_idxlist_collection_copy
100 INTEGER,
PARAMETER :: num_indices = 7, num_vec = 2
101 INTEGER(xt_int_kind) :: i, j
102 INTEGER(xt_int_kind),
PARAMETER :: index_list(num_indices, num_vec) = &
103 reshape((/ ((int(num_indices - (j * num_indices + 1 - j - i) &
104 & * (2*j - 1), xt_int_kind), &
105 & i=1, num_indices), j=1,0,-1) /), &
106 & (/ num_indices, num_vec /))
107 TYPE(xt_idxlist) :: idxlists(num_vec), collectionlist, collectionlist_copy
108 TYPE(xt_stripe),
PARAMETER :: ref_stripes(num_vec) &
109 = (/ xt_stripe(1, 1, 7), xt_stripe(7, -1, 7) /)
116 CALL check_idxlist(collectionlist, &
117 reshape(index_list, (/
SIZE(index_list) /)))
118 collectionlist_copy = idxlist_pack_unpack_copy(collectionlist)
119 CALL check_idxlist_copy(collectionlist, collectionlist_copy, &
120 reshape(index_list, (/
SIZE(index_list) /)), ref_stripes)
123 END SUBROUTINE test_idxlist_collection_copy
125 SUBROUTINE test_idxlist_collection_intersection
126 INTEGER,
PARAMETER :: num_indices = 7, num_lists = 3
127 INTEGER,
PARAMETER :: xi = xt_int_kind
128 INTEGER(xt_int_kind),
PARAMETER :: index_list(num_indices, num_lists) &
129 = reshape((/ 1_xi, 2_xi, 3_xi, 4_xi, 5_xi, 6_xi, 7_xi, &
130 & 7_xi, 6_xi, 5_xi, 4_xi, 3_xi, 2_xi, 1_xi, &
131 & 2_xi, 6_xi, 1_xi, 4_xi, 7_xi, 3_xi, 0_xi /), &
132 & (/ num_indices, num_lists /)), &
133 sorted_index_list(
SIZE(index_list)) &
134 = (/ 0_xi, 1_xi, 1_xi, 1_xi, 2_xi, 2_xi, 2_xi, &
135 & 3_xi, 3_xi, 3_xi, 4_xi, 4_xi, 4_xi, 5_xi, &
136 & 5_xi, 6_xi, 6_xi, 6_xi, 7_xi, 7_xi, 7_xi /)
137 TYPE(xt_idxlist) :: idxlists(num_lists), collectionlist, intersection, &
148 CALL check_idxlist(collectionlist, &
149 reshape(index_list, (/
SIZE(index_list) /)))
150 ref_idxvec =
xt_idxvec_new(reshape(index_list, (/
SIZE(index_list) /)), &
153 CALL check_idxlist(intersection, sorted_index_list)
156 CALL check_idxlist(intersection, sorted_index_list)
161 END SUBROUTINE test_idxlist_collection_intersection
163 SUBROUTINE test_idxlist_collection_heterogeneous
164 INTEGER,
PARAMETER :: num_indices = 6, num_lists = 3
165 INTEGER,
PARAMETER :: xi = xt_int_kind
166 INTEGER(xt_int_kind),
PARAMETER :: &
167 index_list(num_indices) = (/ 1_xi, 3_xi, 5_xi, 7_xi, 9_xi, 11_xi /)
168 TYPE(xt_stripe),
PARAMETER :: stripes(2) = (/ xt_stripe(0, 2, 5), &
169 xt_stripe(1, 2, 5) /)
170 INTEGER(xt_int_kind),
PARAMETER :: local_start(2) = 2
171 INTEGER(xt_int_kind),
PARAMETER :: global_size(2) = (/ 10_xi, 10_xi /)
172 INTEGER,
PARAMETER :: local_size(2) = 5
173 INTEGER,
PARAMETER :: ref_size = num_indices + stripes(1)%nstrides &
174 + stripes(2)%nstrides + local_size(1) * local_size(2)
175 INTEGER(xt_int_kind),
PARAMETER :: ref_index_list(ref_size) &
176 = (/ 1_xi, 3_xi, 5_xi, 7_xi, 9_xi, 11_xi, &
177 & 0_xi, 2_xi, 4_xi, 6_xi, 8_xi, 1_xi, 3_xi, 5_xi, 7_xi, 9_xi, &
178 & 22_xi, 23_xi, 24_xi, 25_xi, 26_xi, &
179 & 32_xi, 33_xi, 34_xi, 35_xi, 36_xi, &
180 & 42_xi, 43_xi, 44_xi, 45_xi, 46_xi, &
181 & 52_xi, 53_xi, 54_xi, 55_xi, 56_xi, &
182 & 62_xi, 63_xi, 64_xi, 65_xi, 66_xi /)
183 TYPE(xt_idxlist) :: idxlists(num_lists), collectionlist
196 CALL check_idxlist(collectionlist, ref_index_list)
200 END SUBROUTINE test_idxlist_collection_heterogeneous
202 SUBROUTINE test_bounding_box1
203 INTEGER,
PARAMETER :: ndim=3, num_lists = 2
204 INTEGER(xt_int_kind),
PARAMETER :: global_size_bb(ndim) = 4, &
205 global_start_index = 0
206 TYPE(xt_idxlist) :: idxlists(num_lists), collectionlist
207 TYPE(xt_bounds) :: bounds(ndim)
217 IF (any(bounds%size /= 0)) &
218 CALL test_abort(
"ERROR: non-zero bounding box size", &
221 END SUBROUTINE test_bounding_box1
223 SUBROUTINE test_bounding_box2
224 INTEGER,
PARAMETER :: ndim = 3, num_lists = 2, num_indices = 3
225 INTEGER,
PARAMETER :: xi = xt_int_kind
226 INTEGER(xt_int_kind),
PARAMETER :: indices(num_indices, num_lists) &
227 = reshape( (/ 45_xi, 35_xi, 32_xi, 32_xi, 48_xi, 33_xi /), &
228 & (/ num_indices, num_lists /)), &
229 global_size(ndim) = (/ 5_xi, 4_xi, 3_xi /), &
230 global_start_index = 1
231 TYPE(xt_idxlist) :: idxlists(num_lists), collectionlist
232 TYPE(xt_bounds) :: bounds(ndim)
233 TYPE(xt_bounds),
PARAMETER :: bounds_ref(ndim) = (/ xt_bounds(2, 2), &
234 xt_bounds(2, 2), xt_bounds(1, 2) /)
246 IF (any(bounds /= bounds_ref)) &
247 CALL test_abort(
"ERROR: unexpected boundaries", filename, __line__)
248 END SUBROUTINE test_bounding_box2
250 END PROGRAM test_idxlist_collection_f
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)