Commit 792b9966 authored by Thomas Jahns's avatar Thomas Jahns 🤸
Browse files

Add adjustable exchangers to serial redist collection tests.

parent 89b14bfd
......@@ -57,19 +57,19 @@
#include "core/ppm_xfuncs.h"
static void
simple_test(MPI_Comm comm);
simple_test(MPI_Comm comm, Xt_config config);
static void
test_empty_redist(MPI_Comm comm);
test_empty_redist(MPI_Comm comm, Xt_config config);
static void
test_repeated_redist(MPI_Comm comm, int cache_size);
test_repeated_redist(MPI_Comm comm, Xt_config config, int cache_size);
static void
test_displacement_variations(MPI_Comm comm);
test_displacement_variations(MPI_Comm comm, Xt_config config);
int main(void) {
int main(int argc, char **argv) {
// init mpi
......@@ -77,22 +77,25 @@ int main(void) {
xt_initialize(MPI_COMM_WORLD);
simple_test(MPI_COMM_WORLD);
Xt_config config = redist_exchanger_option(&argc, &argv);
test_empty_redist(MPI_COMM_WORLD);
simple_test(MPI_COMM_WORLD, config);
test_empty_redist(MPI_COMM_WORLD, config);
// test with one redist used three times (with two different input data
// displacements -> test of cache) (with default cache size)
// set up data
test_repeated_redist(MPI_COMM_WORLD, -1);
test_repeated_redist(MPI_COMM_WORLD, config, -1);
// test with one redist used three times (with two different input data
// displacements -> test of cache) (with cache size == 0)
// set up data
test_repeated_redist(MPI_COMM_WORLD, 0);
test_repeated_redist(MPI_COMM_WORLD, config, 0);
test_displacement_variations(MPI_COMM_WORLD);
test_displacement_variations(MPI_COMM_WORLD, config);
xt_config_delete(config);
xt_finalize();
MPI_Finalize();
......@@ -100,7 +103,7 @@ int main(void) {
}
static void
simple_test(MPI_Comm comm)
simple_test(MPI_Comm comm, Xt_config config)
{ // general test with one redist
// set up data
enum { nvalues = 5, nselect = (nvalues + 1)/2 };
......@@ -113,7 +116,7 @@ simple_test(MPI_Comm comm)
// generate redist_collection
Xt_redist redist_coll
= xt_redist_collection_new(&redist, 1, -1, comm);
= xt_redist_collection_custom_new(&redist, 1, -1, comm, config);
// test communicator of redist
if (!communicators_are_congruent(xt_redist_get_MPI_Comm(redist_coll), comm))
......@@ -141,7 +144,7 @@ simple_test(MPI_Comm comm)
}
static void
test_empty_redist(MPI_Comm comm)
test_empty_redist(MPI_Comm comm, Xt_config config)
{ // test empty redist
Xt_idxlist src_idxlist = xt_idxempty_new();
Xt_idxlist dst_idxlist = xt_idxempty_new();
......@@ -155,7 +158,8 @@ test_empty_redist(MPI_Comm comm)
xt_xmap_delete(xmap);
// generate redist_collection
Xt_redist redist_coll = xt_redist_collection_new(&redist, 1, -1, comm);
Xt_redist redist_coll
= xt_redist_collection_custom_new(&redist, 1, -1, comm, config);
// test communicator of redist
if (!communicators_are_congruent(xt_redist_get_MPI_Comm(redist_coll), comm))
......@@ -189,7 +193,7 @@ test_empty_redist(MPI_Comm comm)
static void
test_repeated_redist(MPI_Comm comm, int cache_size)
test_repeated_redist(MPI_Comm comm, Xt_config config, int cache_size)
{
enum { num_slice = 3,
src_slice_len = 5, dst_slice_len = (src_slice_len+1)/2 };
......@@ -202,7 +206,8 @@ test_repeated_redist(MPI_Comm comm, int cache_size)
// generate redist_collection
Xt_redist redists[num_slice] = {redist, redist, redist};
Xt_redist redist_coll
= xt_redist_collection_new(redists, num_slice, cache_size, comm);
= xt_redist_collection_custom_new(redists, num_slice, cache_size, comm,
config);
// test communicator of redist
if (!communicators_are_congruent(xt_redist_get_MPI_Comm(redist_coll), comm))
......@@ -322,7 +327,7 @@ run_displacement_check(Xt_redist redist_coll, int sync)
static void
test_displacement_variations(MPI_Comm comm)
test_displacement_variations(MPI_Comm comm, Xt_config config)
{
// test with one redist used three times (with different input
// data displacements until the cache is full)
......@@ -338,7 +343,7 @@ test_displacement_variations(MPI_Comm comm)
Xt_redist redists[num_redists] = {redist, redist, redist};
Xt_redist redist_coll
= xt_redist_collection_new(redists, num_redists, -1, comm);
= xt_redist_collection_custom_new(redists, num_redists, -1, comm, config);
// test communicator of redist
......
......@@ -52,7 +52,7 @@ MODULE redist_collection_displace
xt_xmap, xt_xmap_delete, &
xt_redist, xt_redist_p2p_new, xt_redist_collection_new, &
Xt_redist_copy, xt_redist_delete, xt_redist_s_exchange, &
xt_request, xt_redist_a_exchange
xt_request, xt_redist_a_exchange, xt_config
! 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
......@@ -82,13 +82,15 @@ CONTAINS
! test with one redist used three times (with different input
! data displacements until the cache is full)
! set up data
SUBROUTINE test_displacement_variations
SUBROUTINE test_displacement_variations(comm, config)
INTEGER, INTENT(in) :: comm
TYPE(xt_config), INTENT(in) :: config
TYPE(xt_xmap) :: xmap
TYPE(xt_redist) :: redist, redists(num_slice), redist_coll, &
redist_coll_copy
xmap = build_odd_selection_xmap(src_slice_len)
redist = xt_redist_p2p_new(xmap, mpi_double_precision)
redist = xt_redist_p2p_new(xmap, mpi_double_precision, config)
CALL xt_xmap_delete(xmap)
......@@ -96,7 +98,7 @@ CONTAINS
redists = redist
redist_coll = xt_redist_collection_new(redists, num_slice, &
cache_size, mpi_comm_world)
cache_size, comm, config)
CALL xt_redist_delete(redist)
......
......@@ -56,7 +56,7 @@ PROGRAM test_redist_collection
xt_redist_delete, xt_redist_copy, &
xt_redist_s_exchange, xt_redist_a_exchange, &
xt_idxempty_new, xt_idxlist_delete, &
xt_idxlist, xt_request
xt_idxlist, xt_request, xt_config, xt_config_delete
#if !defined HAVE_FC_LOGICAL_INTEROP || !defined(__GNUC__) || __GNUC__ > 4 \
|| (__GNUC__ == 4 && __GNUC_MINOR__ > 8)
#else
......@@ -67,7 +67,7 @@ PROGRAM test_redist_collection
USE xt_redist_base, ONLY: xt_redist_s_exchange, xt_redist_a_exchange
#endif
USE test_redist_common, ONLY: build_odd_selection_xmap, check_redist, &
check_wait_request
check_wait_request, redist_exchanger_option
USE iso_c_binding, ONLY: c_loc, c_ptr
USE redist_collection_displace, ONLY: test_displacement_variations
#include "xt_slice_c_loc.inc"
......@@ -75,24 +75,29 @@ PROGRAM test_redist_collection
CHARACTER(len=*), PARAMETER :: filename = 'test_redist_collection_f.f90'
CHARACTER(len=*), PARAMETER :: err_msg(2) = &
(/ "error on xt_redist_s_exchange", "error on xt_redist_a_exchange" /)
TYPE(xt_config) :: config
CALL init_mpi
CALL xt_initialize(mpi_comm_world)
config = redist_exchanger_option()
CALL simple_test
CALL simple_test2
CALL test_empty_redist
CALL test_repeated_redist(-1)
CALL test_repeated_redist(0)
CALL test_displacement_variations
CALL simple_test(mpi_comm_world, config)
CALL simple_test2(mpi_comm_world, config)
CALL test_empty_redist(mpi_comm_world, config)
CALL test_repeated_redist(mpi_comm_world, config, -1)
CALL test_repeated_redist(mpi_comm_world, config, 0)
CALL test_displacement_variations(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 simple_test
SUBROUTINE simple_test(comm, config)
! general test with one redist
INTEGER, INTENT(in) :: comm
TYPE(xt_config), INTENT(in) :: config
! set up data
TYPE(xt_xmap) :: xmap
TYPE(xt_redist) :: redist, redist_coll, redist_copy
......@@ -112,7 +117,7 @@ CONTAINS
redist = redist_copy
! generate redist_collection
redist_coll = xt_redist_collection_new((/ redist /), 1, -1, mpi_comm_world)
redist_coll = xt_redist_collection_new((/ redist /), 1, -1, comm, config)
CALL xt_redist_delete(redist)
......@@ -123,8 +128,10 @@ CONTAINS
CALL xt_redist_delete(redist_coll)
END SUBROUTINE simple_test
SUBROUTINE simple_test2
SUBROUTINE simple_test2(comm, config)
! general test with one redist
INTEGER, INTENT(in) :: comm
TYPE(xt_config), INTENT(in) :: config
! set up data
TYPE(xt_xmap) :: xmap
TYPE(xt_redist) :: redist_coll, redist_copy, &
......@@ -154,7 +161,7 @@ CONTAINS
CALL xt_xmap_delete(xmap)
! generate redist_collection
redist_coll = xt_redist_collection_new(redist_components, mpi_comm_world)
redist_coll = xt_redist_collection_new(redist_components, comm, config)
CALL xt_redist_delete(redist_components)
redist_copy = xt_redist_copy(redist_coll)
CALL xt_redist_delete(redist_coll)
......@@ -191,8 +198,10 @@ CONTAINS
CALL xt_redist_delete(redist_coll)
END SUBROUTINE simple_test2
SUBROUTINE test_empty_redist
SUBROUTINE test_empty_redist(comm, config)
! general test with empty redist
INTEGER, INTENT(in) :: comm
TYPE(xt_config), INTENT(in) :: config
! set up data
TYPE(xt_idxlist) :: src_idxlist, dst_idxlist
TYPE(xt_xmap) :: xmap
......@@ -202,7 +211,7 @@ CONTAINS
src_idxlist = xt_idxempty_new()
dst_idxlist = xt_idxempty_new()
xmap = xt_xmap_all2all_new(src_idxlist, dst_idxlist, mpi_comm_world)
xmap = xt_xmap_all2all_new(src_idxlist, dst_idxlist, comm)
CALL xt_idxlist_delete(src_idxlist)
CALL xt_idxlist_delete(dst_idxlist)
......@@ -214,7 +223,7 @@ CONTAINS
redist = redist_copy
! generate redist_collection
redist_coll = xt_redist_collection_new((/ redist /), 1, -1, mpi_comm_world)
redist_coll = xt_redist_collection_new((/ redist /), 1, -1, comm, config)
CALL xt_redist_delete(redist)
......@@ -253,7 +262,9 @@ CONTAINS
ENDDO
END SUBROUTINE test_repeated_redist_ds
SUBROUTINE test_repeated_redist(cache_size)
SUBROUTINE test_repeated_redist(comm, config, cache_size)
INTEGER, INTENT(in) :: comm
TYPE(xt_config), INTENT(in) :: config
INTEGER, INTENT(in) :: cache_size
! test with one redist used three times (with two different input data
! displacements -> test of cache) (with default cache size)
......@@ -277,7 +288,7 @@ CONTAINS
! generate redist_collection
redist_coll = xt_redist_collection_new(redists, 3, cache_size, &
mpi_comm_world)
comm, config)
CALL xt_redist_delete(redists(1))
......
......@@ -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_collection
@MPI_LAUNCH@ -n 1 @abs_builddir@/test_redist_collection "$@"
@abs_top_builddir@/libtool --mode=execute \
@MPI_LAUNCH@ -n 1 @abs_builddir@/test_redist_collection_f
@MPI_LAUNCH@ -n 1 @abs_builddir@/test_redist_collection_f "$@"
#
# Local Variables:
# mode: sh
......
......@@ -48,6 +48,7 @@
#endif
#include <string.h>
#include <unistd.h>
#include "yaxt.h"
#include "tests.h"
......@@ -277,6 +278,33 @@ exchanger_id_by_name(const char *name)
return exchanger_new;
}
Xt_config
redist_exchanger_option(int *argc, char ***argv)
{
Xt_config config = xt_config_new();
int opt;
while ((opt = getopt(*argc, *argv, "m:")) != -1)
switch (opt) {
case 'm':
{
int exchanger_id = exchanger_id_by_name(optarg);
if (exchanger_id != -1)
xt_config_set_exchange_method(config, exchanger_id);
else {
fprintf(stderr, "error: unexpected command-line argument for "
"option -m: %s\n", optarg);
xt_config_delete(config);
return NULL;
}
}
case '?':
break;
}
return config;
}
/*
* Local Variables:
* c-basic-offset: 2
......
......@@ -168,6 +168,8 @@ check_wait_request_(Xt_request *request, const char *file, int line);
int
exchanger_id_by_name(const char *name);
Xt_config
redist_exchanger_option(int *argc, char ***argv);
#endif
/*
......
......@@ -47,7 +47,7 @@
!
MODULE test_redist_common
USE xt_core, ONLY: i2, i4, i8
USE iso_c_binding, ONLY: c_loc
USE iso_c_binding, ONLY: c_loc, c_int, c_char, c_null_char
USE mpi
USE yaxt, ONLY: xt_idxlist, xt_int_kind, xt_idxvec_new, xt_idxlist_delete, &
xt_xmap, xt_xmap_all2all_new, xt_redist, xt_redist_msg, xt_redist_copy, &
......@@ -56,7 +56,8 @@ MODULE test_redist_common
xt_redist_a_exchange1, xt_redist_get_mpi_comm, &
xt_request, xt_request_wait, xt_request_test, xt_is_null, &
xt_redist_get_num_recv_msg, xt_redist_get_num_send_msg, &
xi => xt_int_kind
xi => xt_int_kind, xt_config, xt_config_new, &
xt_config_set_exchange_method
#ifdef __PGI
! PGI up to at least 15.4 has a bug that prevents proper import of
! multiply extended generics. This is a separate bug from the one exhibited
......@@ -108,6 +109,7 @@ MODULE test_redist_common
PUBLIC :: build_odd_selection_xmap, check_redist, communicators_are_congruent
PUBLIC :: check_wait_request, check_test_request, check_redist_xi
PUBLIC :: test_redist_single_array_base
PUBLIC :: redist_exchanger_option
CHARACTER(len=*), PARAMETER :: filename = 'test_redist_common_f.f90'
......@@ -574,6 +576,53 @@ CONTAINS
END SUBROUTINE check_redist_extended_dp
FUNCTION redist_exchanger_option() RESULT(config)
TYPE(xt_config) :: config
INTEGER :: i, j, num_cmd_args, arg_len
INTEGER(c_int) :: exchanger_id
INTEGER, PARAMETER :: max_opt_arg_len = 80
CHARACTER(max_opt_arg_len) :: optarg
CHARACTER(len=1, kind=c_char) :: optarg_c(max_opt_arg_len+1)
INTERFACE
FUNCTION exchanger_id_by_name(name) RESULT(exchanger_id) &
BIND(c, name='exchanger_id_by_name')
IMPORT :: c_char, c_int
CHARACTER(len=1, kind=c_char), INTENT(in) :: name(*)
INTEGER(c_int) :: exchanger_id
END FUNCTION exchanger_id_by_name
END INTERFACE
config = xt_config_new()
num_cmd_args = COMMAND_ARGUMENT_COUNT()
i = 1
DO WHILE (i < num_cmd_args)
CALL GET_COMMAND_ARGUMENT(i, optarg, arg_len)
IF (optarg(1:2) == '-m' .AND. i < num_cmd_args .AND. arg_len == 2) THEN
CALL GET_COMMAND_ARGUMENT(i + 1, optarg, arg_len)
IF (arg_len > max_opt_arg_len) &
CALL test_abort('incorrect argument to command-line option -s', &
filename, __LINE__)
DO j = 1, arg_len
optarg_c(j) = optarg(j:j)
END DO
optarg_c(arg_len+1) = c_null_char
exchanger_id = exchanger_id_by_name(optarg_c)
IF (exchanger_id == -1_c_int) THEN
WRITE (0, *) 'arg to -m: ', optarg(1:arg_len)
CALL test_abort('incorrect argument to command-line option -m', &
filename, __LINE__)
END IF
CALL xt_config_set_exchange_method(config, INT(exchanger_id))
i = i + 2
ELSE
WRITE (0, *) 'unexpected command-line argument parsing error: ', &
optarg(1:arg_len)
FLUSH(0)
CALL test_abort('unexpected command-line argument', &
filename, __LINE__)
END IF
END DO
END FUNCTION redist_exchanger_option
END MODULE test_redist_common
!
! 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