49 PROGRAM test_redist_collection
51 USE ftest_common,
ONLY: init_mpi, finish_mpi, test_abort, cmp_arrays
52 USE test_idxlist_utils,
ONLY: test_err_count
60 #if !defined HAVE_FC_LOGICAL_INTEROP || !defined(__GNUC__) || __GNUC__ > 4 \
61 || (__gnuc__ == 4 && __gnuc_minor__ > 8)
63 USE yaxt,
ONLY: xt_slice_c_loc
66 #if defined __PGI && (__PGIC__ < 12 || (__PGIC__ == 12 && __PGIC_MINOR__ <= 10))
69 USE test_redist_common,
ONLY: build_odd_selection_xmap, check_redist, &
70 check_wait_request, redist_exchanger_option
71 USE iso_c_binding,
ONLY: c_loc, c_ptr
72 USE redist_collection_displace,
ONLY: test_displacement_variations
73 #include "xt_slice_c_loc.inc"
75 CHARACTER(len=*),
PARAMETER :: filename =
'test_redist_collection_f.f90'
76 CHARACTER(len=*),
PARAMETER :: err_msg(2) = &
77 (/
"error on xt_redist_s_exchange",
"error on xt_redist_a_exchange" /)
78 TYPE(xt_config) :: config
82 config = redist_exchanger_option()
84 CALL simple_test(mpi_comm_world, config)
85 CALL simple_test2(mpi_comm_world, config)
86 CALL test_empty_redist(mpi_comm_world, config)
87 CALL test_repeated_redist(mpi_comm_world, config, -1)
88 CALL test_repeated_redist(mpi_comm_world, config, 0)
89 CALL test_displacement_variations(mpi_comm_world, config)
91 IF (test_err_count() /= 0) &
92 CALL test_abort(
"non-zero error count!", filename, __line__)
97 SUBROUTINE simple_test(comm, config)
99 INTEGER,
INTENT(in) :: comm
100 TYPE(xt_config),
INTENT(in) :: config
102 TYPE(xt_xmap) :: xmap
103 TYPE(xt_redist) :: redist, redist_coll, redist_copy
104 INTEGER,
PARAMETER :: src_slice_len = 5, dst_slice_len = 3
105 DOUBLE PRECISION,
PARAMETER :: &
106 ref_dst_data(dst_slice_len) = (/ 1.0d0, 3.0d0, 5.0d0 /), &
107 src_data(src_slice_len) = (/ 1.0d0, 2.0d0, 3.0d0, 4.0d0, 5.0d0 /)
108 DOUBLE PRECISION :: dst_data(dst_slice_len)
111 xmap = build_odd_selection_xmap(src_slice_len)
125 CALL check_redist(redist_coll, src_data, dst_data, ref_dst_data)
129 END SUBROUTINE simple_test
131 SUBROUTINE simple_test2(comm, config)
133 INTEGER,
INTENT(in) :: comm
134 TYPE(xt_config),
INTENT(in) :: config
136 TYPE(xt_xmap) :: xmap
137 TYPE(xt_redist) :: redist_coll, redist_copy, &
139 INTEGER,
PARAMETER :: src_slice_len = 5, dst_slice_len = 3
140 TYPE src_data_collection
141 DOUBLE PRECISION :: dp(src_slice_len)
142 LOGICAL :: l(src_slice_len)
143 END TYPE src_data_collection
144 TYPE dst_data_collection
145 DOUBLE PRECISION :: dp(dst_slice_len)
146 LOGICAL :: l(dst_slice_len)
147 END TYPE dst_data_collection
148 TYPE(src_data_collection),
SAVE,
TARGET :: src_data = src_data_collection(&
149 (/ 1.0d0, 2.0d0, 3.0d0, 4.0d0, 5.0d0 /), &
150 (/ .true., .false., .true., .false., .true. /))
151 TYPE(dst_data_collection),
PARAMETER :: &
152 ref_dst_data = dst_data_collection((/ 1.0d0, 3.0d0, 5.0d0 /), &
153 (/ .true., .true., .true. /))
154 TYPE(dst_data_collection),
TARGET :: dst_data
155 TYPE(c_ptr) :: src_data_p(2), dst_data_p(2)
157 xmap = build_odd_selection_xmap(src_slice_len)
168 redist_coll = redist_copy
173 #if !defined(__GNUC__) || __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ > 8)
174 # define COMP_C_LOC(v, p) p = C_LOC(v)
176 # define COMP_C_LOC(v, p) CALL xt_slice_c_loc(v, p)
178 #if !defined HAVE_FC_LOGICAL_INTEROP || !defined(__GNUC__) || __GNUC__ > 4 \
179 || (__gnuc__ == 4 && __gnuc_minor__ > 8)
180 # define L_COMP_C_LOC(v, p) CALL xt_slice_c_loc(v, p)
182 # define L_COMP_C_LOC(v, p) p = C_LOC(v)
185 comp_c_loc(src_data%dp, src_data_p(1))
186 l_comp_c_loc(src_data%l, src_data_p(2))
189 comp_c_loc(dst_data%dp, dst_data_p(1))
190 l_comp_c_loc(dst_data%l, dst_data_p(2))
192 IF (any(dst_data%l .NEQV. ref_dst_data%l)) &
193 CALL test_abort(
"error in xt_redist_s_exchange", filename, __line__)
194 IF (cmp_arrays(dst_data%dp, ref_dst_data%dp)) &
195 CALL test_abort(
"error in xt_redist_s_exchange", filename, __line__)
199 END SUBROUTINE simple_test2
201 SUBROUTINE test_empty_redist(comm, config)
203 INTEGER,
INTENT(in) :: comm
204 TYPE(xt_config),
INTENT(in) :: config
206 TYPE(xt_idxlist) :: src_idxlist, dst_idxlist
207 TYPE(xt_xmap) :: xmap
208 TYPE(xt_redist) :: redist, redist_coll, redist_copy
232 END SUBROUTINE test_empty_redist
234 SUBROUTINE test_repeated_redist_ds(redist_coll, src_data, permutation)
235 TYPE(xt_redist),
INTENT(in) :: redist_coll
236 DOUBLE PRECISION,
INTENT(in),
TARGET :: src_data(5, 3)
237 INTEGER,
INTENT(in) :: permutation(3)
239 DOUBLE PRECISION,
PARAMETER :: ref_dst_data(3, 3) &
240 = reshape((/ ((dble(i + j), i = 1,5,2), j = 0,10,5) /), (/ 3, 3 /))
241 DOUBLE PRECISION,
TARGET :: dst_data(3, 3)
242 TYPE(c_ptr) :: src_data_p(3), dst_data_p(3)
245 TYPE(xt_request) :: request
248 xt_slice_c_loc(src_data(:, permutation(i)), src_data_p(i))
249 xt_slice_c_loc(dst_data(:, permutation(i)), dst_data_p(i))
258 CALL check_wait_request(request, filename, __line__)
260 IF (cmp_arrays(ref_dst_data, dst_data)) &
261 CALL test_abort(err_msg(iexch), filename, __line__)
263 END SUBROUTINE test_repeated_redist_ds
265 SUBROUTINE test_repeated_redist(comm, config, cache_size)
266 INTEGER,
INTENT(in) :: comm
267 TYPE(xt_config),
INTENT(in) :: config
268 INTEGER,
INTENT(in) :: cache_size
272 INTEGER,
PARAMETER :: num_slice = 3
273 INTEGER,
PARAMETER :: src_slice_len = 5
275 DOUBLE PRECISION,
PARAMETER :: src_data(5, num_slice) = reshape((/&
276 (dble(i), i = 1, 15)/), (/ 5, num_slice /))
277 TYPE(xt_xmap) :: xmap
278 TYPE(xt_redist) :: redists(num_slice), redist_coll, redist_coll_copy
279 INTEGER,
PARAMETER :: permutation(3, 3) &
280 = reshape((/ 1, 2, 3, 2, 1, 3, 1, 2, 3 /), (/ 3, 3 /))
282 xmap = build_odd_selection_xmap(src_slice_len)
298 CALL test_repeated_redist_ds(redist_coll, src_data, permutation(:, i))
307 CALL test_repeated_redist_ds(redist_coll_copy, src_data, permutation(:, i))
312 END SUBROUTINE test_repeated_redist
314 END PROGRAM test_redist_collection
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_a_exchange(Xt_redist redist, int num_arrays, const void **src_data, void **dst_data, Xt_request *request)
void xt_redist_s_exchange(Xt_redist redist, int num_arrays, const void **src_data, void **dst_data)
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)