46 PROGRAM test_redist_p2p_f
48 USE yaxt,
ONLY: xt_int_kind, xt_xmap, xt_idxlist, xt_redist, xt_offset_ext, &
61 USE ftest_common,
ONLY: init_mpi, finish_mpi, test_abort
62 USE test_redist_common,
ONLY: check_redist, communicators_are_congruent, &
63 redist_exchanger_option
64 USE test_idxlist_utils,
ONLY: test_err_count
66 CHARACTER(len=*),
PARAMETER :: filename =
'test_redist_p2p_f.f90'
67 TYPE(xt_config) :: config
73 config = redist_exchanger_option()
77 CALL test_without_offsets
78 CALL test_with_offsets
79 CALL test_offset_extents
81 IF (test_err_count() /= 0) &
82 CALL test_abort(
"non-zero error count!", filename, __line__)
90 SUBROUTINE test_without_offsets
91 INTEGER,
PARAMETER :: src_num_indices = 14, dst_num_indices = 13
92 INTEGER(xt_int_kind),
PARAMETER :: src_index_list(src_num_indices) &
93 = (/ 5_xi, 67_xi, 4_xi, 5_xi, 13_xi, &
94 & 9_xi, 2_xi, 1_xi, 0_xi, 96_xi, &
95 & 13_xi, 12_xi, 1_xi, 3_xi /), &
96 dst_index_list(dst_num_indices) = &
97 & (/ 5_xi, 4_xi, 3_xi, 96_xi, 1_xi, &
98 & 5_xi, 4_xi, 5_xi, 4_xi, 3_xi, &
99 & 13_xi, 2_xi, 1_xi /)
102 DOUBLE PRECISION,
PARAMETER :: src_data(src_num_indices) = &
103 (/ (dble(i), i=0,src_num_indices-1) /)
106 DOUBLE PRECISION :: src_data(src_num_indices)
108 DOUBLE PRECISION,
PARAMETER :: ref_dst_data(dst_num_indices) &
109 = (/ 0.0d0, 2.0d0, 13.0d0, 9.0d0, 7.0d0, &
110 & 0.0d0, 2.0d0, 0.0d0, 2.0d0, 13.0d0, &
111 & 4.0d0, 6.0d0, 7.0d0 /)
112 LOGICAL :: src_l(src_num_indices), &
113 dst_l(dst_num_indices), ref_dst_l(dst_num_indices)
114 DOUBLE PRECISION :: dst_data(dst_num_indices)
115 TYPE(xt_idxlist) :: src_idxlist, dst_idxlist
116 TYPE(xt_xmap) :: xmap
117 TYPE(xt_redist) :: redist_dp, redist_copy, redist_l
120 DO i = 1, src_num_indices
121 src_data(i) = dble(i - 1)
136 IF (.NOT. communicators_are_congruent(xt_redist_get_mpi_comm(redist_dp), &
138 CALL test_abort(
"error in xt_redist_get_mpi_Comm", filename, __line__)
141 CALL check_redist(redist_dp, src_data, dst_data, ref_dst_data)
144 src_l = nint(mod(src_data, 2.0d0)) == 1
146 ref_dst_l = nint(mod(ref_dst_data, 2.0d0)) == 1
148 IF (.NOT. communicators_are_congruent(xt_redist_get_mpi_comm(redist_l), &
150 CALL test_abort(
"error in xt_redist_get_mpi_Comm", filename, __line__)
152 IF (any(dst_l .NEQV. ref_dst_l)) &
153 CALL test_abort(
"error in xt_redist_s_exchange for 1D logical array", &
157 CALL check_redist(redist_copy, src_data, dst_data, ref_dst_data)
165 END SUBROUTINE test_without_offsets
167 SUBROUTINE test_with_offsets
169 INTEGER,
PARAMETER :: src_num = 14, dst_num = 13
170 INTEGER(xt_int_kind),
PARAMETER :: src_index_list(src_num) = &
171 (/ 5_xi, 67_xi, 4_xi, 5_xi, 13_xi, &
172 & 9_xi, 2_xi, 1_xi, 0_xi, 96_xi, &
173 & 13_xi, 12_xi, 1_xi, 3_xi /), &
174 dst_index_list(dst_num) = &
175 (/ 5_xi, 4_xi, 3_xi, 96_xi, 1_xi, &
176 & 5_xi, 4_xi, 5_xi, 4_xi, 3_xi, &
177 & 13_xi, 2_xi, 1_xi /)
179 INTEGER,
PARAMETER :: src_pos(src_num) = (/ (i, i = 0, src_num - 1) /), &
180 dst_pos(dst_num) = (/ ( dst_num - i, i = 1, dst_num ) /)
181 TYPE(xt_idxlist) :: src_idxlist, dst_idxlist
182 TYPE(xt_xmap) :: xmap
183 TYPE(xt_redist) :: redist, redist_copy
185 DOUBLE PRECISION,
PARAMETER :: src_data(src_num) = &
186 (/ (dble(i), i=0,src_num-1) /)
189 DOUBLE PRECISION :: src_data(src_num)
191 DOUBLE PRECISION :: dst_data(dst_num)
192 DOUBLE PRECISION,
PARAMETER :: ref_dst_data(dst_num) = &
193 (/ 0.0d0, 2.0d0, 13.0d0, 9.0d0, 7.0d0, &
194 & 0.0d0, 2.0d0, 0.0d0, 2.0d0, 13.0d0, &
195 & 4.0d0, 6.0d0, 7.0d0 /)
199 src_data(i) = dble(i - 1)
211 mpi_double_precision, config)
214 IF (.NOT. communicators_are_congruent(xt_redist_get_mpi_comm(redist), &
216 CALL test_abort(
"error in xt_redist_get_MPI_Comm", filename, __line__)
219 CALL check_redist(redist, src_data, dst_data, ref_dst_data(dst_num:1:-1))
223 CALL check_redist(redist_copy, src_data, dst_data, &
224 ref_dst_data(dst_num:1:-1))
231 END SUBROUTINE test_with_offsets
233 SUBROUTINE test_offset_extents
235 INTEGER,
PARAMETER :: src_num = 14, dst_num = 13
236 INTEGER(xt_int_kind),
PARAMETER :: src_index_list(src_num) = &
237 (/ 5_xi, 67_xi, 4_xi, 5_xi, 13_xi, &
238 & 9_xi, 2_xi, 1_xi, 0_xi, 96_xi, &
239 & 13_xi, 12_xi, 1_xi, 3_xi /), &
240 dst_index_list(dst_num) = &
241 (/ 5_xi, 4_xi, 3_xi, 96_xi, 1_xi, &
242 & 5_xi, 4_xi, 5_xi, 4_xi, 3_xi, &
243 & 13_xi, 2_xi, 1_xi /)
246 INTEGER(xt_int_kind),
PARAMETER :: src_data(src_num) &
247 = (/ (int(i, xi), i = 0, 13) /)
249 INTEGER(xt_int_kind) :: i
250 INTEGER(xt_int_kind),
PARAMETER :: src_data(src_num) &
251 = (/ (i, i = 0_xi, 13_xi) /)
253 INTEGER(xt_int_kind) :: dst_data(dst_num)
254 INTEGER(xt_int_kind),
PARAMETER :: ref_dst_data(dst_num) = &
255 (/ 7_xi, 6_xi, 4_xi, 13_xi, 2_xi, &
256 & 0_xi, 2_xi, 0_xi, 7_xi, 9_xi, &
257 & 13_xi, 2_xi, 0_xi /)
258 TYPE(xt_idxlist) :: src_idxlist, dst_idxlist
259 TYPE(xt_xmap) :: xmap
260 TYPE(xt_redist) :: redist, redist_copy
261 TYPE(xt_offset_ext),
PARAMETER :: &
262 src_pos(1) = (/ xt_offset_ext(0, src_num, 1) /), &
263 dst_pos(1) = (/ xt_offset_ext(dst_num - 1, dst_num, -1) /)
273 IF (.NOT. communicators_are_congruent(xt_redist_get_mpi_comm(redist), &
275 CALL test_abort(
"error in xt_redist_get_MPI_Comm", &
279 CALL check_redist(redist, src_data, dst_data, ref_dst_data)
283 CALL check_redist(redist_copy, src_data, dst_data, ref_dst_data)
290 END SUBROUTINE test_offset_extents
292 END PROGRAM test_redist_p2p_f
void xt_config_delete(Xt_config config)
void xt_initialize(MPI_Comm default_comm)
void xt_idxlist_delete(Xt_idxlist idxlist)
Xt_idxlist xt_idxvec_new(const Xt_int *idxlist, int num_indices)
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 **src_data, void **dst_data)
Xt_redist xt_redist_p2p_new(Xt_xmap xmap, MPI_Datatype datatype)
Xt_redist xt_redist_p2p_off_custom_new(Xt_xmap xmap, const int *src_offsets, const int *dst_offsets, MPI_Datatype datatype, Xt_config config)
Xt_redist xt_redist_p2p_ext_new(Xt_xmap xmap, int num_src_ext, const struct Xt_offset_ext src_extents[], int num_dst_ext, const struct Xt_offset_ext dst_extents[], 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)