1
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
49#include "fc_feature_defs.inc"
50PROGRAM test_redist_collection
51 USE mpi
52 USE ftest_common, ONLY: init_mpi, finish_mpi, test_abort, cmp_arrays
53 USE test_idxlist_utils, ONLY: test_err_count
61#if !defined HAVE_FC_LOGICAL_INTEROP || !defined(__GNUC__) || __GNUC__ > 4 \
62 || (__gnuc__ == 4 && __gnuc_minor__ > 8)
63#else
64 USE yaxt, ONLY: xt_slice_c_loc
65#endif
66
67#if defined __PGI && (__PGIC__ < 12 || (__PGIC__ == 12 && __PGIC_MINOR__ <= 10))
69#endif
70 USE test_redist_common, ONLY: build_odd_selection_xmap, check_redist, &
71 check_wait_request, redist_exchanger_option
72 USE iso_c_binding, ONLY: c_loc, c_ptr
73 USE redist_collection_displace, ONLY: test_displacement_variations
74#include "xt_slice_c_loc.inc"
75 IMPLICIT NONE
76 CHARACTER(len=*), PARAMETER :: filename = 'test_redist_collection_f.f90'
77 CHARACTER(len=*), PARAMETER :: err_msg(2) = &
78 (/ "error on xt_redist_s_exchange", "error on xt_redist_a_exchange" /)
79 TYPE(xt_config) :: config
80
81 CALL init_mpi
83 config = redist_exchanger_option()
84
85 CALL simple_test(mpi_comm_world, config)
86 CALL simple_test2(mpi_comm_world, config)
87 CALL test_empty_redist(mpi_comm_world, config)
88 CALL test_repeated_redist(mpi_comm_world, config, -1)
89 CALL test_repeated_redist(mpi_comm_world, config, 0)
90 CALL test_displacement_variations(mpi_comm_world, config)
91
92 IF (test_err_count() /= 0) &
93 CALL test_abort("non-zero error count!", filename, __line__)
96 CALL finish_mpi
97CONTAINS
98 SUBROUTINE simple_test(comm, config)
99
100 INTEGER, INTENT(in) :: comm
101 TYPE(xt_config), INTENT(in) :: config
102
103 TYPE(xt_xmap) :: xmap
104 TYPE(xt_redist) :: redist, redist_coll, redist_copy
105 INTEGER, PARAMETER :: src_slice_len = 5, dst_slice_len = 3
106 DOUBLE PRECISION, PARAMETER :: &
107 ref_dst_data(dst_slice_len) = (/ 1.0d0, 3.0d0, 5.0d0 /), &
108 src_data(src_slice_len) = (/ 1.0d0, 2.0d0, 3.0d0, 4.0d0, 5.0d0 /)
109 DOUBLE PRECISION :: dst_data(dst_slice_len)
110
111
112 xmap = build_odd_selection_xmap(src_slice_len, comm)
113
118 redist = redist_copy
119
120
122
124
125
126 CALL check_redist(redist_coll, src_data, dst_data, ref_dst_data)
127
128
130 END SUBROUTINE simple_test
131
132 SUBROUTINE simple_test2(comm, config)
133
134 INTEGER, INTENT(in) :: comm
135 TYPE(xt_config), INTENT(in) :: config
136
137 TYPE(xt_xmap) :: xmap
138 TYPE(xt_redist) :: redist_coll, redist_copy, &
139 redist_components(2)
140 INTEGER, PARAMETER :: src_slice_len = 5, dst_slice_len = 3
141 TYPE src_data_collection
142 DOUBLE PRECISION :: dp(src_slice_len)
143 LOGICAL :: l(src_slice_len)
144 END TYPE src_data_collection
145 TYPE dst_data_collection
146 DOUBLE PRECISION :: dp(dst_slice_len)
147 LOGICAL :: l(dst_slice_len)
148 END TYPE dst_data_collection
149 TYPE(src_data_collection), SAVE, TARGET :: src_data = src_data_collection(&
150 (/ 1.0d0, 2.0d0, 3.0d0, 4.0d0, 5.0d0 /), &
151 (/ .true., .false., .true., .false., .true. /))
152 TYPE(dst_data_collection), PARAMETER :: &
153 ref_dst_data = dst_data_collection((/ 1.0d0, 3.0d0, 5.0d0 /), &
154 (/ .true., .true., .true. /))
155 TYPE(dst_data_collection), TARGET :: dst_data
156 TYPE(c_ptr) :: src_data_p(2), dst_data_p(2)
157
158 xmap = build_odd_selection_xmap(src_slice_len, comm)
159
163
164
169 redist_coll = redist_copy
170
171
172
173
174#if !defined(__GNUC__) || __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ > 8)
175# define COMP_C_LOC(v, p) p = C_LOC(v)
176#else
177# define COMP_C_LOC(v, p) CALL xt_slice_c_loc(v, p)
178#endif
179
180
181
182
183#if defined HAVE_FC_LOGICAL_INTEROP && ( !defined __GNUC__ || __GNUC__ > 8 )
184# define L_COMP_C_LOC(v, p) p = C_LOC(v)
185#else
186# define L_COMP_C_LOC(v, p) CALL xt_slice_c_loc(v, p)
187#endif
188
189 comp_c_loc(src_data%dp, src_data_p(1))
190 l_comp_c_loc(src_data%l, src_data_p(2))
191 dst_data%dp = -1.0d0
192 dst_data%l = .false.
193 comp_c_loc(dst_data%dp, dst_data_p(1))
194 l_comp_c_loc(dst_data%l, dst_data_p(2))
196 IF (any(dst_data%l .NEQV. ref_dst_data%l)) &
197 CALL test_abort("error in xt_redist_s_exchange", filename, __line__)
198 IF (cmp_arrays(dst_data%dp, ref_dst_data%dp)) &
199 CALL test_abort("error in xt_redist_s_exchange", filename, __line__)
200
201
203 END SUBROUTINE simple_test2
204
205 SUBROUTINE test_empty_redist(comm, config)
206
207 INTEGER, INTENT(in) :: comm
208 TYPE(xt_config), INTENT(in) :: config
209
210 TYPE(xt_idxlist) :: src_idxlist, dst_idxlist
211 TYPE(xt_xmap) :: xmap
212 TYPE(xt_redist) :: redist, redist_coll, redist_copy
213
214
217
219
222
227 redist = redist_copy
228
229
231
233
234
236 END SUBROUTINE test_empty_redist
237
238 SUBROUTINE test_repeated_redist_ds(redist_coll, src_data, permutation)
239 TYPE(xt_redist), INTENT(in) :: redist_coll
240 DOUBLE PRECISION, INTENT(in), TARGET :: src_data(5, 3)
241 INTEGER, INTENT(in) :: permutation(3)
242 INTEGER :: i, j
243 DOUBLE PRECISION, PARAMETER :: ref_dst_data(3, 3) &
244 = reshape((/ ((dble(i + j), i = 1,5,2), j = 0,10,5) /), (/ 3, 3 /))
245 DOUBLE PRECISION, TARGET :: dst_data(3, 3)
246 TYPE(c_ptr) :: src_data_p(3), dst_data_p(3)
247
248 INTEGER :: iexch
249 TYPE(xt_request) :: request
250
251 DO i = 1, 3
252 xt_slice_c_loc(src_data(:, permutation(i)), src_data_p(i))
253 xt_slice_c_loc(dst_data(:, permutation(i)), dst_data_p(i))
254 END DO
255 DO iexch = 1, 2
256 dst_data = -1.0d0
257 IF (iexch == 1) THEN
259 ELSE
261 request)
262 CALL check_wait_request(request, filename, __line__)
263 ENDIF
264 IF (cmp_arrays(ref_dst_data, dst_data)) &
265 CALL test_abort(err_msg(iexch), filename, __line__)
266 ENDDO
267 END SUBROUTINE test_repeated_redist_ds
268
269 SUBROUTINE test_repeated_redist(comm, config, cache_size)
270 INTEGER, INTENT(in) :: comm
271 TYPE(xt_config), INTENT(in) :: config
272 INTEGER, INTENT(in) :: cache_size
273
274
275
276 INTEGER, PARAMETER :: num_slice = 3
277 INTEGER, PARAMETER :: src_slice_len = 5
278 INTEGER :: i
279 DOUBLE PRECISION, PARAMETER :: src_data(5, num_slice) = reshape((/&
280 (dble(i), i = 1, 15)/), (/ 5, num_slice /))
281 TYPE(xt_xmap) :: xmap
282 TYPE(xt_redist) :: redists(num_slice), redist_coll, redist_coll_copy
283 INTEGER, PARAMETER :: permutation(3, 3) &
284 = reshape((/ 1, 2, 3, 2, 1, 3, 1, 2, 3 /), (/ 3, 3 /))
285
286 xmap = build_odd_selection_xmap(src_slice_len, comm)
287
289
291
292
293
295 comm, config)
296
298
299 DO i = 1, 3
300
301
302 CALL test_repeated_redist_ds(redist_coll, src_data, permutation(:, i))
303 END DO
304
305
308 DO i = 1, 3
309
310
311 CALL test_repeated_redist_ds(redist_coll_copy, src_data, permutation(:, i))
312 END DO
313
314
316 END SUBROUTINE test_repeated_redist
317
318END PROGRAM test_redist_collection
319
320
321
322
323
324
325
326
327
void xt_config_delete(Xt_config config)
void xt_initialize(MPI_Comm default_comm)
Xt_idxlist xt_idxempty_new(void)
void xt_idxlist_delete(Xt_idxlist idxlist)
void xt_redist_delete(Xt_redist redist)
Xt_redist xt_redist_copy(Xt_redist redist)
void xt_redist_s_exchange(Xt_redist redist, int num_arrays, const void *const src_data[], void *const dst_data[])
void xt_redist_a_exchange(Xt_redist redist, int num_arrays, const void *const src_data[], void *const dst_data[], Xt_request *request)
Xt_redist xt_redist_collection_new(Xt_redist *redists, int num_redists, int cache_size, MPI_Comm comm)
Xt_redist xt_redist_p2p_new(Xt_xmap xmap, MPI_Datatype datatype)
void xt_xmap_delete(Xt_xmap xmap)
Xt_xmap xt_xmap_all2all_new(Xt_idxlist src_idxlist, Xt_idxlist dst_idxlist, MPI_Comm comm)