1
2
3
4
5
6
7
8
9
10
11
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
48#include "fc_feature_defs.inc"
49MODULE test_xmap_common
50 USE iso_c_binding, ONLY: c_int
51 USE mpi
52 USE ftest_common, ONLY: init_mpi, finish_mpi, test_abort
53 USE test_idxlist_utils, ONLY: test_err_count
61 IMPLICIT NONE
62 PRIVATE
63 INTEGER :: my_rank
64 PUBLIC :: xmap_self_test_main, test_self_xmap_construct
65 INTERFACE test_self_xmap_construct
66 MODULE PROCEDURE test_self_xmap_construct_idxlist
67 MODULE PROCEDURE test_self_xmap_construct_indices
68 MODULE PROCEDURE test_self_xmap_construct_stripes
69 END INTERFACE test_self_xmap_construct
70 CHARACTER(len=*), PARAMETER :: filename = 'test_xmap_common_f.f90'
71CONTAINS
72 SUBROUTINE xmap_self_test_main(xmap_new)
73 INTERFACE
74 FUNCTION xmap_new(src_idxlist, dst_idxlist, comm) RESULT(res)
76 IMPLICIT NONE
77 TYPE(xt_idxlist), INTENT(in) :: src_idxlist
78 TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
79 INTEGER, INTENT(in) :: comm
80 TYPE(xt_xmap) :: res
81 END FUNCTION xmap_new
82 END INTERFACE
83 INTEGER :: ierror, i, j
84 INTEGER :: comms(2)
85 INTEGER(xi), PARAMETER :: lsize(2) = (/ 7_xi, 1023_xi /)
86
87 CALL init_mpi
89 CALL mpi_comm_rank(mpi_comm_world, my_rank, ierror)
90 IF (ierror /= mpi_success) &
91 CALL test_abort("MPI error!", filename, __line__)
92
93 comms(1) = mpi_comm_world
94 CALL mpi_comm_dup(mpi_comm_world, comms(2), ierror)
95 IF (ierror /= mpi_success) &
96 CALL test_abort("MPI error!", filename, __line__)
98
99 DO i = 1, SIZE(comms)
100 DO j = 1, 2
101 CALL test_xmap1a(xmap_new, lsize(j), comms(i))
102 CALL test_xmap1b(xmap_new, lsize(j), comms(i))
103 END DO
104 CALL test_xmap2(xmap_new, comms(i))
105 END DO
106
107 CALL mpi_comm_free(comms(2), ierror)
108 IF (ierror /= mpi_success) &
109 CALL test_abort("MPI error!", filename, __line__)
110
111 IF (test_err_count() /= 0) &
112 CALL test_abort("non-zero error count!", filename, __line__)
114 CALL finish_mpi
115 END SUBROUTINE xmap_self_test_main
116
117 SUBROUTINE shift_idx(idx, offset)
118 INTEGER(xi), INTENT(inout) :: idx(:)
119 INTEGER(xi), INTENT(in) :: offset
120 INTEGER :: i
121 DO i = 1, SIZE(idx)
122 idx(i) = idx(i) + int(my_rank, xi) * offset
123 END DO
124 END SUBROUTINE shift_idx
125
126 SUBROUTINE assert_xmap_is_to_self(xmap)
127 TYPE(xt_xmap) :: xmap
128 INTEGER :: rank(1)
130 CALL test_abort("error in xmap construction", filename, __line__)
131
133 CALL test_abort("error in xt_xmap_get_num_sources", filename, __line__)
135 IF (rank(1) /= my_rank) &
136 CALL test_abort("error in xt_xmap_get_destination_ranks", &
137 filename, __line__)
138
140 IF (rank(1) /= my_rank) &
141 CALL test_abort("error in xt_xmap_get_source_ranks", &
142 filename, __line__)
143
144 END SUBROUTINE assert_xmap_is_to_self
145
146 SUBROUTINE test_self_xmap_construct_stripes(src_stripes, dst_stripes, &
147 xmap_new, comm)
148 TYPE(xt_stripe), INTENT(in) :: src_stripes(:), dst_stripes(:)
149 INTERFACE
150 FUNCTION xmap_new(src_idxlist, dst_idxlist, comm) RESULT(res)
152 IMPLICIT NONE
153 TYPE(xt_idxlist), INTENT(in) :: src_idxlist
154 TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
155 INTEGER, INTENT(in) :: comm
156 TYPE(xt_xmap) :: res
157 END FUNCTION xmap_new
158 END INTERFACE
159 INTEGER, INTENT(in) :: comm
160 TYPE(xt_idxlist) :: src_idxlist, dst_idxlist
163 CALL test_self_xmap_construct(src_idxlist, dst_idxlist, xmap_new, comm)
164 END SUBROUTINE test_self_xmap_construct_stripes
165
166 SUBROUTINE test_self_xmap_construct_indices(src_indices, dst_indices, &
167 xmap_new, comm)
168 INTEGER(xi), INTENT(in) :: src_indices(:), dst_indices(:)
169 INTERFACE
170 FUNCTION xmap_new(src_idxlist, dst_idxlist, comm) RESULT(res)
172 IMPLICIT NONE
173 TYPE(xt_idxlist), INTENT(in) :: src_idxlist
174 TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
175 INTEGER, INTENT(in) :: comm
176 TYPE(xt_xmap) :: res
177 END FUNCTION xmap_new
178 END INTERFACE
179 INTEGER, INTENT(in) :: comm
180 TYPE(xt_idxlist) :: src_idxlist, dst_idxlist
183 CALL test_self_xmap_construct(src_idxlist, dst_idxlist, xmap_new, comm)
184 END SUBROUTINE test_self_xmap_construct_indices
185
186 SUBROUTINE test_self_xmap_construct_idxlist(src_idxlist, dst_idxlist, &
187 xmap_new, comm)
188 TYPE(xt_idxlist), INTENT(inout) :: src_idxlist, dst_idxlist
189 INTERFACE
190 FUNCTION xmap_new(src_idxlist, dst_idxlist, comm) RESULT(res)
192 IMPLICIT NONE
193 TYPE(xt_idxlist), INTENT(in) :: src_idxlist
194 TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
195 INTEGER, INTENT(in) :: comm
196 TYPE(xt_xmap) :: res
197 END FUNCTION xmap_new
198 END INTERFACE
199 INTEGER, INTENT(in) :: comm
200
201 TYPE(xt_xmap) :: xmap, xmap_copy
202
203 xmap = xmap_new(src_idxlist, dst_idxlist, comm)
206
207 CALL assert_xmap_is_to_self(xmap)
209 CALL assert_xmap_is_to_self(xmap_copy)
210
213 END SUBROUTINE test_self_xmap_construct_idxlist
214
215 SUBROUTINE test_xmap1a(xmap_new, lsize, comm)
216 INTERFACE
217 FUNCTION xmap_new(src_idxlist, dst_idxlist, comm) RESULT(res)
219 IMPLICIT NONE
220 TYPE(xt_idxlist), INTENT(in) :: src_idxlist
221 TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
222 INTEGER, INTENT(in) :: comm
223 TYPE(xt_xmap) :: res
224 END FUNCTION xmap_new
225 END INTERFACE
226 INTEGER(xi), INTENT(in) :: lsize
227 INTEGER, INTENT(in) :: comm
228
229 INTEGER(xt_int_kind) :: src_indices(lsize), dst_indices(lsize), i
230 DO i = 1_xi, lsize
231 src_indices(i) = i
232 END DO
233 CALL shift_idx(src_indices, lsize)
234 DO i = 1_xi, lsize
235 dst_indices(i) = lsize - i + 1_xi
236 END DO
237 CALL shift_idx(dst_indices, lsize)
238
239 CALL test_self_xmap_construct(src_indices, dst_indices, &
240 xmap_new, comm)
241 END SUBROUTINE test_xmap1a
242
243 SUBROUTINE test_xmap1b(xmap_new, lsize, comm)
244 INTERFACE
245 FUNCTION xmap_new(src_idxlist, dst_idxlist, comm) RESULT(res)
247 IMPLICIT NONE
248 TYPE(xt_idxlist), INTENT(in) :: src_idxlist
249 TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
250 INTEGER, INTENT(in) :: comm
251 TYPE(xt_xmap) :: res
252 END FUNCTION xmap_new
253 END INTERFACE
254 INTEGER(xi), INTENT(in) :: lsize
255 INTEGER, INTENT(in) :: comm
256
257 TYPE(xt_stripe) :: src_stripe(1), dst_stripe(1)
258 src_stripe(1) =
xt_stripe(1_xi + int(my_rank, xi) * lsize, &
259 1_xi, int(lsize, c_int))
260 dst_stripe(1) =
xt_stripe(int(my_rank+1, xi) * lsize, &
261 -1_xi, int(lsize, c_int))
262 CALL test_self_xmap_construct(src_stripe, dst_stripe, &
263 xmap_new, comm)
264 END SUBROUTINE test_xmap1b
265
266 SUBROUTINE test_xmap2(xmap_new, comm)
267 INTERFACE
268 FUNCTION xmap_new(src_idxlist, dst_idxlist, comm) RESULT(res)
270 IMPLICIT NONE
271 TYPE(xt_idxlist), INTENT(in) :: src_idxlist
272 TYPE(xt_idxlist), INTENT(in) :: dst_idxlist
273 INTEGER, INTENT(in) :: comm
274 TYPE(xt_xmap) :: res
275 END FUNCTION xmap_new
276 END INTERFACE
277 INTEGER, INTENT(in) :: comm
278
279 INTEGER(xi) :: src_index_list(14), dst_index_list(13)
280 src_index_list = &
281 (/ 5_xi, 67_xi, 4_xi, 5_xi, 13_xi, &
282 & 9_xi, 2_xi, 1_xi, 0_xi, 96_xi, &
283 & 13_xi, 12_xi, 1_xi, 3_xi /)
284 dst_index_list = &
285 (/ 5_xi, 4_xi, 3_xi, 96_xi, 1_xi, &
286 & 5_xi, 4_xi, 5_xi, 4_xi, 3_xi, &
287 & 13_xi, 2_xi, 1_xi /)
288 CALL test_self_xmap_construct(src_index_list, dst_index_list, xmap_new, comm)
289 END SUBROUTINE test_xmap2
290
291END MODULE test_xmap_common
292
293
294
295
296
297
298
299
300
void xt_initialize(MPI_Comm default_comm)
void xt_idxlist_delete(Xt_idxlist idxlist)
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)
void xt_mpi_comm_mark_exclusive(MPI_Comm comm)
void xt_xmap_delete(Xt_xmap xmap)
int xt_xmap_get_num_destinations(Xt_xmap xmap)
Xt_xmap xt_xmap_copy(Xt_xmap xmap)
int xt_xmap_get_num_sources(Xt_xmap xmap)
void xt_xmap_get_source_ranks(Xt_xmap xmap, int *ranks)
void xt_xmap_get_destination_ranks(Xt_xmap xmap, int *ranks)