Commit 535298e7 authored by Thomas Jahns's avatar Thomas Jahns 🤸
Browse files

Simplify redundant code.

parent 7a2cef6d
......@@ -87,10 +87,9 @@ int main(void) {
= {{ 0, (Xt_int)(rank*size)},
{ (Xt_int)size, (Xt_int)(size*size-(rank+1)*size) }};
indices_a_[0] = xt_idxsection_new(start, 2, global_size, local_size,
local_start[0]);
indices_a_[1] = xt_idxsection_new(start, 2, global_size, local_size,
local_start[1]);
for (size_t i = 0; i < 2; ++i)
indices_a_[i] = xt_idxsection_new(start, 2, global_size, local_size,
local_start[i]);
indices_a = xt_idxlist_collection_new(indices_a_, 2);
......@@ -130,26 +129,20 @@ int main(void) {
for (size_t i = 0; i < dim0; ++i)
input[j][i] = (Xt_int)(index_vector_a[i] + j * 2*(Xt_int)dim0);
static const int displacements[rpt_cnt] = {0, 1, 2, 3};
static const int displacements_2[rpt_cnt] = {1, 2, 4, 8};
MPI_Aint extent
= (MPI_Aint)(dim0 * sizeof(Xt_int));
static const int displacements[2][rpt_cnt] = { {0,1,2,3}, {1,2,4,8} };
MPI_Aint extent = (MPI_Aint)(dim0 * sizeof(Xt_int));
Xt_redist redist_repeat
= xt_redist_repeat_new(redist_p2p, extent, extent, rpt_cnt,
displacements);
Xt_redist redist_repeat_2
= xt_redist_repeat_new(redist_p2p, extent, extent, rpt_cnt,
displacements_2);
Xt_redist redist_repeat[2];
for (size_t i = 0; i < 2; ++i)
redist_repeat[i] = xt_redist_repeat_new(
redist_p2p, extent, extent, rpt_cnt, displacements[i]);
// test communicator of redist_repeat
if (!communicators_are_congruent(xt_redist_get_MPI_Comm(redist_repeat),
MPI_COMM_WORLD))
PUT_ERR("error in xt_redist_get_MPI_Comm\n");
if (!communicators_are_congruent(xt_redist_get_MPI_Comm(redist_repeat_2),
MPI_COMM_WORLD))
PUT_ERR("error in xt_redist_get_MPI_Comm\n");
for (size_t i = 0; i < 2; ++i)
if (!communicators_are_congruent(xt_redist_get_MPI_Comm(
redist_repeat[i]), MPI_COMM_WORLD))
PUT_ERR("error in xt_redist_get_MPI_Comm\n");
xt_redist_delete(redist_p2p);
......@@ -163,12 +156,12 @@ int main(void) {
result_2[j][i] = -1;
if (sync_mode == 0) {
xt_redist_s_exchange1(redist_repeat, input, result);
xt_redist_s_exchange1(redist_repeat_2, input, result_2);
xt_redist_s_exchange1(redist_repeat[0], input, result);
xt_redist_s_exchange1(redist_repeat[1], input, result_2);
} else {
Xt_request request[2];
xt_redist_a_exchange1(redist_repeat, input, result, request+0);
xt_redist_a_exchange1(redist_repeat_2, input, result_2, request+1);
xt_redist_a_exchange1(redist_repeat[0], input, result, request+0);
xt_redist_a_exchange1(redist_repeat[1], input, result_2, request+1);
xt_request_wait(request+0);
xt_request_wait(request+1);
}
......@@ -187,9 +180,8 @@ int main(void) {
}
// clean up
xt_redist_delete(redist_repeat_2);
xt_redist_delete(redist_repeat);
for (size_t i = 0; i < 2; ++i)
xt_redist_delete(redist_repeat[i]);
}
}
......
......@@ -69,19 +69,16 @@ PROGRAM test_redist_repeat_parallel
CHARACTER(len=*), PARAMETER :: filename = 'test_redist_repeat_parallel_f.f90'
CHARACTER(len=*), PARAMETER :: err_msg(2) = &
(/ "error on xt_redist_s_exchange", "error on xt_redist_a_exchange" /)
INTEGER :: comm_rank, comm_size, ierror
INTEGER :: comm_size, ierror
CALL init_mpi
CALL xt_initialize(mpi_comm_world)
CALL mpi_comm_rank(mpi_comm_world, comm_rank, ierror)
IF (ierror /= MPI_SUCCESS) &
CALL test_abort('mpi_comm_rank failed', filename, __LINE__)
CALL mpi_comm_size(mpi_comm_world, comm_size, ierror)
IF (ierror /= MPI_SUCCESS) &
CALL test_abort('mpi_comm_size failed', filename, __LINE__)
IF (comm_size > 1) THEN
CALL test_4redist(2*comm_size**2)
CALL test_4redist(mpi_comm_world, 2*comm_size**2)
END IF
IF (test_err_count() /= 0) &
......@@ -105,8 +102,9 @@ CONTAINS
! 4D array reshaped to [W,X,Z,Y], decomposed along the Y-axis
! according to comm_rank (but enumerated differently from source
! array).
SUBROUTINE build_idxlists(indices_a, indices_b)
SUBROUTINE build_idxlists(indices_a, indices_b, comm_size, comm_rank)
TYPE(xt_idxlist), INTENT(out) :: indices_a, indices_b
INTEGER, INTENT(in) :: comm_size, comm_rank
INTEGER, PARAMETER :: glob_rank = 4
TYPE(xt_idxlist) :: indices_a_(2)
......@@ -152,7 +150,8 @@ CONTAINS
! redist test for 4 level repetition of redist (i.e. 3D extension of 2D
! redist)
SUBROUTINE test_4redist(dim1)
SUBROUTINE test_4redist(comm, dim1)
INTEGER, INTENT(in) :: comm
INTEGER, INTENT(in) :: dim1
TYPE(xt_idxlist) :: indices_a, indices_b
INTEGER(xt_int_kind) :: index_vector_a(dim1), &
......@@ -168,8 +167,9 @@ CONTAINS
INTEGER(mpi_address_kind) :: extent
INTEGER(mpi_address_kind) :: base_address, temp_address
INTEGER(c_int), PARAMETER :: &
displacements(rpt_cnt) = (/ 0_c_int, 1_c_int, 2_c_int, 3_c_int /), &
displacements_2(rpt_cnt) = (/ 1_c_int, 2_c_int, 4_c_int, 8_c_int /)
displacements(rpt_cnt, 2) &
= RESHAPE((/ 0_c_int, 1_c_int, 2_c_int, 3_c_int, &
& 1_c_int, 2_c_int, 4_c_int, 8_c_int /), (/ rpt_cnt, 2 /))
! skip_lev_2 must correspond to the levels skipped via displacements_2
LOGICAL, PARAMETER :: skip_lev_2(9) &
= (/ .TRUE., .FALSE., .FALSE., &
......@@ -178,13 +178,21 @@ CONTAINS
INTEGER :: i, j, ierror
TYPE(xt_request) :: request1, request2
INTEGER :: iexch
INTEGER :: comm_rank, comm_size
CALL mpi_comm_rank(comm, comm_rank, ierror)
IF (ierror /= MPI_SUCCESS) &
CALL test_abort('mpi_comm_rank failed', filename, __LINE__)
CALL mpi_comm_size(comm, comm_size, ierror)
IF (ierror /= MPI_SUCCESS) &
CALL test_abort('mpi_comm_size failed', filename, __LINE__)
CALL build_idxlists(indices_a, indices_b)
CALL build_idxlists(indices_a, indices_b, comm_size, comm_rank)
CALL xt_idxlist_get_indices(indices_a, index_vector_a)
CALL xt_idxlist_get_indices(indices_b, index_vector_b)
xmap = xt_xmap_all2all_new(indices_a, indices_b, mpi_comm_world)
xmap = xt_xmap_all2all_new(indices_a, indices_b, comm)
CALL xt_idxlist_delete(indices_a)
CALL xt_idxlist_delete(indices_b)
......@@ -197,9 +205,9 @@ CONTAINS
extent = temp_address - base_address
redist_repeat = xt_redist_repeat_new(redist_p2p, extent, extent, &
rpt_cnt, displacements)
rpt_cnt, displacements(:, 1))
redist_repeat_2 = xt_redist_repeat_new(redist_p2p, extent, extent, &
rpt_cnt, displacements_2)
rpt_cnt, displacements(:, 2))
CALL xt_redist_delete(redist_p2p)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment