48 PROGRAM test_redist_repeat_parallel
50 USE ftest_common,
ONLY: init_mpi, finish_mpi, test_abort
51 USE test_idxlist_utils,
ONLY: test_err_count
66 USE test_redist_common,
ONLY: check_wait_request, redist_exchanger_option
67 USE iso_c_binding,
ONLY: c_int
69 CHARACTER(len=*),
PARAMETER :: filename =
'test_redist_repeat_parallel_f.f90'
70 CHARACTER(len=*),
PARAMETER :: err_msg(2) = &
71 (/
"error on xt_redist_s_exchange",
"error on xt_redist_a_exchange" /)
72 TYPE(xt_config) :: config
73 INTEGER :: comm_size, ierror
76 config = redist_exchanger_option()
78 CALL mpi_comm_size(mpi_comm_world, comm_size, ierror)
79 IF (ierror /= mpi_success) &
80 CALL test_abort(
'mpi_comm_size failed', filename, __line__)
82 IF (comm_size > 1)
THEN
83 CALL test_4redist(mpi_comm_world, config, 2*comm_size**2)
86 IF (test_err_count() /= 0) &
87 CALL test_abort(
"non-zero error count!", filename, __line__)
108 SUBROUTINE build_idxlists(indices_a, indices_b, comm_size, comm_rank)
109 TYPE(xt_idxlist),
INTENT(out) :: indices_a, indices_b
110 INTEGER,
INTENT(in) :: comm_size, comm_rank
112 INTEGER,
PARAMETER :: glob_rank = 4
113 TYPE(xt_idxlist) :: indices_a_(2)
115 INTEGER(xt_int_kind),
PARAMETER :: start = 0
116 INTEGER(xt_int_kind) :: global_size(glob_rank), local_start(glob_rank, 2)
117 INTEGER :: local_size(glob_rank)
119 TYPE(xt_stripe) :: stripe
121 global_size(1) = int(comm_size, xi)
122 global_size(2) = int(comm_size, xi)
123 global_size(3) = int(comm_size, xi)
124 global_size(4) = 2_xi
125 local_size(1) = comm_size
127 local_size(3) = comm_size
129 local_start(1, 1) = 1_xi
130 local_start(2, 1) = int(comm_rank + 1, xi)
131 local_start(3, 1) = 1_xi
132 local_start(4, 1) = 1_xi
134 local_start(1, 2) = 1_xi
135 local_start(2, 2) = int(comm_size-comm_rank, xi)
136 local_start(3, 2) = 1_xi
137 local_start(4, 2) = 2_xi
140 indices_a_(i) = xt_idxfsection_new(start, global_size, local_size, &
148 stripe = xt_stripe(start = int(comm_rank * 2 * comm_size**2, xi), &
150 & nstrides = int(2*comm_size**2, c_int))
152 END SUBROUTINE build_idxlists
156 SUBROUTINE test_4redist(comm, config, dim1)
157 INTEGER,
INTENT(in) :: comm
158 TYPE(xt_config),
INTENT(in) :: config
159 INTEGER,
INTENT(in) :: dim1
160 TYPE(xt_idxlist) :: indices_a, indices_b
161 INTEGER(xt_int_kind) :: index_vector_a(dim1), &
163 TYPE(xt_xmap) :: xmap
164 TYPE(xt_redist) :: redist_repeat, redist_repeat_2, redist_p2p
165 INTEGER,
PARAMETER :: dim2a = 9, rpt_cnt = 4
166 INTEGER(xt_int_kind) :: results_1(dim1,rpt_cnt), &
167 results_2(dim1,dim2a), dim1_xi
168 INTEGER(xt_int_kind) :: input_data(dim1,dim2a)
169 INTEGER(xt_int_kind) :: ref_results_1(dim1,rpt_cnt), &
170 ref_results_2(dim1,dim2a)
171 INTEGER(mpi_address_kind) :: extent
172 INTEGER(mpi_address_kind) :: base_address, temp_address
173 INTEGER(c_int),
PARAMETER :: &
174 displacements(rpt_cnt, 2) &
175 = reshape((/ 0_c_int, 1_c_int, 2_c_int, 3_c_int, &
176 & 1_c_int, 2_c_int, 4_c_int, 8_c_int /), (/ rpt_cnt, 2 /))
178 LOGICAL,
PARAMETER :: skip_lev_2(9) &
179 = (/ .true., .false., .false., &
180 & .true., .false., .true., &
181 & .true., .true., .false. /)
182 INTEGER :: i, j, ierror
183 TYPE(xt_request) :: request1, request2
185 INTEGER :: comm_rank, comm_size
187 CALL mpi_comm_rank(comm, comm_rank, ierror)
188 IF (ierror /= mpi_success) &
189 CALL test_abort(
'mpi_comm_rank failed', filename, __line__)
190 CALL mpi_comm_size(comm, comm_size, ierror)
191 IF (ierror /= mpi_success) &
192 CALL test_abort(
'mpi_comm_size failed', filename, __line__)
194 CALL build_idxlists(indices_a, indices_b, comm_size, comm_rank)
207 CALL mpi_get_address(input_data(1,1), base_address, ierror)
208 CALL mpi_get_address(input_data(1,2), temp_address, ierror)
209 extent = temp_address - base_address
212 rpt_cnt, displacements(:, 1), config)
214 rpt_cnt, displacements(:, 2), config)
218 dim1_xi = int(dim1, xi)
221 input_data(i, j) = index_vector_a(i) + int(j-1, xi) * 2_xi * dim1_xi
227 ref_results_1(i, j) = index_vector_b(i) + int(j-1, xi) * 2_xi * dim1_xi
231 IF (skip_lev_2(j))
THEN
232 ref_results_2(:, j) = -1_xi
235 ref_results_2(i, j) &
236 = index_vector_b(i) + int(j-1, xi) * 2_xi * dim1_xi
253 CALL check_wait_request(request1, filename, __line__)
254 CALL check_wait_request(request2, filename, __line__)
258 IF (any(results_1 /= ref_results_1)) &
259 CALL test_abort(err_msg(iexch), filename, __line__)
260 IF (any(results_2 /= ref_results_2)) &
261 CALL test_abort(err_msg(iexch), filename, __line__)
267 END SUBROUTINE test_4redist
269 END PROGRAM test_redist_repeat_parallel
void xt_config_delete(Xt_config config)
void xt_initialize(MPI_Comm default_comm)
void xt_idxlist_get_indices(Xt_idxlist idxlist, Xt_int *indices)
void xt_idxlist_delete(Xt_idxlist idxlist)
Xt_idxlist xt_idxlist_collection_new(Xt_idxlist *idxlists, int num_idxlists)
Xt_idxlist xt_idxstripes_new(struct Xt_stripe const *stripes, int num_stripes)
void xt_redist_delete(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_p2p_new(Xt_xmap xmap, MPI_Datatype datatype)
Xt_redist xt_redist_repeat_new(Xt_redist redist, MPI_Aint src_extent, MPI_Aint dst_extent, int num_repetitions, const int displacements[num_repetitions])
void xt_xmap_delete(Xt_xmap xmap)
Xt_xmap xt_xmap_all2all_new(Xt_idxlist src_idxlist, Xt_idxlist dst_idxlist, MPI_Comm comm)