Commit 60c84653 authored by Moritz Hanke's avatar Moritz Hanke

add new redist interface xt_redist_get_num_send_msg and xt_redist_get_num_recv_msg

parent eb3ff7c1
......@@ -150,6 +150,24 @@ void xt_redist_s_exchange1(Xt_redist redist, const void *src_data, void *dst_dat
void xt_redist_a_exchange1(Xt_redist redist, const void *src_data,
void *dst_data, Xt_request *request);
/**
* gets the number of messages send from the local process in an exchange
* operation
*
* @param[in] redist redistribution structure
* @return number of messages sent in the exchange operation
*/
int xt_redist_get_num_send_msg(Xt_redist redist);
/**
* gets the number of messages received by the local process in an exchange
* operation
*
* @param[in] redist redistribution structure
* @return number of messages received in the exchange operation
*/
int xt_redist_get_num_recv_msg(Xt_redist redist);
/**
* gets a copy of the MPI_Datatype used for the data of the send operation with
* the given rank
......
......@@ -93,6 +93,16 @@ void xt_redist_a_exchange1(Xt_redist redist, const void *src_data,
redist->vtable->a_exchange1(redist, src_data, dst_data, request);
}
int xt_redist_get_num_send_msg(Xt_redist redist) {
return redist->vtable->get_num_send_msg(redist);
}
int xt_redist_get_num_recv_msg(Xt_redist redist) {
return redist->vtable->get_num_recv_msg(redist);
}
MPI_Datatype xt_redist_get_send_MPI_Datatype(Xt_redist redist, int rank) {
return redist->vtable->get_send_MPI_Datatype(redist, rank);
......
......@@ -93,6 +93,10 @@ redist_collection_a_exchange1(Xt_redist redist,
const void *src_data, void *dst_data,
Xt_request *request);
static int redist_collection_get_num_send_msg(Xt_redist redist);
static int redist_collection_get_num_recv_msg(Xt_redist redist);
static MPI_Datatype
redist_collection_get_send_MPI_Datatype(Xt_redist redist, int rank);
......@@ -114,6 +118,8 @@ static const struct xt_redist_vtable redist_collection_vtable = {
.a_exchange = redist_collection_a_exchange,
.s_exchange1 = redist_collection_s_exchange1,
.a_exchange1 = redist_collection_a_exchange1,
.get_num_send_msg = redist_collection_get_num_send_msg,
.get_num_recv_msg = redist_collection_get_num_recv_msg,
.get_send_MPI_Datatype = redist_collection_get_send_MPI_Datatype,
.get_recv_MPI_Datatype = redist_collection_get_recv_MPI_Datatype,
.get_msg_ranks = redist_collection_get_msg_ranks,
......@@ -557,6 +563,16 @@ redist_collection_delete(Xt_redist redist) {
free(redist_coll);
}
static int redist_collection_get_num_send_msg(Xt_redist redist) {
return (int)(xrc(redist)->nsrc);
}
static int redist_collection_get_num_recv_msg(Xt_redist redist) {
return (int)(xrc(redist)->ndst);
}
static MPI_Datatype
redist_collection_get_send_MPI_Datatype(Xt_redist redist, int XT_UNUSED(rank))
{
......
......@@ -150,6 +150,22 @@ MODULE xt_redist_base
INTEGER(xt_mpi_fint_kind) :: comm
END FUNCTION xt_redist_get_mpi_comm
FUNCTION xt_redist_get_num_send_msg_c(redist) RESULT(num_send_msg) &
BIND(c, name='xt_redist_get_num_send_msg')
IMPORT :: c_ptr, c_int
IMPLICIT NONE
TYPE(c_ptr), VALUE, INTENT(in) :: redist
INTEGER(c_int) :: num_send_msg
END FUNCTION xt_redist_get_num_send_msg_c
FUNCTION xt_redist_get_num_recv_msg_c(redist) RESULT(num_recv_msg) &
BIND(c, name='xt_redist_get_num_recv_msg')
IMPORT :: c_ptr, c_int
IMPLICIT NONE
TYPE(c_ptr), VALUE, INTENT(in) :: redist
INTEGER(c_int) :: num_recv_msg
END FUNCTION xt_redist_get_num_recv_msg_c
FUNCTION xt_redist_get_recv_mpi_datatype(redist, rank) &
BIND(c, name='xt_redist_get_recv_MPI_Datatype_c2f') RESULT(dt)
IMPORT :: xt_redist, xt_mpi_fint_kind
......@@ -278,7 +294,8 @@ MODULE xt_redist_base
xt_redist_repeat_new, xt_redist_get_mpi_comm, xt_redist_p2p_ext_new, &
xt_redist_a_exchange1, xt_redist_a_exchange, &
xt_redist_single_array_base_new, &
xt_redist_get_send_mpi_datatype, xt_redist_get_recv_mpi_datatype
xt_redist_get_send_mpi_datatype, xt_redist_get_recv_mpi_datatype, &
xt_redist_get_num_send_msg, xt_redist_get_num_recv_msg
CHARACTER(len=*), PARAMETER :: filename = 'xt_redist_f.f90'
CONTAINS
......@@ -323,6 +340,26 @@ CONTAINS
END DO
END SUBROUTINE xt_redist_delete_a1d
FUNCTION xt_redist_get_num_send_msg(redist) RESULT(num_send_msg)
TYPE(xt_redist), INTENT(in) :: redist
INTEGER :: num_send_msg
INTEGER(c_int) :: n
n = xt_redist_get_num_send_msg_c(xt_redist_f2c(redist))
IF (n > HUGE(num_send_msg) .OR. n < -HUGE(num_send_msg)) &
CALL xt_abort("num_send_msg out of bounds", filename, __LINE__)
num_send_msg = INT(n)
END FUNCTION xt_redist_get_num_send_msg
FUNCTION xt_redist_get_num_recv_msg(redist) RESULT(num_recv_msg)
TYPE(xt_redist), INTENT(in) :: redist
INTEGER :: num_recv_msg
INTEGER(c_int) :: n
n = xt_redist_get_num_send_msg_c(xt_redist_f2c(redist))
IF (n > HUGE(num_recv_msg) .OR. n < -HUGE(num_recv_msg)) &
CALL xt_abort("num_recv_msg out of bounds", filename, __LINE__)
num_recv_msg = INT(n)
END FUNCTION xt_redist_get_num_recv_msg
SUBROUTINE xt_redist_s_exchange1(redist, src_data_cptr, dst_data_cptr)
TYPE(xt_redist), INTENT(in) :: redist
TYPE(c_ptr), INTENT(in) :: src_data_cptr, dst_data_cptr
......
......@@ -72,6 +72,8 @@ struct xt_redist_vtable {
void (*a_exchange1)(Xt_redist, const void *, void *, Xt_request *);
MPI_Datatype (*get_send_MPI_Datatype)(Xt_redist, int);
MPI_Datatype (*get_recv_MPI_Datatype)(Xt_redist, int);
int (*get_num_send_msg)(Xt_redist);
int (*get_num_recv_msg)(Xt_redist);
int (*get_msg_ranks)(Xt_redist, enum xt_msg_direction, int *restrict *);
MPI_Comm (*get_MPI_Comm)(Xt_redist);
};
......
......@@ -85,6 +85,10 @@ static void
redist_sab_a_exchange1(Xt_redist redist, const void *src_data, void *dst_data,
Xt_request *request);
static int redist_sab_get_num_send_msg(Xt_redist redist);
static int redist_sab_get_num_recv_msg(Xt_redist redist);
static MPI_Datatype
redist_sab_get_send_MPI_Datatype(Xt_redist redist, int rank);
......@@ -106,6 +110,8 @@ static const struct xt_redist_vtable redist_sab_vtable = {
.a_exchange = redist_sab_a_exchange,
.s_exchange1 = redist_sab_s_exchange1,
.a_exchange1 = redist_sab_a_exchange1,
.get_num_send_msg = redist_sab_get_num_send_msg,
.get_num_recv_msg = redist_sab_get_num_recv_msg,
.get_send_MPI_Datatype = redist_sab_get_send_MPI_Datatype,
.get_recv_MPI_Datatype = redist_sab_get_recv_MPI_Datatype,
.get_msg_ranks = redist_sab_get_msg_ranks,
......@@ -225,6 +231,16 @@ redist_sab_a_exchange1(Xt_redist redist, const void *src_data, void *dst_data,
xt_exchanger_a_exchange(redist_sab->exchanger, src_data, dst_data, request);
}
static int redist_sab_get_num_send_msg(Xt_redist redist) {
return xrsab(redist)->nsend;
}
static int redist_sab_get_num_recv_msg(Xt_redist redist) {
return xrsab(redist)->nrecv;
}
static MPI_Datatype
redist_sab_get_send_MPI_Datatype(Xt_redist redist, int rank) {
......
......@@ -98,8 +98,8 @@ MODULE yaxt
xt_offset_ext, xt_redist_p2p_ext_new, xt_redist_msg, &
xt_redist_a_exchange1, xt_redist_a_exchange, &
xt_redist_single_array_base_new, &
xt_redist_get_recv_mpi_datatype, &
xt_redist_get_send_mpi_datatype
xt_redist_get_recv_mpi_datatype, xt_redist_get_send_mpi_datatype, &
xt_redist_get_num_send_msg, xt_redist_get_num_recv_msg
USE xt_redist_int_i2, ONLY: xt_redist_s_exchange, xt_redist_a_exchange
USE xt_redist_int_i4, ONLY: xt_redist_s_exchange, xt_redist_a_exchange
USE xt_redist_int_i8, ONLY: xt_redist_s_exchange, xt_redist_a_exchange
......@@ -157,8 +157,8 @@ MODULE yaxt
xt_redist_repeat_new, xt_redist_copy, xt_redist_delete, &
xt_redist_s_exchange1, xt_redist_s_exchange, &
xt_redist_get_mpi_comm, &
xt_redist_get_recv_mpi_datatype, &
xt_redist_get_send_mpi_datatype, &
xt_redist_get_recv_mpi_datatype, xt_redist_get_send_mpi_datatype, &
xt_redist_get_num_send_msg, xt_redist_get_num_recv_msg, &
xt_idxempty_new, xt_redist_collection_static_new, &
xt_redist_collection_new, xt_slice_c_loc, &
xt_mpi_comm_mark_exclusive, &
......
......@@ -80,6 +80,14 @@ int main(void) {
xt_redist_single_array_base_new(
nsend, nrecv, send_msgs, recv_msgs, MPI_COMM_WORLD);
// test number of send messages
if ((int)nsend != xt_redist_get_num_send_msg(redist))
PUT_ERR("error in xt_redist_get_num_send_msg\n");
// test number of recv messages
if ((int)nrecv != xt_redist_get_num_recv_msg(redist))
PUT_ERR("error in xt_redist_get_num_recv_msg\n");
// test communicator of redist
if (!communicators_are_congruent(xt_redist_get_MPI_Comm(redist),
MPI_COMM_WORLD))
......@@ -128,6 +136,14 @@ int main(void) {
MPI_Type_free(&recv_type);
MPI_Type_free(&send_type);
// test number of send messages
if ((int)nsend != xt_redist_get_num_send_msg(redist))
PUT_ERR("error in xt_redist_get_num_send_msg\n");
// test number of recv messages
if ((int)nrecv != xt_redist_get_num_recv_msg(redist))
PUT_ERR("error in xt_redist_get_num_recv_msg\n");
// test communicator of redist
if (!communicators_are_congruent(xt_redist_get_MPI_Comm(redist),
MPI_COMM_WORLD))
......
......@@ -86,6 +86,14 @@ int main(void) {
xt_redist_single_array_base_new(
nsend, nrecv, send_msgs, recv_msgs, MPI_COMM_WORLD);
// test number of send messages
if ((int)nsend != xt_redist_get_num_send_msg(redist))
PUT_ERR("error in xt_redist_get_num_send_msg\n");
// test number of recv messages
if ((int)nrecv != xt_redist_get_num_recv_msg(redist))
PUT_ERR("error in xt_redist_get_num_recv_msg\n");
// test communicator of redist
if (!communicators_are_congruent(xt_redist_get_MPI_Comm(redist),
MPI_COMM_WORLD))
......@@ -137,6 +145,14 @@ int main(void) {
xt_redist_single_array_base_new(
nsend, nrecv, send_msgs, recv_msgs, MPI_COMM_WORLD);
// test number of send messages
if ((int)nsend != xt_redist_get_num_send_msg(redist))
PUT_ERR("error in xt_redist_get_num_send_msg\n");
// test number of recv messages
if ((int)nrecv != xt_redist_get_num_recv_msg(redist))
PUT_ERR("error in xt_redist_get_num_recv_msg\n");
// test communicator of redist
if (!communicators_are_congruent(xt_redist_get_MPI_Comm(redist),
MPI_COMM_WORLD))
......@@ -189,6 +205,14 @@ int main(void) {
xt_redist_single_array_base_new(
nsend, nrecv, send_msgs, recv_msgs, MPI_COMM_WORLD);
// test number of send messages
if ((int)nsend != xt_redist_get_num_send_msg(redist))
PUT_ERR("error in xt_redist_get_num_send_msg\n");
// test number of recv messages
if ((int)nrecv != xt_redist_get_num_recv_msg(redist))
PUT_ERR("error in xt_redist_get_num_recv_msg\n");
// test communicator of redist
if (!communicators_are_congruent(xt_redist_get_MPI_Comm(redist),
MPI_COMM_WORLD))
......
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