Commit 87c43aa2 authored by Thomas Jahns's avatar Thomas Jahns 🤸
Browse files

Add adjustable exchangers to parallel redist collection tests.

parent 792b9966
......@@ -67,28 +67,29 @@ enum {
};
static void
test_4redist(MPI_Comm comm);
test_4redist(MPI_Comm comm, Xt_config config);
static void
test_rr_redist(MPI_Comm comm);
test_rr_redist(MPI_Comm comm, Xt_config config);
int main(void) {
int main(int argc, char **argv) {
// init mpi
xt_mpi_call(MPI_Init(NULL, NULL), MPI_COMM_WORLD);
xt_initialize(MPI_COMM_WORLD);
Xt_config config = redist_exchanger_option(&argc, &argv);
int comm_size;
xt_mpi_call(MPI_Comm_size(MPI_COMM_WORLD, &comm_size), MPI_COMM_WORLD);
if (comm_size > 1) {
test_4redist(MPI_COMM_WORLD, config);
test_4redist(MPI_COMM_WORLD);
test_rr_redist(MPI_COMM_WORLD);
test_rr_redist(MPI_COMM_WORLD, config);
}
xt_config_delete(config);
xt_finalize();
MPI_Finalize();
......@@ -103,7 +104,7 @@ exchange_4redist(Xt_redist redist, MPI_Comm comm,
int sync);
static void
test_4redist(MPI_Comm comm)
test_4redist(MPI_Comm comm, Xt_config config)
{
int comm_rank, comm_size;
xt_mpi_call(MPI_Comm_rank(comm, &comm_rank), comm);
......@@ -122,16 +123,15 @@ test_4redist(MPI_Comm comm)
= { (Xt_int)((Xt_int)2 * comm_size), (Xt_int)((Xt_int)comm_size_sq) };
int local_size[2] = { comm_size, comm_size };
Xt_int local_start[2][2] = {
{0, (Xt_int)((Xt_int)comm_rank * comm_size)},
{ 0, (Xt_int)((Xt_int)comm_rank * comm_size) },
{ (Xt_int)comm_size,
(Xt_int)((Xt_int)comm_size_sq - (Xt_int)(comm_rank+1) * comm_size) }
};
Xt_idxlist indices_a_[2]
= { [0] = xt_idxsection_new(start, 2, global_size, local_size,
local_start[0]),
[1] = xt_idxsection_new(start, 2, global_size, local_size,
local_start[1]) };
Xt_idxlist indices_a_[2];
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);
......@@ -185,8 +185,8 @@ test_4redist(MPI_Comm comm)
for (size_t i = 0; i < num_redists; ++i)
xt_xmap_delete(xmaps[i]);
Xt_redist redist = xt_redist_collection_new(redists, num_redists, -1,
comm);
Xt_redist redist = xt_redist_collection_custom_new(redists, num_redists, -1,
comm, config);
// test communicator of redist
......@@ -298,7 +298,7 @@ check_4redist_result(int comm_size, void *results[4],
enum { elems_per_rank = 5, };
static void
test_rr_redist(MPI_Comm comm)
test_rr_redist(MPI_Comm comm, Xt_config config)
{
int comm_rank, comm_size;
xt_mpi_call(MPI_Comm_rank(comm, &comm_rank), comm);
......@@ -327,7 +327,8 @@ test_rr_redist(MPI_Comm comm)
xt_xmap_delete(xmap);
}
xt_idxlist_delete(src_indices);
Xt_redist redist = xt_redist_collection_new(redists, 2, -1, comm);
Xt_redist redist = xt_redist_collection_custom_new(redists, 2, -1, comm,
config);
// test communicator of redist
if (!communicators_are_congruent(xt_redist_get_MPI_Comm(redist), comm))
......
......@@ -56,12 +56,12 @@ PROGRAM test_redist_collection_parallel
xt_redist, xt_redist_p2p_new, xt_redist_collection_new, &
xt_redist_copy, xt_redist_delete, xt_redist_s_exchange, &
xt_idxlist_get_indices, xt_int_mpidt, &
xt_request, xt_redist_a_exchange
xt_request, xt_redist_a_exchange, xt_config, xt_config_delete
! older PGI compilers do not handle generic interface correctly
#if defined __PGI && (__PGIC__ < 12 || (__PGIC__ == 12 && __PGIC_MINOR__ <= 10))
USE xt_redist_base, ONLY: xt_redist_s_exchange, xt_redist_a_exchange
#endif
USE test_redist_common, ONLY: check_wait_request
USE test_redist_common, ONLY: check_wait_request, redist_exchanger_option
USE iso_c_binding, ONLY: c_loc, c_ptr
#include "xt_slice_c_loc.inc"
IMPLICIT NONE
......@@ -70,9 +70,11 @@ PROGRAM test_redist_collection_parallel
filename = 'test_redist_collection_parallel_f.f90'
CHARACTER(len=*), PARAMETER :: err_msg(2) = &
(/ "error in xt_redist_s_exchange", "error in xt_redist_a_exchange" /)
TYPE(xt_config) :: config
CALL init_mpi
CALL xt_initialize(mpi_comm_world)
config = redist_exchanger_option()
CALL mpi_comm_rank(mpi_comm_world, rank, ierror)
IF (ierror /= MPI_SUCCESS) &
......@@ -82,8 +84,8 @@ PROGRAM test_redist_collection_parallel
CALL test_abort('mpi_comm_size failed', filename, __LINE__)
IF (world_size > 1) THEN
CALL test_4redist
CALL test_rr_exchange
CALL test_4redist(mpi_comm_world, config)
CALL test_rr_exchange(mpi_comm_world, config)
END IF
IF (test_err_count() /= 0) &
......@@ -125,8 +127,10 @@ CONTAINS
indices_all = xt_idxstripes_new(stripe)
END SUBROUTINE build_idxlists
SUBROUTINE test_4redist
SUBROUTINE test_4redist(comm, config)
! redist test with four different redists
INTEGER, INTENT(in) :: comm
TYPE(xt_config), INTENT(in) :: config
INTEGER, PARAMETER :: num_tx = 4
TYPE(xt_idxlist) :: indices_a, indices_b, indices_all
INTEGER(xt_int_kind), ALLOCATABLE :: index_vector_a(:), &
......@@ -143,10 +147,10 @@ CONTAINS
ALLOCATE(index_vector_a(vec_size), index_vector_b(vec_size))
CALL build_idxlists(indices_a, indices_b, indices_all)
xmaps(1) = xt_xmap_all2all_new(indices_a, indices_b, mpi_comm_world)
xmaps(2) = xt_xmap_all2all_new(indices_b, indices_a, mpi_comm_world)
xmaps(3) = xt_xmap_all2all_new(indices_a, indices_all, mpi_comm_world)
xmaps(4) = xt_xmap_all2all_new(indices_b, indices_all, mpi_comm_world)
xmaps(1) = xt_xmap_all2all_new(indices_a, indices_b, comm)
xmaps(2) = xt_xmap_all2all_new(indices_b, indices_a, comm)
xmaps(3) = xt_xmap_all2all_new(indices_a, indices_all, comm)
xmaps(4) = xt_xmap_all2all_new(indices_b, indices_all, comm)
CALL xt_idxlist_get_indices(indices_a, index_vector_a)
CALL xt_idxlist_get_indices(indices_b, index_vector_b)
......@@ -160,10 +164,10 @@ CONTAINS
CALL xt_xmap_delete(xmaps(i))
END DO
redist = xt_redist_collection_new(redists, num_tx, -1, mpi_comm_world)
redist = xt_redist_collection_new(redists, num_tx, -1, comm, config)
! test communicator of redist
! if (!test_communicator(xt_redist_get_MPI_Comm(redist), MPI_COMM_WORLD))
! if (!test_communicator(xt_redist_get_MPI_Comm(redist), COMM))
! PUT_ERR("error in xt_redist_get_MPI_Comm\n");
CALL xt_redist_delete(redists)
......@@ -284,7 +288,10 @@ CONTAINS
! redist test with two redists that do a round robin exchange in
! different directions
SUBROUTINE test_rr_exchange
SUBROUTINE test_rr_exchange(comm, config)
INTEGER, INTENT(in) :: comm
TYPE(xt_config), INTENT(in) :: config
TYPE(xt_idxlist) :: src_indices, dst_indices(2)
INTEGER(xt_int_kind) :: src_indices_(5)
INTEGER(xt_int_kind) :: i, temp, dst_indices_(5, 2)
......@@ -307,8 +314,8 @@ CONTAINS
dst_indices(1) = xt_idxvec_new(dst_indices_(:, 1))
dst_indices(2) = xt_idxvec_new(dst_indices_(:, 2))
xmaps(1) = xt_xmap_all2all_new(src_indices, dst_indices(1), mpi_comm_world)
xmaps(2) = xt_xmap_all2all_new(src_indices, dst_indices(2), mpi_comm_world)
xmaps(1) = xt_xmap_all2all_new(src_indices, dst_indices(1), comm)
xmaps(2) = xt_xmap_all2all_new(src_indices, dst_indices(2), comm)
CALL xt_idxlist_delete(src_indices)
CALL xt_idxlist_delete(dst_indices)
......@@ -318,10 +325,10 @@ CONTAINS
CALL xt_xmap_delete(xmaps)
redist = xt_redist_collection_new(redists, 2, -1, mpi_comm_world)
redist = xt_redist_collection_new(redists, 2, -1, comm, config)
! test communicator of redist
! IF (!test_communicator(xt_redist_get_MPI_Comm(redist), MPI_COMM_WORLD))
! IF (!test_communicator(xt_redist_get_MPI_Comm(redist), comm))
! PUT_ERR("error in xt_redist_get_MPI_Comm\n");
CALL xt_redist_delete(redists)
......
......@@ -5,9 +5,11 @@ export LIBC_FATAL_STDERR_
[ x"@MPI_LAUNCH@" != xtrue ] || exit 77
for nprocs in 2 3 4 8 ; do
@abs_top_builddir@/libtool --mode=execute \
@MPI_LAUNCH@ -n $nprocs @abs_builddir@/test_redist_collection_parallel
@MPI_LAUNCH@ -n $nprocs @abs_builddir@/test_redist_collection_parallel \
"$@"
@abs_top_builddir@/libtool --mode=execute \
@MPI_LAUNCH@ -n $nprocs @abs_builddir@/test_redist_collection_parallel_f
@MPI_LAUNCH@ -n $nprocs @abs_builddir@/test_redist_collection_parallel_f \
"$@"
done
#
# Local Variables:
......
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