Commit 89b14bfd authored by Thomas Jahns's avatar Thomas Jahns 🤸
Browse files

Fortran version of redist custom configuration constructors.

parent 833351f2
......@@ -35,6 +35,7 @@
if FC_MOD_UPPERCASE
##UPPERCASE_MODULE_NAME_MARKER do not remove##
XT_REDIST_RENAME_MOD_NAME=XT_REDIST_RENAME
XT_CONFIG_F_MOD_NAME=XT_CONFIG_F
XT_SORT_MOD_NAME=XT_SORT
XT_REDIST_INT_I2_MOD_NAME=XT_REDIST_INT_I2
......@@ -58,6 +59,7 @@ XT_UT_MOD_NAME=XT_UT
YAXT_MOD_NAME=YAXT
else
##LOWERCASE_MODULE_NAME_MARKER do not remove##
XT_REDIST_RENAME_MOD_NAME=xt_redist_rename
XT_CONFIG_F_MOD_NAME=xt_config_f
XT_SORT_MOD_NAME=xt_sort
XT_REDIST_INT_I2_MOD_NAME=xt_redist_int_i2
......@@ -144,10 +146,14 @@ $(XT_SORT_MOD_NAME).$(FCMODEXT): ../../src/$(XT_SORT_MOD_NAME).$(FCMODEXT)
$(XT_CONFIG_F_MOD_NAME).$(FCMODEXT): ../../src/$(XT_CONFIG_F_MOD_NAME).$(FCMODEXT)
$(LN_S) ../../src/$(XT_CONFIG_F_MOD_NAME).$(FCMODEXT) .
$(XT_REDIST_RENAME_MOD_NAME).$(FCMODEXT): ../../src/$(XT_REDIST_RENAME_MOD_NAME).$(FCMODEXT)
$(LN_S) ../../src/$(XT_REDIST_RENAME_MOD_NAME).$(FCMODEXT) .
##MODULE_RECIPE_MARKER do not remove ##
##INCLUDE_HEADER_MARKER do not remove ##
include_HEADERS= \
$(XT_REDIST_RENAME_MOD_NAME).$(FCMODEXT) \
$(XT_CONFIG_F_MOD_NAME).$(FCMODEXT) \
$(XT_SORT_MOD_NAME).$(FCMODEXT) \
$(XT_REDIST_INT_I2_MOD_NAME).$(FCMODEXT) \
......
......@@ -58,7 +58,20 @@ MODULE xt_config_f
#endif
TYPE(c_ptr) :: cptr = c_null_ptr
END TYPE xt_config
INTERFACE
! this function must not be implemented in Fortran because
! PGI 11.x chokes on that
FUNCTION xt_config_f2c(config) BIND(c, name='xt_config_f2c') RESULT(p)
IMPORT :: c_ptr, xt_config
IMPLICIT NONE
TYPE(xt_config), INTENT(in) :: config
TYPE(c_ptr) :: p
END FUNCTION xt_config_f2c
END INTERFACE
PUBLIC :: xt_config_new, xt_config_delete
PUBLIC :: xt_config_f2c
PUBLIC :: xt_config_get_exchange_method, xt_config_set_exchange_method
INTEGER, PUBLIC, PARAMETER :: &
xt_exchanger_irecv_send = 0, &
......
This diff is collapsed.
......@@ -96,17 +96,20 @@ MODULE yaxt
xt_xmap_intersection_ext_new, xt_com_list, &
xt_xmap_intersection_pos_new, xt_com_pos
USE xt_redist_base, ONLY: xt_redist, xt_redist_c2f, xt_redist_f2c, &
xt_redist_copy, &
xt_redist_copy, xt_redist_p2p_custom_new, &
xt_redist_delete, xt_redist_s_exchange1, xt_redist_s_exchange, &
xt_redist_p2p_new, xt_redist_p2p_off_new, &
xt_redist_p2p_blocks_new, xt_redist_p2p_blocks_off_new, &
xt_redist_p2p_off_new, xt_redist_p2p_off_custom_new, &
xt_redist_p2p_blocks_new, xt_redist_p2p_blocks_custom_new, &
xt_redist_p2p_blocks_off_new, xt_redist_p2p_blocks_off_custom_new, &
xt_redist_collection_static_new, xt_redist_collection_new, &
xt_redist_repeat_new, xt_is_null, xt_redist_get_mpi_comm, &
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_single_array_base_custom_new, &
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_rename, ONLY: xt_redist_p2p_new
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
......@@ -159,9 +162,7 @@ MODULE yaxt
xt_xmap_iterator_get_transfer_pos_ext, &
xt_xmap_iterator_get_num_transfer_pos_ext, &
xt_redist, xt_redist_f2c, xt_redist_c2f, &
xt_redist_p2p_off_new, xt_redist_p2p_new, &
xt_redist_p2p_blocks_off_new, xt_redist_p2p_blocks_new, &
xt_redist_msg, xt_redist_single_array_base_new, &
xt_redist_msg, &
xt_offset_ext, xt_redist_p2p_ext_new, &
xt_redist_repeat_new, xt_redist_copy, xt_redist_delete, &
xt_redist_s_exchange1, xt_redist_s_exchange, &
......@@ -183,6 +184,13 @@ MODULE yaxt
xt_exchanger_irecv_isend_packed, xt_exchanger_mix_isend_irecv, &
xt_exchanger_neigh_alltoall
PUBLIC :: xt_redist_p2p_new, xt_redist_p2p_custom_new
PUBLIC :: xt_redist_p2p_off_new, xt_redist_p2p_off_custom_new
PUBLIC :: xt_redist_p2p_blocks_new, xt_redist_p2p_blocks_custom_new
PUBLIC :: xt_redist_p2p_blocks_off_new, xt_redist_p2p_blocks_off_custom_new
PUBLIC :: xt_redist_single_array_base_new, &
xt_redist_single_array_base_custom_new
INTERFACE OPERATOR(==)
MODULE PROCEDURE xt_bounds_eq
END INTERFACE OPERATOR(==)
......
......@@ -80,6 +80,8 @@
#include "xt/xt_redist_collection.h"
#include "xt/xt_sort.h"
#include "xt_config_internal.h"
struct xt_idxlist_f {
Xt_idxlist cptr;
};
......@@ -88,6 +90,10 @@ struct xt_xmap_f {
Xt_xmap cptr;
};
struct xt_config_f {
Xt_config cptr;
};
struct xt_redist_f {
Xt_redist cptr;
};
......@@ -157,6 +163,11 @@ Xt_redist xt_redist_f2c(struct xt_redist_f *p)
return p->cptr;
}
Xt_config xt_config_f2c(struct xt_config_f *p)
{
return p->cptr;
}
Xt_request xt_request_f2c(struct xt_request_f *p)
{
return p->cptr;
......@@ -246,16 +257,71 @@ Xt_redist xt_redist_p2p_blocks_off_new_f(struct xt_xmap_f *xmap_f,
datatype_c);
}
Xt_redist
xt_redist_p2p_blocks_off_custom_new_f(struct xt_xmap_f *xmap_f,
int *src_block_offsets,
int *src_block_sizes,
int src_block_num,
int *dst_block_offsets,
int *dst_block_sizes,
int dst_block_num,
MPI_Fint datatype_f,
struct xt_config_f *config)
{
MPI_Datatype datatype_c = MPI_Type_f2c(datatype_f);
return xt_redist_p2p_blocks_off_custom_new(
xmap_f->cptr, src_block_offsets, src_block_sizes, src_block_num,
dst_block_offsets, dst_block_sizes, dst_block_num, datatype_c,
config->cptr);
}
Xt_redist xt_redist_p2p_blocks_new_f(struct xt_xmap_f *xmap_f,
int *src_block_sizes, int src_block_num,
int *dst_block_sizes, int dst_block_num,
MPI_Fint datatype_f) {
MPI_Datatype datatype_c = MPI_Type_f2c(datatype_f);
return xt_redist_p2p_blocks_new(xmap_f->cptr,
src_block_sizes, src_block_num,
dst_block_sizes, dst_block_num,
datatype_c);
return xt_redist_p2p_blocks_new(
xmap_f->cptr, src_block_sizes, src_block_num,
dst_block_sizes, dst_block_num, datatype_c);
}
Xt_redist
xt_redist_p2p_blocks_custom_new_f(struct xt_xmap_f *xmap_f,
int *src_block_sizes, int src_block_num,
int *dst_block_sizes, int dst_block_num,
MPI_Fint datatype_f,
struct xt_config_f *config)
{
MPI_Datatype datatype_c = MPI_Type_f2c(datatype_f);
return xt_redist_p2p_blocks_custom_new(
xmap_f->cptr, src_block_sizes, src_block_num,
dst_block_sizes, dst_block_num, datatype_c, config->cptr);
}
Xt_redist
xt_redist_p2p_ext_new_c2f(Xt_xmap *xmap,
int num_src_ext, struct Xt_offset_ext src_extents[],
int num_dst_ext, struct Xt_offset_ext dst_extents[],
MPI_Fint datatype_f)
{
return xt_redist_p2p_ext_new(*xmap, num_src_ext, src_extents,
num_dst_ext, dst_extents,
MPI_Type_f2c(datatype_f));
}
Xt_redist
xt_redist_p2p_ext_custom_new_c2f(
Xt_xmap *xmap,
int num_src_ext, struct Xt_offset_ext src_extents[],
int num_dst_ext, struct Xt_offset_ext dst_extents[],
MPI_Fint datatype_f, struct xt_config_f *config)
{
return xt_redist_p2p_ext_custom_new(*xmap, num_src_ext, src_extents,
num_dst_ext, dst_extents,
MPI_Type_f2c(datatype_f), config->cptr);
}
Xt_redist
......@@ -269,6 +335,18 @@ xt_redist_p2p_off_new_f(struct xt_xmap_f *xmap_f,
datatype_c);
}
Xt_redist
xt_redist_p2p_off_custom_new_f(struct xt_xmap_f *xmap_f,
MPI_Fint *src_offsets, MPI_Fint *dst_offsets,
MPI_Fint datatype_f, struct xt_config_f *config)
{
MPI_Datatype datatype_c = MPI_Type_f2c(datatype_f);
assert(sizeof (MPI_Fint) == sizeof (int));
return xt_redist_p2p_off_custom_new(xmap_f->cptr, src_offsets, dst_offsets,
datatype_c, config->cptr);
}
Xt_redist
xt_redist_p2p_new_f(struct xt_xmap_f *xmap_f, MPI_Fint datatype_f) {
MPI_Datatype datatype_c = MPI_Type_f2c(datatype_f);
......@@ -276,6 +354,14 @@ xt_redist_p2p_new_f(struct xt_xmap_f *xmap_f, MPI_Fint datatype_f) {
return xt_redist_p2p_new(xmap_f->cptr, datatype_c);
}
Xt_redist
xt_redist_p2p_custom_new_f(struct xt_xmap_f *xmap_f, MPI_Fint datatype_f,
struct xt_config_f *config) {
MPI_Datatype datatype_c = MPI_Type_f2c(datatype_f);
return xt_redist_p2p_custom_new(xmap_f->cptr, datatype_c, config->cptr);
}
Xt_redist
xt_redist_collection_static_new_f(Xt_redist *redists, MPI_Fint num_redists,
MPI_Aint *src_displacements,
......@@ -289,10 +375,26 @@ xt_redist_collection_static_new_f(Xt_redist *redists, MPI_Fint num_redists,
if (num_redists < 1)
Xt_abort(comm_c, "bad case: (num_redists < 1)", __FILE__, __LINE__);
return xt_redist_collection_static_new(redists, (int)num_redists,
src_displacements,
dst_displacements,
comm_c);
return xt_redist_collection_static_new(
redists, (int)num_redists, src_displacements, dst_displacements, comm_c);
}
Xt_redist
xt_redist_collection_static_custom_new_f(
Xt_redist *redists, MPI_Fint num_redists,
MPI_Aint *src_displacements, MPI_Aint *dst_displacements,
MPI_Fint comm_f, struct xt_config_f *config)
{
#if XT_MPI_FINT_MAX != INT_MAX
assert((long long)num_redists <= (long long)INT_MAX);
#endif
MPI_Comm comm_c = MPI_Comm_f2c(comm_f);
if (num_redists < 1)
Xt_abort(comm_c, "bad case: (num_redists < 1)", __FILE__, __LINE__);
return xt_redist_collection_static_custom_new(
redists, (int)num_redists, src_displacements, dst_displacements,
comm_c, config->cptr);
}
Xt_redist
......@@ -310,6 +412,22 @@ xt_redist_collection_new_f(Xt_redist *redists, MPI_Fint num_redists,
(int)cache_size, comm_c);
}
Xt_redist
xt_redist_collection_custom_new_f(Xt_redist *redists, MPI_Fint num_redists,
MPI_Fint cache_size, MPI_Fint comm_f,
struct xt_config_f *config)
{
#if XT_MPI_FINT_MAX != INT_MAX
assert((long long)num_redists <= (long long)INT_MAX
&& (long long)cache_size <= (long long)INT_MAX);
#endif
MPI_Comm comm_c = MPI_Comm_f2c(comm_f);
if (num_redists < 1)
Xt_abort(comm_c, "bad case: (num_redists < 1)", __FILE__, __LINE__);
return xt_redist_collection_custom_new(redists, (int)num_redists,
(int)cache_size, comm_c, config->cptr);
}
static void
xt_slice_c_loc_f2c(void *a, void **p)
{
......@@ -340,21 +458,10 @@ xt_redist_get_send_MPI_Datatype_c2f(Xt_redist *redist, MPI_Fint rank)
}
void *
xt_redist_p2p_ext_new_c2f(Xt_xmap *xmap,
int num_src_ext, struct Xt_offset_ext src_extents[],
int num_dst_ext, struct Xt_offset_ext dst_extents[],
MPI_Fint datatype_f)
{
return xt_redist_p2p_ext_new(*xmap, num_src_ext, src_extents,
num_dst_ext, dst_extents,
MPI_Type_f2c(datatype_f));
}
void *
xt_redist_single_array_base_new_c2f(int nsend, int nrecv,
const struct xt_redist_msg_f *send_msgs_f,
const struct xt_redist_msg_f *recv_msgs_f,
MPI_Fint comm_f)
xt_redist_single_array_base_custom_new_c2f(
int nsend, int nrecv, const struct xt_redist_msg_f *send_msgs_f,
const struct xt_redist_msg_f *recv_msgs_f, MPI_Fint comm_f,
struct xt_config_f *config)
{
assert(nsend >= 0 && nrecv >= 0);
MPI_Comm comm_c = MPI_Comm_f2c(comm_f);
......@@ -369,12 +476,23 @@ xt_redist_single_array_base_new_c2f(int nsend, int nrecv,
recv_msgs_c[i].rank = recv_msgs_f[i].rank;
recv_msgs_c[i].datatype = MPI_Type_f2c(recv_msgs_f[i].datatype);
}
void *redist = xt_redist_single_array_base_new(nsend, nrecv, send_msgs_c,
recv_msgs_c, comm_c);
void *redist = xt_redist_single_array_base_custom_new(
nsend, nrecv, send_msgs_c, recv_msgs_c, comm_c, config->cptr);
free(send_msgs_c);
return redist;
}
void *
xt_redist_single_array_base_new_c2f(int nsend, int nrecv,
const struct xt_redist_msg_f *send_msgs_f,
const struct xt_redist_msg_f *recv_msgs_f,
MPI_Fint comm_f)
{
return xt_redist_single_array_base_custom_new_c2f(
nsend, nrecv, send_msgs_f, recv_msgs_f, comm_f,
&(struct xt_config_f){ (Xt_config)&xt_default_config });
}
void *
xt_xmap_intersection_new_f2c(
int num_src_intersections,
......
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