Commit 7afe7695 authored by Thomas Jahns's avatar Thomas Jahns 🤸
Browse files

Add adjustable exchangers to parallel single array base redist tests.

parent 0e977ade
......@@ -132,17 +132,19 @@ test_redist_single_array_base_(int nsend, const struct Xt_redist_msg *send_msgs,
MPI_Datatype dst_data_dt,
MPI_Datatype ref_dst_data_dt,
MPI_Comm comm,
Xt_config config,
const char *file, int line);
#define test_redist_single_array_base(nsend, send_msgs, nrecv, recv_msgs, \
src_data, num_dst, dst_data, dst_prep, \
dst_prep_info, ref_dst_data, \
dst_data_dt, ref_dst_data_dt, comm) \
dst_data_dt, ref_dst_data_dt, comm, \
config) \
test_redist_single_array_base_(nsend, send_msgs, nrecv, recv_msgs, \
src_data, num_dst, dst_data, dst_prep, \
dst_prep_info, ref_dst_data, \
dst_data_dt, ref_dst_data_dt, comm, __FILE__, \
__LINE__)
dst_data_dt, ref_dst_data_dt, comm, config, \
__FILE__, __LINE__)
void
wrap_a_exchange(Xt_redist redist, int num_data_p, const void *src_data_p[],
......
......@@ -530,18 +530,19 @@ CONTAINS
END SUBROUTINE check_redist_i8
SUBROUTINE test_redist_single_array_base_dp( &
send_msgs, recv_msgs, src_data, ref_dst_data, comm)
send_msgs, recv_msgs, src_data, ref_dst_data, comm, config)
TYPE(xt_redist_msg), INTENT(in) :: send_msgs(:)
TYPE(xt_redist_msg), INTENT(in) :: recv_msgs(:)
DOUBLE PRECISION, INTENT(in) :: src_data(:)
DOUBLE PRECISION, INTENT(in) :: ref_dst_data(:)
INTEGER, INTENT(in) :: comm
TYPE(xt_config), INTENT(in) :: config
TYPE(xt_redist) :: redist
INTEGER :: nsend, nrecv
redist = &
xt_redist_single_array_base_new(send_msgs, recv_msgs, comm)
xt_redist_single_array_base_new(send_msgs, recv_msgs, comm, config)
nsend = SIZE(send_msgs)
IF (nsend /= xt_redist_get_num_send_msg(redist)) &
CALL test_abort("error in xt_redist_get_num_send_msg", &
......
......@@ -60,7 +60,7 @@
#include "tests.h"
#include "test_redist_common.h"
int main(void) {
int main(int argc, char **argv) {
// init mpi
......@@ -69,6 +69,7 @@ int main(void) {
xt_mpi_call(MPI_Init(NULL, NULL), comm);
xt_initialize(comm);
Xt_config config = redist_exchanger_option(&argc, &argv);
// single double
{
......@@ -86,7 +87,7 @@ int main(void) {
test_redist_single_array_base(nsend, send_msgs, nrecv, recv_msgs,
src_data, num_ref_values, dst_data,
fill_array_double, NULL, ref_dst_data,
MPI_DOUBLE, MPI_DOUBLE, comm);
MPI_DOUBLE, MPI_DOUBLE, comm, config);
}
// reverse order of some doubles
......@@ -115,12 +116,13 @@ int main(void) {
test_redist_single_array_base(nsend, send_msgs, nrecv, recv_msgs,
src_data, num_ref_values, dst_data,
fill_array_float, NULL, ref_dst_data,
MPI_FLOAT, MPI_FLOAT, comm);
MPI_FLOAT, MPI_FLOAT, comm, config);
// clean up
xt_mpi_call(MPI_Type_free(&recv_type), comm);
xt_mpi_call(MPI_Type_free(&send_type), comm);
}
xt_config_delete(config);
xt_finalize();
xt_mpi_call(MPI_Finalize(), comm);
......
......@@ -60,10 +60,11 @@ test_redist_single_array_base_(int nsend, const struct Xt_redist_msg *send_msgs,
MPI_Datatype dst_data_dt,
MPI_Datatype ref_dst_data_dt,
MPI_Comm comm,
Xt_config config,
const char *file, int line)
{
Xt_redist redist =
xt_redist_single_array_base_new(nsend, nrecv, send_msgs, recv_msgs, comm);
Xt_redist redist = xt_redist_single_array_base_custom_new(
nsend, nrecv, send_msgs, recv_msgs, comm, config);
// test number of send messages
if (nsend != xt_redist_get_num_send_msg(redist))
PUT_ERR("error in xt_redist_get_num_send_msg\n");
......
......@@ -45,34 +45,42 @@
!
PROGRAM test_redist_single_array_base_f
USE mpi
USE yaxt, ONLY: xt_initialize, xt_finalize, xt_redist_msg
USE yaxt, ONLY: xt_initialize, xt_finalize, xt_redist_msg, &
xt_config, xt_config_delete
USE ftest_common, ONLY: init_mpi, finish_mpi, test_abort
USE test_redist_common, ONLY: communicators_are_congruent, &
test_redist_single_array_base
test_redist_single_array_base, redist_exchanger_option
USE test_idxlist_utils, ONLY: test_err_count
IMPLICIT NONE
CHARACTER(len=*), PARAMETER :: &
filename = 'test_redist_single_array_base_f.f90'
TYPE(xt_config) :: config
! init mpi
CALL init_mpi
CALL xt_initialize(mpi_comm_world)
config = redist_exchanger_option()
! single double
call test_single_double
CALL test_single_double(mpi_comm_world, config)
! reverse order of some doubles
call test_reverse_doubles
CALL test_reverse_doubles(mpi_comm_world, config)
IF (test_err_count() /= 0) &
CALL test_abort("non-zero error count!", filename, __LINE__)
CALL xt_config_delete(config)
CALL xt_finalize
CALL finish_mpi
CONTAINS
SUBROUTINE test_single_double
SUBROUTINE test_single_double(comm, config)
INTEGER, INTENT(in) :: comm
TYPE(xt_config), INTENT(in) :: config
TYPE(xt_redist_msg) :: send_msgs(1)
TYPE(xt_redist_msg) :: recv_msgs(1)
......@@ -89,11 +97,14 @@ CONTAINS
recv_msgs(1)%datatype = MPI_DOUBLE_PRECISION
CALL test_redist_single_array_base(send_msgs, recv_msgs, src_data, &
ref_dst_data, mpi_comm_world)
ref_dst_data, comm, config)
END SUBROUTINE test_single_double
SUBROUTINE test_reverse_doubles
SUBROUTINE test_reverse_doubles(comm, config)
INTEGER, INTENT(in) :: comm
TYPE(xt_config), INTENT(in) :: config
TYPE(xt_redist_msg) :: send_msgs(1)
TYPE(xt_redist_msg) :: recv_msgs(1)
......@@ -139,7 +150,7 @@ CONTAINS
filename, __LINE__)
CALL test_redist_single_array_base(send_msgs, recv_msgs, src_data, &
ref_dst_data, mpi_comm_world)
ref_dst_data, comm, config)
CALL MPI_Type_free(recv_msgs(1)%datatype, ierror)
IF (ierror /= mpi_success) &
......
......@@ -58,7 +58,7 @@
#include "test_redist_common.h"
#include "core/ppm_xfuncs.h"
int main(void) {
int main(int argc, char **argv) {
// init mpi
......@@ -68,6 +68,7 @@ int main(void) {
xt_mpi_call(MPI_Init(NULL, NULL), comm);
xt_initialize(comm);
Xt_config config = redist_exchanger_option(&argc, &argv);
xt_mpi_call(MPI_Comm_rank(comm, &rank), comm);
xt_mpi_call(MPI_Comm_size(comm, &size), comm);
......@@ -93,7 +94,7 @@ int main(void) {
test_redist_single_array_base(nsend, send_msgs, nrecv, recv_msgs,
src_data, num_dst_values, dst_data,
fill_array_double, NULL, ref_dst_data,
MPI_DOUBLE, MPI_DOUBLE, comm);
MPI_DOUBLE, MPI_DOUBLE, comm, config);
}
// allgather
......@@ -127,7 +128,7 @@ int main(void) {
test_redist_single_array_base(nsend, send_msgs, nrecv, recv_msgs,
src_data, (size_t)size, dst_data,
fill_array_double, NULL, ref_dst_data,
MPI_DOUBLE, MPI_DOUBLE, comm);
MPI_DOUBLE, MPI_DOUBLE, comm, config);
// clean up
free(dst_data);
free(ref_dst_data);
......@@ -166,7 +167,7 @@ int main(void) {
test_redist_single_array_base(nsend, send_msgs, nrecv, recv_msgs,
src_data, num_dst_values, dst_data,
fill_array_double, NULL, ref_dst_data,
MPI_DOUBLE, MPI_DOUBLE, comm);
MPI_DOUBLE, MPI_DOUBLE, comm, config);
// clean up
......@@ -176,6 +177,7 @@ int main(void) {
free(send_msgs);
}
xt_config_delete(config);
xt_finalize();
xt_mpi_call(MPI_Finalize(), comm);
......
......@@ -45,48 +45,54 @@
!
PROGRAM test_redist_single_array_base_parallel_f
USE mpi
USE yaxt, ONLY: xt_initialize, xt_finalize, xt_redist_msg
USE yaxt, ONLY: xt_initialize, xt_finalize, xt_redist_msg, &
xt_config, xt_config_delete
USE ftest_common, ONLY: init_mpi, finish_mpi, test_abort
USE test_redist_common, ONLY: communicators_are_congruent, &
test_redist_single_array_base
test_redist_single_array_base, redist_exchanger_option
USE test_idxlist_utils, ONLY: test_err_count
IMPLICIT NONE
INTEGER :: comm_rank, comm_size, ierror
CHARACTER(len=*), PARAMETER :: &
filename = 'test_redist_single_array_base_parallel_f.f90'
TYPE(xt_config) :: config
CALL init_mpi
CALL xt_initialize(mpi_comm_world)
config = redist_exchanger_option()
CALL mpi_comm_rank(mpi_comm_world, comm_rank, ierror)
IF (ierror /= mpi_success) &
CALL test_abort("MPI error!", filename, __LINE__)
CALL mpi_comm_size(mpi_comm_world, comm_size, ierror)
IF (ierror /= mpi_success) &
CALL test_abort("MPI error!", filename, __LINE__)
CALL test_round_robin
CALL test_allgather
CALL test_scatter
CALL test_round_robin(mpi_comm_world, config)
CALL test_allgather(mpi_comm_world, config)
CALL test_scatter(mpi_comm_world, config)
IF (test_err_count() /= 0) &
CALL test_abort("non-zero error count!", filename, __LINE__)
CALL xt_config_delete(config)
CALL xt_finalize
CALL finish_mpi
CONTAINS
SUBROUTINE test_round_robin
SUBROUTINE test_round_robin(comm, config)
INTEGER, INTENT(in) :: comm
TYPE(xt_config), INTENT(in) :: config
TYPE(xt_redist_msg) :: send_msgs(1), recv_msgs(1)
INTEGER, PARAMETER :: num_elem = 1
DOUBLE PRECISION :: src_data(num_elem)
DOUBLE PRECISION :: ref_dst_data(num_elem)
INTEGER :: comm_rank, comm_size, ierror
CALL mpi_comm_rank(mpi_comm_world, comm_rank, ierror)
IF (ierror /= mpi_success) &
CALL test_abort("MPI error!", filename, __LINE__)
CALL mpi_comm_size(comm, comm_size, ierror)
IF (ierror /= mpi_success) &
CALL test_abort("MPI error!", filename, __LINE__)
send_msgs(1)%rank = MOD(comm_rank + 1, comm_size)
send_msgs(1)%datatype = MPI_DOUBLE_PRECISION
......@@ -97,20 +103,31 @@ CONTAINS
ref_dst_data(1) = DBLE(MOD(comm_rank + comm_size - 1, comm_size))
CALL test_redist_single_array_base(send_msgs, recv_msgs, src_data, &
ref_dst_data, mpi_comm_world)
ref_dst_data, comm, config)
END SUBROUTINE test_round_robin
SUBROUTINE test_allgather
SUBROUTINE test_allgather(comm, config)
INTEGER, INTENT(in) :: comm
TYPE(xt_config), INTENT(in) :: config
TYPE(xt_redist_msg) :: send_msgs(comm_size)
TYPE(xt_redist_msg) :: recv_msgs(comm_size)
TYPE(xt_redist_msg), ALLOCATABLE :: send_msgs(:), recv_msgs(:)
DOUBLE PRECISION :: src_data(1)
DOUBLE PRECISION :: ref_dst_data(comm_size)
DOUBLE PRECISION, ALLOCATABLE :: ref_dst_data(:)
INTEGER :: comm_rank, comm_size, i, ierror
INTEGER :: i, ierror
CALL mpi_comm_rank(mpi_comm_world, comm_rank, ierror)
IF (ierror /= mpi_success) &
CALL test_abort("MPI error!", filename, __LINE__)
CALL mpi_comm_size(mpi_comm_world, comm_size, ierror)
IF (ierror /= mpi_success) &
CALL test_abort("MPI error!", filename, __LINE__)
ALLOCATE(send_msgs(comm_size), recv_msgs(comm_size), &
ref_dst_data(comm_size))
DO i = 1, comm_size
send_msgs(i)%rank = i - 1
send_msgs(i)%datatype = MPI_DOUBLE_PRECISION
......@@ -131,7 +148,7 @@ CONTAINS
END DO
CALL test_redist_single_array_base(send_msgs, recv_msgs, src_data, &
ref_dst_data, mpi_comm_world)
ref_dst_data, comm, config)
DO i = 1, comm_size
CALL MPI_Type_free(recv_msgs(i)%datatype, ierror)
......@@ -141,7 +158,9 @@ CONTAINS
END SUBROUTINE test_allgather
SUBROUTINE test_scatter
SUBROUTINE test_scatter(comm, config)
INTEGER, INTENT(in) :: comm
TYPE(xt_config), INTENT(in) :: config
TYPE(xt_redist_msg), ALLOCATABLE :: send_msgs(:)
TYPE(xt_redist_msg) :: recv_msgs(1)
......@@ -149,7 +168,16 @@ CONTAINS
DOUBLE PRECISION, ALLOCATABLE :: src_data(:)
DOUBLE PRECISION :: ref_dst_data(1)
INTEGER :: i, ierror, nsend, rank, displ(1)
INTEGER :: comm_size, comm_rank, i, ierror, nsend, rank, displ(1)
CALL mpi_comm_rank(mpi_comm_world, comm_rank, ierror)
IF (ierror /= mpi_success) &
CALL test_abort("MPI error!", filename, __LINE__)
ref_dst_data(1) = DBLE(comm_rank)
CALL mpi_comm_size(mpi_comm_world, comm_size, ierror)
IF (ierror /= mpi_success) &
CALL test_abort("MPI error!", filename, __LINE__)
nsend = MERGE(comm_size, 0, comm_rank == 0)
ALLOCATE(send_msgs(nsend))
......@@ -173,10 +201,9 @@ CONTAINS
DO i = 1, nsend
src_data(i) = DBLE(i-1)
END DO
ref_dst_data(1) = DBLE(comm_rank)
CALL test_redist_single_array_base(send_msgs, recv_msgs, src_data, &
ref_dst_data, mpi_comm_world)
ref_dst_data, comm, config)
DO i = 1, nsend
CALL MPI_Type_free(send_msgs(i)%datatype, ierror)
......
......@@ -4,9 +4,11 @@ LIBC_FATAL_STDERR_=1
export LIBC_FATAL_STDERR_
[ x"@MPI_LAUNCH@" != xtrue ] || exit 77
@abs_top_builddir@/libtool --mode=execute \
@MPI_LAUNCH@ -n 4 @abs_builddir@/test_redist_single_array_base_parallel
@MPI_LAUNCH@ -n 4 \
@abs_builddir@/test_redist_single_array_base_parallel "$@"
@abs_top_builddir@/libtool --mode=execute \
@MPI_LAUNCH@ -n 4 @abs_builddir@/test_redist_single_array_base_parallel_f
@MPI_LAUNCH@ -n 4 \
@abs_builddir@/test_redist_single_array_base_parallel_f "$@"
#
# Local Variables:
# mode: sh
......
......@@ -4,9 +4,9 @@ LIBC_FATAL_STDERR_=1
export LIBC_FATAL_STDERR_
[ x"@MPI_LAUNCH@" != xtrue ] || exit 77
@abs_top_builddir@/libtool --mode=execute \
@MPI_LAUNCH@ -n 1 @abs_builddir@/test_redist_single_array_base
@MPI_LAUNCH@ -n 1 @abs_builddir@/test_redist_single_array_base "$@"
@abs_top_builddir@/libtool --mode=execute \
@MPI_LAUNCH@ -n 1 @abs_builddir@/test_redist_single_array_base_f
@MPI_LAUNCH@ -n 1 @abs_builddir@/test_redist_single_array_base_f "$@"
#
# Local Variables:
# mode: sh
......
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