int MPI_Ialltoallw(void *sendbuf, int sendcounts[], int sdispls[],
MPI_Datatype *sendtypes,
void *recvbuf, int recvcounts[], int rdispls[],
MPI_Datatype *recvtypes, MPI_Comm comm, MPI_Request *request)
{
int i, size, err;
MEMCHECKER(
ptrdiff_t recv_ext;
ptrdiff_t send_ext;
size = ompi_comm_remote_size(comm);
memchecker_comm(comm);
for ( i = 0; i < size; i++ ) {
memchecker_datatype(sendtypes[i]);
memchecker_datatype(recvtypes[i]);
ompi_datatype_type_extent(sendtypes[i], &send_ext);
ompi_datatype_type_extent(recvtypes[i], &recv_ext);
memchecker_call(&opal_memchecker_base_isdefined,
(char *)(sendbuf)+sdispls[i]*send_ext,
sendcounts[i], sendtypes[i]);
memchecker_call(&opal_memchecker_base_isaddressable,
(char *)(recvbuf)+sdispls[i]*recv_ext,
recvcounts[i], recvtypes[i]);
}
);
int MPI_Ialltoallw(const void *sendbuf, const int sendcounts[], const int sdispls[],
const MPI_Datatype sendtypes[], void *recvbuf, const int recvcounts[],
const int rdispls[], const MPI_Datatype recvtypes[], MPI_Comm comm,
MPI_Request *request)
{
int i, size, err;
size_t sendtype_size, recvtype_size;
MEMCHECKER(
ptrdiff_t recv_ext;
ptrdiff_t send_ext;
memchecker_comm(comm);
size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm);
for ( i = 0; i < size; i++ ) {
if (MPI_IN_PLACE != sendbuf) {
memchecker_datatype(sendtypes[i]);
ompi_datatype_type_extent(sendtypes[i], &send_ext);
memchecker_call(&opal_memchecker_base_isdefined,
(char *)(sendbuf)+sdispls[i]*send_ext,
sendcounts[i], sendtypes[i]);
}
memchecker_datatype(recvtypes[i]);
ompi_datatype_type_extent(recvtypes[i], &recv_ext);
memchecker_call(&opal_memchecker_base_isaddressable,
(char *)(recvbuf)+sdispls[i]*recv_ext,
recvcounts[i], recvtypes[i]);
}
);
int MPI_Alltoallv(void *sendbuf, int sendcounts[], int sdispls[],
MPI_Datatype sendtype,
void *recvbuf, int recvcounts[], int rdispls[],
MPI_Datatype recvtype, MPI_Comm comm)
{
int i, size, err;
MEMCHECKER(
ptrdiff_t recv_ext;
ptrdiff_t send_ext;
size = ompi_comm_remote_size(comm);
ompi_datatype_type_extent(recvtype, &recv_ext);
ompi_datatype_type_extent(sendtype, &send_ext);
memchecker_datatype(sendtype);
memchecker_datatype(recvtype);
memchecker_comm(comm);
for ( i = 0; i < size; i++ ) {
/* check if send chunks are defined. */
memchecker_call(&opal_memchecker_base_isdefined,
(char *)(sendbuf)+sdispls[i]*send_ext,
sendcounts[i], sendtype);
/* check if receive chunks are addressable. */
memchecker_call(&opal_memchecker_base_isaddressable,
(char *)(recvbuf)+rdispls[i]*recv_ext,
recvcounts[i], recvtype);
}
);
int
ompi_coll_base_alltoallv_intra_pairwise(const void *sbuf, const int *scounts, const int *sdisps,
struct ompi_datatype_t *sdtype,
void* rbuf, const int *rcounts, const int *rdisps,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm,
mca_coll_base_module_t *module)
{
int line = -1, err = 0, rank, size, step = 0, sendto, recvfrom;
void *psnd, *prcv;
ptrdiff_t sext, rext;
if (MPI_IN_PLACE == sbuf) {
return mca_coll_base_alltoallv_intra_basic_inplace (rbuf, rcounts, rdisps,
rdtype, comm, module);
}
size = ompi_comm_size(comm);
rank = ompi_comm_rank(comm);
OPAL_OUTPUT((ompi_coll_base_framework.framework_output,
"coll:base:alltoallv_intra_pairwise rank %d", rank));
ompi_datatype_type_extent(sdtype, &sext);
ompi_datatype_type_extent(rdtype, &rext);
/* Perform pairwise exchange starting from 1 since local exhange is done */
for (step = 0; step < size; step++) {
/* Determine sender and receiver for this step. */
sendto = (rank + step) % size;
recvfrom = (rank + size - step) % size;
/* Determine sending and receiving locations */
psnd = (char*)sbuf + (ptrdiff_t)sdisps[sendto] * sext;
prcv = (char*)rbuf + (ptrdiff_t)rdisps[recvfrom] * rext;
/* send and receive */
err = ompi_coll_base_sendrecv( psnd, scounts[sendto], sdtype, sendto,
MCA_COLL_BASE_TAG_ALLTOALLV,
prcv, rcounts[recvfrom], rdtype, recvfrom,
MCA_COLL_BASE_TAG_ALLTOALLV,
comm, MPI_STATUS_IGNORE, rank);
if (MPI_SUCCESS != err) { line = __LINE__; goto err_hndl; }
}
return MPI_SUCCESS;
err_hndl:
OPAL_OUTPUT((ompi_coll_base_framework.framework_output,
"%s:%4d\tError occurred %d, rank %2d at step %d", __FILE__, line,
err, rank, step));
(void)line; // silence compiler warning
return err;
}
int MPI_Ineighbor_allgather(const void *sendbuf, int sendcount, MPI_Datatype sendtype,
void *recvbuf, int recvcount, MPI_Datatype recvtype,
MPI_Comm comm, MPI_Request *request)
{
int err;
SPC_RECORD(OMPI_SPC_INEIGHBOR_ALLGATHER, 1);
MEMCHECKER(
int rank;
ptrdiff_t ext;
rank = ompi_comm_rank(comm);
ompi_datatype_type_extent(recvtype, &ext);
memchecker_datatype(recvtype);
memchecker_comm(comm);
/* check whether the actual send buffer is defined. */
if (MPI_IN_PLACE != sendbuf) {
memchecker_datatype(sendtype);
memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype);
}
/* check whether the receive buffer is addressable. */
memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype);
);
int MPI_Neighbor_allgatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype,
void *recvbuf, const int recvcounts[], const int displs[],
MPI_Datatype recvtype, MPI_Comm comm)
{
int i, size, err;
MEMCHECKER(
int rank;
ptrdiff_t ext;
rank = ompi_comm_rank(comm);
size = ompi_comm_size(comm);
ompi_datatype_type_extent(recvtype, &ext);
memchecker_datatype(recvtype);
memchecker_comm (comm);
/* check whether the receive buffer is addressable. */
for (i = 0; i < size; i++) {
memchecker_call(&opal_memchecker_base_isaddressable,
(char *)(recvbuf)+displs[i]*ext,
recvcounts[i], recvtype);
}
/* check whether the actual send buffer is defined. */
if (MPI_IN_PLACE == sendbuf) {
memchecker_call(&opal_memchecker_base_isdefined,
(char *)(recvbuf)+displs[rank]*ext,
recvcounts[rank], recvtype);
} else {
memchecker_datatype(sendtype);
memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype);
}
);
int MPI_Neighbor_allgatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype,
void *recvbuf, const int recvcounts[], const int displs[],
MPI_Datatype recvtype, MPI_Comm comm)
{
int in_size, out_size, err;
SPC_RECORD(OMPI_SPC_NEIGHBOR_ALLGATHERV, 1);
MEMCHECKER(
int rank;
ptrdiff_t ext;
rank = ompi_comm_rank(comm);
mca_topo_base_neighbor_count (comm, &in_size, &out_size);
ompi_datatype_type_extent(recvtype, &ext);
memchecker_datatype(recvtype);
memchecker_comm (comm);
/* check whether the receive buffer is addressable. */
for (int i = 0; i < in_size; ++i) {
memchecker_call(&opal_memchecker_base_isaddressable,
(char *)(recvbuf)+displs[i]*ext,
recvcounts[i], recvtype);
}
/* check whether the actual send buffer is defined. */
if (MPI_IN_PLACE != sendbuf) {
memchecker_datatype(sendtype);
memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype);
}
);
int MPI_Iallgather(void *sendbuf, int sendcount, MPI_Datatype sendtype,
void *recvbuf, int recvcount, MPI_Datatype recvtype,
MPI_Comm comm, MPI_Request *request)
{
int err;
MEMCHECKER(
int rank;
ptrdiff_t ext;
rank = ompi_comm_rank(comm);
ompi_datatype_type_extent(recvtype, &ext);
memchecker_datatype(recvtype);
memchecker_comm(comm);
/* check whether the actual send buffer is defined. */
if (MPI_IN_PLACE == sendbuf) {
memchecker_call(&opal_memchecker_base_isdefined,
(char *)(recvbuf)+rank*ext,
recvcount, recvtype);
} else {
memchecker_datatype(sendtype);
memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype);
}
/* check whether the receive buffer is addressable. */
memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype);
);
/* simple chained MPI_Ibcast */
static inline int bcast_sched_chain(int rank, int p, int root, NBC_Schedule *schedule, void *buffer, int count, MPI_Datatype datatype, int fragsize, size_t size) {
int res, vrank, rpeer, speer, numfrag, fragcount, thiscount;
MPI_Aint ext;
char *buf;
RANK2VRANK(rank, vrank, root);
VRANK2RANK(rpeer, vrank-1, root);
VRANK2RANK(speer, vrank+1, root);
res = ompi_datatype_type_extent(datatype, &ext);
if (MPI_SUCCESS != res) {
NBC_Error("MPI Error in ompi_datatype_type_extent() (%i)", res);
return res;
}
if (count == 0) {
return OMPI_SUCCESS;
}
numfrag = count * size/fragsize;
if ((count * size) % fragsize != 0) {
numfrag++;
}
fragcount = count/numfrag;
for (int fragnum = 0 ; fragnum < numfrag ; ++fragnum) {
buf = (char *) buffer + fragnum * fragcount * ext;
thiscount = fragcount;
if (fragnum == numfrag-1) {
/* last fragment may not be full */
thiscount = count - fragcount * fragnum;
}
/* root does not receive */
if (vrank != 0) {
res = NBC_Sched_recv (buf, false, thiscount, datatype, rpeer, schedule, true);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
return res;
}
}
/* last rank does not send */
if (vrank != p-1) {
res = NBC_Sched_send (buf, false, thiscount, datatype, speer, schedule, false);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
return res;
}
/* this barrier here seems awaward but isn't!!!! */
if (vrank == 0) {
res = NBC_Sched_barrier (schedule);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
return res;
}
}
}
}
return OMPI_SUCCESS;
}
int ompi_coll_libnbc_ireduce_inter(const void* sendbuf, void* recvbuf, int count, MPI_Datatype datatype,
MPI_Op op, int root, struct ompi_communicator_t *comm, ompi_request_t ** request,
struct mca_coll_base_module_2_1_0_t *module) {
int rank, res, rsize;
NBC_Schedule *schedule;
MPI_Aint ext;
NBC_Handle *handle;
ompi_coll_libnbc_module_t *libnbc_module = (ompi_coll_libnbc_module_t*) module;
rank = ompi_comm_rank (comm);
rsize = ompi_comm_remote_size (comm);
res = ompi_datatype_type_extent (datatype, &ext);
if (MPI_SUCCESS != res) {
NBC_Error("MPI Error in ompi_datatype_type_extent() (%i)", res);
return res;
}
res = NBC_Init_handle(comm, &handle, libnbc_module);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
return res;
}
handle->tmpbuf = malloc (ext * count);
if (OPAL_UNLIKELY(NULL == handle->tmpbuf)) {
NBC_Return_handle (handle);
return OMPI_ERR_OUT_OF_RESOURCE;
}
schedule = OBJ_NEW(NBC_Schedule);
if (OPAL_UNLIKELY(NULL == schedule)) {
NBC_Return_handle (handle);
return OMPI_ERR_OUT_OF_RESOURCE;
}
res = red_sched_linear (rank, rsize, root, sendbuf, recvbuf, count, datatype, op, schedule, handle);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
NBC_Return_handle (handle);
return OMPI_ERR_OUT_OF_RESOURCE;
}
res = NBC_Sched_commit(schedule);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
NBC_Return_handle (handle);
return OMPI_ERR_OUT_OF_RESOURCE;
}
res = NBC_Start(handle, schedule);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
NBC_Return_handle (handle);
return OMPI_ERR_OUT_OF_RESOURCE;
}
*request = (ompi_request_t *) handle;
/* tmpbuf is freed with the handle */
return OMPI_SUCCESS;
}
int MPI_Gatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype,
void *recvbuf, const int recvcounts[], const int displs[],
MPI_Datatype recvtype, int root, MPI_Comm comm)
{
int i, size, err;
MEMCHECKER(
int rank;
ptrdiff_t ext;
size = ompi_comm_remote_size(comm);
rank = ompi_comm_rank(comm);
ompi_datatype_type_extent(recvtype, &ext);
memchecker_comm(comm);
if(OMPI_COMM_IS_INTRA(comm)) {
if(ompi_comm_rank(comm) == root) {
/* check whether root's send buffer is defined. */
if (MPI_IN_PLACE == sendbuf) {
for (i = 0; i < size; i++) {
memchecker_call(&opal_memchecker_base_isdefined,
(char *)(recvbuf)+displs[i]*ext,
recvcounts[i], recvtype);
}
} else {
memchecker_datatype(sendtype);
memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype);
}
memchecker_datatype(recvtype);
/* check whether root's receive buffer is addressable. */
for (i = 0; i < size; i++) {
memchecker_call(&opal_memchecker_base_isaddressable,
(char *)(recvbuf)+displs[i]*ext,
recvcounts[i], recvtype);
}
} else {
memchecker_datatype(sendtype);
/* check whether send buffer is defined on other processes. */
memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype);
}
} else {
if (MPI_ROOT == root) {
memchecker_datatype(recvtype);
/* check whether root's receive buffer is addressable. */
for (i = 0; i < size; i++) {
memchecker_call(&opal_memchecker_base_isaddressable,
(char *)(recvbuf)+displs[i]*ext,
recvcounts[i], recvtype);
}
} else if (MPI_PROC_NULL != root) {
memchecker_datatype(sendtype);
/* check whether send buffer is defined. */
memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype);
}
}
);
static int nbc_allgather_inter_init(const void* sendbuf, int sendcount, MPI_Datatype sendtype, void* recvbuf, int recvcount,
MPI_Datatype recvtype, struct ompi_communicator_t *comm, ompi_request_t ** request,
struct mca_coll_base_module_2_3_0_t *module, bool persistent)
{
int res, rsize;
MPI_Aint rcvext;
NBC_Schedule *schedule;
char *rbuf;
ompi_coll_libnbc_module_t *libnbc_module = (ompi_coll_libnbc_module_t*) module;
res = ompi_datatype_type_extent(recvtype, &rcvext);
if (MPI_SUCCESS != res) {
NBC_Error ("MPI Error in ompi_datatype_type_extent() (%i)", res);
return res;
}
rsize = ompi_comm_remote_size (comm);
/* set up schedule */
schedule = OBJ_NEW(NBC_Schedule);
if (OPAL_UNLIKELY(NULL == schedule)) {
return OMPI_ERR_OUT_OF_RESOURCE;
}
/* do rsize - 1 rounds */
for (int r = 0 ; r < rsize ; ++r) {
/* recv from rank r */
rbuf = (char *) recvbuf + r * recvcount * rcvext;
res = NBC_Sched_recv (rbuf, false, recvcount, recvtype, r, schedule, false);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
OBJ_RELEASE(schedule);
return res;
}
/* send to rank r */
res = NBC_Sched_send (sendbuf, false, sendcount, sendtype, r, schedule, false);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
OBJ_RELEASE(schedule);
return res;
}
}
res = NBC_Sched_commit (schedule);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
OBJ_RELEASE(schedule);
return res;
}
res = NBC_Schedule_request(schedule, comm, libnbc_module, persistent, request, NULL);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
OBJ_RELEASE(schedule);
return res;
}
return OMPI_SUCCESS;
}
int MPI_Neighbor_alltoallv(const void *sendbuf, const int sendcounts[], const int sdispls[],
MPI_Datatype sendtype, void *recvbuf,
const int recvcounts[], const int rdispls[],
MPI_Datatype recvtype, MPI_Comm comm)
{
int i, err;
int indegree, outdegree, weighted;
size_t sendtype_size, recvtype_size;
bool zerosend=true, zerorecv=true;
MEMCHECKER(
ptrdiff_t recv_ext;
ptrdiff_t send_ext;
memchecker_comm(comm);
if (MPI_IN_PLACE != sendbuf) {
memchecker_datatype(sendtype);
ompi_datatype_type_extent(recvtype, &recv_ext);
}
memchecker_datatype(recvtype);
ompi_datatype_type_extent(sendtype, &send_ext);
err = ompi_comm_neighbors_count(comm, &indegree, &outdegree, &weighted);
if (MPI_SUCCESS == err) {
if (MPI_IN_PLACE != sendbuf) {
for ( i = 0; i < outdegree; i++ ) {
/* check if send chunks are defined. */
memchecker_call(&opal_memchecker_base_isdefined,
(char *)(sendbuf)+sdispls[i]*send_ext,
sendcounts[i], sendtype);
}
}
for ( i = 0; i < indegree; i++ ) {
/* check if receive chunks are addressable. */
memchecker_call(&opal_memchecker_base_isaddressable,
(char *)(recvbuf)+rdispls[i]*recv_ext,
recvcounts[i], recvtype);
}
}
);
int MPI_Neighbor_alltoallw(const void *sendbuf, const int sendcounts[], const MPI_Aint sdispls[],
const MPI_Datatype sendtypes[], void *recvbuf,
const int recvcounts[], const MPI_Aint rdispls[],
const MPI_Datatype recvtypes[], MPI_Comm comm)
{
int i, err;
int indegree, outdegree;
SPC_RECORD(OMPI_SPC_NEIGHBOR_ALLTOALLW, 1);
MEMCHECKER(
ptrdiff_t recv_ext;
ptrdiff_t send_ext;
memchecker_comm(comm);
err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree);
if (MPI_SUCCESS == err) {
if (MPI_IN_PLACE != sendbuf) {
for ( i = 0; i < outdegree; i++ ) {
memchecker_datatype(sendtypes[i]);
ompi_datatype_type_extent(sendtypes[i], &send_ext);
memchecker_call(&opal_memchecker_base_isdefined,
(char *)(sendbuf)+sdispls[i]*send_ext,
sendcounts[i], sendtypes[i]);
}
}
for ( i = 0; i < indegree; i++ ) {
memchecker_datatype(recvtypes[i]);
ompi_datatype_type_extent(recvtypes[i], &recv_ext);
memchecker_call(&opal_memchecker_base_isaddressable,
(char *)(recvbuf)+sdispls[i]*recv_ext,
recvcounts[i], recvtypes[i]);
}
}
);
int MPI_Alltoallv(const void *sendbuf, const int sendcounts[],
const int sdispls[], MPI_Datatype sendtype,
void *recvbuf, const int recvcounts[], const int rdispls[],
MPI_Datatype recvtype, MPI_Comm comm)
{
int i, size, err;
SPC_RECORD(OMPI_SPC_ALLTOALLV, 1);
MEMCHECKER(
ptrdiff_t recv_ext;
ptrdiff_t send_ext;
if (MPI_IN_PLACE != sendbuf) {
memchecker_datatype(sendtype);
ompi_datatype_type_extent(sendtype, &send_ext);
}
memchecker_datatype(recvtype);
ompi_datatype_type_extent(recvtype, &recv_ext);
memchecker_comm(comm);
size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm);
for ( i = 0; i < size; i++ ) {
if (MPI_IN_PLACE != sendbuf) {
/* check if send chunks are defined. */
memchecker_call(&opal_memchecker_base_isdefined,
(char *)(sendbuf)+sdispls[i]*send_ext,
sendcounts[i], sendtype);
}
/* check if receive chunks are addressable. */
memchecker_call(&opal_memchecker_base_isaddressable,
(char *)(recvbuf)+rdispls[i]*recv_ext,
recvcounts[i], recvtype);
}
);
int MPI_Igather(const void *sendbuf, int sendcount, MPI_Datatype sendtype,
void *recvbuf, int recvcount, MPI_Datatype recvtype,
int root, MPI_Comm comm, MPI_Request *request)
{
int err;
MEMCHECKER(
int rank;
ptrdiff_t ext;
rank = ompi_comm_rank(comm);
ompi_datatype_type_extent(recvtype, &ext);
memchecker_comm(comm);
if(OMPI_COMM_IS_INTRA(comm)) {
if(ompi_comm_rank(comm) == root) {
/* check whether root's send buffer is defined. */
if (MPI_IN_PLACE == sendbuf) {
memchecker_call(&opal_memchecker_base_isdefined,
(char *)(recvbuf)+rank*ext,
recvcount, recvtype);
} else {
memchecker_datatype(sendtype);
memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype);
}
memchecker_datatype(recvtype);
/* check whether root's receive buffer is addressable. */
memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype);
} else {
memchecker_datatype(sendtype);
/* check whether send buffer is defined on other processes. */
memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype);
}
} else {
if (MPI_ROOT == root) {
memchecker_datatype(recvtype);
/* check whether root's receive buffer is addressable. */
memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype);
} else if (MPI_PROC_NULL != root) {
memchecker_datatype(sendtype);
/* check whether send buffer is defined. */
memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype);
}
}
);
int32_t ompi_datatype_create_subarray(int ndims,
int const* size_array,
int const* subsize_array,
int const* start_array,
int order,
const ompi_datatype_t* oldtype,
ompi_datatype_t** newtype)
{
MPI_Datatype last_type;
int32_t i, step, end_loop;
MPI_Aint size, displ, extent;
/**
* If the oldtype contains the original MPI_LB and MPI_UB markers then we
* are forced to follow the MPI standard suggestion and reset these 2
* markers (MPI 3.0 page 96 line 37). Otherwise we can simply resize the
* datatype.
*/
ompi_datatype_type_extent( oldtype, &extent );
/* If the ndims is zero then return the NULL datatype */
if( ndims < 2 ) {
if( 0 == ndims ) {
*newtype = &ompi_mpi_datatype_null.dt;
return MPI_SUCCESS;
}
ompi_datatype_create_contiguous( subsize_array[0], oldtype, &last_type );
size = size_array[0];
displ = start_array[0];
goto replace_subarray_type;
}
if( MPI_ORDER_C == order ) {
i = ndims - 1;
step = -1;
end_loop = -1;
} else {
i = 0;
step = 1;
end_loop = ndims;
}
/* As we know that the ndims is at least 1 we can start by creating the
* first dimension data outside the loop, such that we dont have to create
* a duplicate of the oldtype just to be able to free it.
*/
ompi_datatype_create_vector( subsize_array[i+step], subsize_array[i], size_array[i],
oldtype, newtype );
last_type = *newtype;
size = (MPI_Aint)size_array[i] * (MPI_Aint)size_array[i+step];
displ = (MPI_Aint)start_array[i] + (MPI_Aint)start_array[i+step] * (MPI_Aint)size_array[i];
for( i += 2 * step; i != end_loop; i += step ) {
ompi_datatype_create_hvector( subsize_array[i], 1, size * extent,
last_type, newtype );
ompi_datatype_destroy( &last_type );
displ += size * start_array[i];
size *= size_array[i];
last_type = *newtype;
}
replace_subarray_type:
/*
* Resized will only set the soft lb and ub markers without moving the real
* data inside. Thus, in case the original data contains the hard markers
* (MPI_LB or MPI_UB) we must force the displacement of the data upward to
* the right position AND set the hard markers LB and UB.
*
* NTH: ompi_datatype_create_resized() does not do enough for the general
* pack/unpack functions to work correctly. Until this is fixed always use
* ompi_datatype_create_struct(). Once this is fixed remove 1 || below. To
* verify that the regression is fixed run the subarray test in the Open MPI
* ibm testsuite.
*/
if(1 || oldtype->super.flags & (OPAL_DATATYPE_FLAG_USER_LB | OPAL_DATATYPE_FLAG_USER_UB) ) {
MPI_Aint displs[3];
MPI_Datatype types[3];
int blength[3] = { 1, 1, 1 };
displs[0] = 0; displs[1] = displ * extent; displs[2] = size * extent;
types[0] = MPI_LB; types[1] = last_type; types[2] = MPI_UB;
ompi_datatype_create_struct( 3, blength, displs, types, newtype );
} else {
ompi_datatype_create_resized(last_type, displ * extent, size * extent, newtype);
}
ompi_datatype_destroy( &last_type );
return OMPI_SUCCESS;
}
int
mca_coll_base_alltoallv_intra_basic_inplace(const void *rbuf, const int *rcounts, const int *rdisps,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm,
mca_coll_base_module_t *module)
{
mca_coll_base_module_t *base_module = (mca_coll_base_module_t*) module;
int i, j, size, rank, err=MPI_SUCCESS;
ompi_request_t **preq, **reqs;
char *allocated_buffer, *tmp_buffer;
size_t max_size, rdtype_size;
OPAL_PTRDIFF_TYPE ext, gap = 0;
/* Initialize. */
size = ompi_comm_size(comm);
rank = ompi_comm_rank(comm);
ompi_datatype_type_size(rdtype, &rdtype_size);
/* If only one process, we're done. */
if (1 == size || 0 == rdtype_size) {
return MPI_SUCCESS;
}
/* Find the largest receive amount */
ompi_datatype_type_extent (rdtype, &ext);
for (i = 0, max_size = 0 ; i < size ; ++i) {
size_t size = opal_datatype_span(&rdtype->super, rcounts[i], &gap);
max_size = size > max_size ? size : max_size;
}
/* The gap will always be the same as we are working on the same datatype */
/* Allocate a temporary buffer */
allocated_buffer = calloc (max_size, 1);
if (NULL == allocated_buffer) {
return OMPI_ERR_OUT_OF_RESOURCE;
}
tmp_buffer = allocated_buffer - gap;
/* Initiate all send/recv to/from others. */
reqs = preq = coll_base_comm_get_reqs(base_module->base_data, 2);
if( NULL == reqs ) { err = OMPI_ERR_OUT_OF_RESOURCE; goto error_hndl; }
/* in-place alltoallv slow algorithm (but works) */
for (i = 0 ; i < size ; ++i) {
for (j = i+1 ; j < size ; ++j) {
preq = reqs;
if (i == rank && rcounts[j]) {
/* Copy the data into the temporary buffer */
err = ompi_datatype_copy_content_same_ddt (rdtype, rcounts[j],
tmp_buffer, (char *) rbuf + rdisps[j] * ext);
if (MPI_SUCCESS != err) { goto error_hndl; }
/* Exchange data with the peer */
err = MCA_PML_CALL(irecv ((char *) rbuf + rdisps[j] * ext, rcounts[j], rdtype,
j, MCA_COLL_BASE_TAG_ALLTOALLV, comm, preq++));
if (MPI_SUCCESS != err) { goto error_hndl; }
err = MCA_PML_CALL(isend ((void *) tmp_buffer, rcounts[j], rdtype,
j, MCA_COLL_BASE_TAG_ALLTOALLV, MCA_PML_BASE_SEND_STANDARD,
comm, preq++));
if (MPI_SUCCESS != err) { goto error_hndl; }
} else if (j == rank && rcounts[i]) {
/* Copy the data into the temporary buffer */
err = ompi_datatype_copy_content_same_ddt (rdtype, rcounts[i],
tmp_buffer, (char *) rbuf + rdisps[i] * ext);
if (MPI_SUCCESS != err) { goto error_hndl; }
/* Exchange data with the peer */
err = MCA_PML_CALL(irecv ((char *) rbuf + rdisps[i] * ext, rcounts[i], rdtype,
i, MCA_COLL_BASE_TAG_ALLTOALLV, comm, preq++));
if (MPI_SUCCESS != err) { goto error_hndl; }
err = MCA_PML_CALL(isend ((void *) tmp_buffer, rcounts[i], rdtype,
i, MCA_COLL_BASE_TAG_ALLTOALLV, MCA_PML_BASE_SEND_STANDARD,
comm, preq++));
if (MPI_SUCCESS != err) { goto error_hndl; }
} else {
continue;
}
/* Wait for the requests to complete */
err = ompi_request_wait_all (2, reqs, MPI_STATUSES_IGNORE);
if (MPI_SUCCESS != err) { goto error_hndl; }
}
}
error_hndl:
/* Free the temporary buffer */
free (allocated_buffer);
if( MPI_SUCCESS != err ) {
ompi_coll_base_free_reqs(reqs, 2 );
}
/* All done */
return err;
}
/* the non-blocking reduce */
int ompi_coll_libnbc_ireduce(const void* sendbuf, void* recvbuf, int count, MPI_Datatype datatype,
MPI_Op op, int root, struct ompi_communicator_t *comm, ompi_request_t ** request,
struct mca_coll_base_module_2_1_0_t *module) {
int rank, p, res, segsize;
size_t size;
MPI_Aint ext;
NBC_Schedule *schedule;
char *redbuf=NULL, inplace;
enum { NBC_RED_BINOMIAL, NBC_RED_CHAIN } alg;
NBC_Handle *handle;
ompi_coll_libnbc_module_t *libnbc_module = (ompi_coll_libnbc_module_t*) module;
NBC_IN_PLACE(sendbuf, recvbuf, inplace);
rank = ompi_comm_rank (comm);
p = ompi_comm_size (comm);
res = ompi_datatype_type_extent(datatype, &ext);
if (MPI_SUCCESS != res) {
NBC_Error("MPI Error in ompi_datatype_type_extent() (%i)", res);
return res;
}
res = ompi_datatype_type_size(datatype, &size);
if (MPI_SUCCESS != res) {
NBC_Error("MPI Error in ompi_datatype_type_size() (%i)", res);
return res;
}
/* only one node -> copy data */
if ((p == 1) && !inplace) {
res = NBC_Copy (sendbuf, count, datatype, recvbuf, count, datatype, comm);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
return res;
}
*request = &ompi_request_empty;
return OMPI_SUCCESS;
}
res = NBC_Init_handle (comm, &handle, libnbc_module);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
return res;
}
/* algorithm selection */
if (p > 4 || size * count < 65536) {
alg = NBC_RED_BINOMIAL;
if(rank == root) {
/* root reduces in receivebuffer */
handle->tmpbuf = malloc (ext * count);
} else {
/* recvbuf may not be valid on non-root nodes */
handle->tmpbuf = malloc (ext * count * 2);
redbuf = (char*) handle->tmpbuf + ext * count;
}
} else {
handle->tmpbuf = malloc (ext * count);
alg = NBC_RED_CHAIN;
segsize = 16384/2;
}
if (OPAL_UNLIKELY(NULL == handle->tmpbuf)) {
NBC_Return_handle (handle);
return OMPI_ERR_OUT_OF_RESOURCE;
}
#ifdef NBC_CACHE_SCHEDULE
NBC_Reduce_args *args, *found, search;
/* search schedule in communicator specific tree */
search.sendbuf = sendbuf;
search.recvbuf = recvbuf;
search.count = count;
search.datatype = datatype;
search.op = op;
search.root = root;
found = (NBC_Reduce_args *) hb_tree_search ((hb_tree *) libnbc_module->NBC_Dict[NBC_REDUCE], &search);
if (NULL == found) {
#endif
schedule = OBJ_NEW(NBC_Schedule);
if (OPAL_UNLIKELY(NULL == schedule)) {
NBC_Return_handle (handle);
return OMPI_ERR_OUT_OF_RESOURCE;
}
/* make sure the schedule is released with the handle on error */
handle->schedule = schedule;
switch(alg) {
case NBC_RED_BINOMIAL:
res = red_sched_binomial(rank, p, root, sendbuf, recvbuf, count, datatype, op, redbuf, schedule, handle);
break;
case NBC_RED_CHAIN:
res = red_sched_chain(rank, p, root, sendbuf, recvbuf, count, datatype, op, ext, size, schedule, handle, segsize);
break;
}
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
NBC_Return_handle (handle);
return res;
}
res = NBC_Sched_commit(schedule);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
NBC_Return_handle (handle);
return res;
}
#ifdef NBC_CACHE_SCHEDULE
/* save schedule to tree */
args = (NBC_Reduce_args *) malloc (sizeof (args));
if (NULL != args) {
args->sendbuf = sendbuf;
args->recvbuf = recvbuf;
args->count = count;
args->datatype = datatype;
args->op = op;
args->root = root;
args->schedule = schedule;
res = hb_tree_insert ((hb_tree *) libnbc_module->NBC_Dict[NBC_REDUCE], args, args, 0);
if (0 == res) {
OBJ_RETAIN(schedule);
/* increase number of elements for Reduce */
if (++libnbc_module->NBC_Dict_size[NBC_REDUCE] > NBC_SCHED_DICT_UPPER) {
NBC_SchedCache_dictwipe ((hb_tree *) libnbc_module->NBC_Dict[NBC_REDUCE],
&libnbc_module->NBC_Dict_size[NBC_REDUCE]);
}
} else {
NBC_Error("error in dict_insert() (%i)", res);
free (args);
}
}
} else {
/* found schedule */
schedule = found->schedule;
OBJ_RETAIN(schedule);
}
#endif
res = NBC_Start(handle, schedule);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
NBC_Return_handle (handle);
return res;
}
*request = (ompi_request_t *) handle;
/* tmpbuf is freed with the handle */
return OMPI_SUCCESS;
}
/* linear iexscan
* working principle:
* 1. each node (but node 0) receives from left neigbor
* 2. performs op
* 3. all but rank p-1 do sends to it's right neigbor and exits
*
*/
int ompi_coll_libnbc_iexscan(const void* sendbuf, void* recvbuf, int count, MPI_Datatype datatype, MPI_Op op,
struct ompi_communicator_t *comm, ompi_request_t ** request,
struct mca_coll_base_module_2_1_0_t *module) {
int rank, p, res;
MPI_Aint ext;
NBC_Schedule *schedule;
#ifdef NBC_CACHE_SCHEDULE
NBC_Scan_args *args, *found, search;
#endif
char inplace;
NBC_Handle *handle;
ompi_coll_libnbc_module_t *libnbc_module = (ompi_coll_libnbc_module_t*) module;
NBC_IN_PLACE(sendbuf, recvbuf, inplace);
rank = ompi_comm_rank (comm);
p = ompi_comm_size (comm);
res = ompi_datatype_type_extent(datatype, &ext);
if (MPI_SUCCESS != res) {
NBC_Error("MPI Error in ompi_datatype_type_extent() (%i)", res);
return res;
}
res = NBC_Init_handle(comm, &handle, libnbc_module);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
return res;
}
if (inplace && rank < p - 1) {
/* need more buffer space for the inplace case */
handle->tmpbuf = malloc(ext * count * 2);
} else {
handle->tmpbuf = malloc(ext * count);
}
if (handle->tmpbuf == NULL) {
NBC_Return_handle (handle);
return OMPI_ERR_OUT_OF_RESOURCE;
}
#ifdef NBC_CACHE_SCHEDULE
/* search schedule in communicator specific tree */
search.sendbuf = sendbuf;
search.recvbuf = recvbuf;
search.count = count;
search.datatype = datatype;
search.op = op;
found = (NBC_Scan_args *) hb_tree_search ((hb_tree *) libnbc_module->NBC_Dict[NBC_EXSCAN], &search);
if (NULL == found) {
#endif
schedule = OBJ_NEW(NBC_Schedule);
if (OPAL_UNLIKELY(NULL == schedule)) {
NBC_Return_handle (handle);
return OMPI_ERR_OUT_OF_RESOURCE;
}
/* make sure the schedule is released with the handle on error */
handle->schedule = schedule;
if (rank != 0) {
if (inplace && rank < p - 1) {
/* if sendbuf == recvbuf do not clobber the send buffer until it has been combined
* with the incoming data. */
res = NBC_Sched_recv ((void *) (ext * count), true, count, datatype, rank-1, schedule, false);
} else {
res = NBC_Sched_recv (recvbuf, false, count, datatype, rank-1, schedule, false);
}
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
NBC_Return_handle (handle);
return res;
}
if (rank < p - 1) {
/* we have to wait until we have the data */
res = NBC_Sched_barrier(schedule);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
NBC_Return_handle (handle);
return res;
}
/* perform the reduce in my temporary buffer */
/* this cannot be done until handle->tmpbuf is unused :-( so barrier after */
if (inplace) {
res = NBC_Sched_op (0, true, sendbuf, false, (void *)(ext * count), true, count,
datatype, op, schedule, true);
} else {
res = NBC_Sched_op (0, true, sendbuf, false, recvbuf, false, count, datatype, op,
schedule, true);
}
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
NBC_Return_handle (handle);
return res;
}
/* send reduced data onward */
res = NBC_Sched_send (0, true, count, datatype, rank + 1, schedule, false);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
NBC_Return_handle (handle);
return res;
}
if (inplace) {
/* copy the received data into the receive buffer */
res = NBC_Sched_copy ((void *)(ext * count), true, count, datatype, recvbuf,
false, count, datatype, schedule, false);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
NBC_Return_handle (handle);
return res;
}
}
}
} else if (p > 1) {
res = NBC_Sched_send (sendbuf, false, count, datatype, 1, schedule, false);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
NBC_Return_handle (handle);
return res;
}
}
res = NBC_Sched_commit(schedule);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
NBC_Return_handle (handle);
return res;
}
#ifdef NBC_CACHE_SCHEDULE
/* save schedule to tree */
args = (NBC_Scan_args *) malloc (sizeof (args));
if (NULL != args) {
args->sendbuf = sendbuf;
args->recvbuf = recvbuf;
args->count = count;
args->datatype = datatype;
args->op = op;
args->schedule = schedule;
res = hb_tree_insert ((hb_tree *) libnbc_module->NBC_Dict[NBC_EXSCAN], args, args, 0);
if (0 == res) {
OBJ_RETAIN(schedule);
/* increase number of elements for A2A */
if (++libnbc_module->NBC_Dict_size[NBC_EXSCAN] > NBC_SCHED_DICT_UPPER) {
NBC_SchedCache_dictwipe ((hb_tree *) libnbc_module->NBC_Dict[NBC_EXSCAN],
&libnbc_module->NBC_Dict_size[NBC_EXSCAN]);
}
} else {
NBC_Error("error in dict_insert() (%i)", res);
free (args);
}
}
} else {
/* found schedule */
schedule = found->schedule;
OBJ_RETAIN(schedule);
}
#endif
res = NBC_Start (handle, schedule);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
NBC_Return_handle (handle);
return res;
}
*request = (ompi_request_t *) handle;
/* tmpbuf is freed with the handle */
return OMPI_SUCCESS;
}
int32_t ompi_datatype_create_subarray(int ndims,
int const* size_array,
int const* subsize_array,
int const* start_array,
int order,
const ompi_datatype_t* oldtype,
ompi_datatype_t** newtype)
{
MPI_Datatype last_type;
int32_t i, step, end_loop;
MPI_Aint size, displ, extent;
ompi_datatype_type_extent( oldtype, &extent );
/* If the ndims is zero then return the NULL datatype */
if( ndims < 2 ) {
if( 0 == ndims ) {
*newtype = &ompi_mpi_datatype_null.dt;
return MPI_SUCCESS;
}
ompi_datatype_create_contiguous( subsize_array[0], oldtype, &last_type );
size = size_array[0];
displ = start_array[0];
goto replace_subarray_type;
}
if( MPI_ORDER_C == order ) {
i = ndims - 1;
step = -1;
end_loop = -1;
} else {
i = 0;
step = 1;
end_loop = ndims;
}
/* As we know that the ndims is at least 1 we can start by creating the
* first dimension data outside the loop, such that we dont have to create
* a duplicate of the oldtype just to be able to free it.
*/
ompi_datatype_create_vector( subsize_array[i+step], subsize_array[i], size_array[i],
oldtype, newtype );
last_type = *newtype;
size = size_array[i] * size_array[i+step];
displ = start_array[i] + start_array[i+step] * size_array[i];
for( i += 2 * step; i != end_loop; i += step ) {
ompi_datatype_create_hvector( subsize_array[i], 1, size * extent,
last_type, newtype );
ompi_datatype_destroy( &last_type );
displ += size * start_array[i];
size *= size_array[i];
last_type = *newtype;
}
replace_subarray_type:
/**
* We cannot use resized here. Resized will only set the soft lb and ub markers
* without moving the real data inside. What we need is to force the displacement
* of the data upward to the right position AND set the LB and UB. A type
* struct is the function we need.
*/
{
MPI_Aint displs[3];
MPI_Datatype types[3];
int blength[3] = { 1, 1, 1 };
displs[0] = 0;
displs[1] = displ * extent;
displs[2] = size * extent;
types[0] = MPI_LB;
types[1] = last_type;
types[2] = MPI_UB;
ompi_datatype_create_struct( 3, blength, displs, types, newtype );
}
ompi_datatype_destroy( &last_type );
return OMPI_SUCCESS;
}
/* MPI_IN_PLACE all to all algorithm. TODO: implement a better one. */
int
mca_coll_base_alltoall_intra_basic_inplace(const void *rbuf, int rcount,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm,
mca_coll_base_module_t *module)
{
int i, j, size, rank, err = MPI_SUCCESS, line;
OPAL_PTRDIFF_TYPE ext, gap;
ompi_request_t *req;
char *allocated_buffer = NULL, *tmp_buffer;
size_t max_size;
/* Initialize. */
size = ompi_comm_size(comm);
rank = ompi_comm_rank(comm);
/* If only one process, we're done. */
if (1 == size) {
return MPI_SUCCESS;
}
/* Find the largest receive amount */
ompi_datatype_type_extent (rdtype, &ext);
max_size = opal_datatype_span(&rdtype->super, rcount, &gap);
/* Initiate all send/recv to/from others. */
/* Allocate a temporary buffer */
allocated_buffer = calloc (max_size, 1);
if( NULL == allocated_buffer) { err = OMPI_ERR_OUT_OF_RESOURCE; line = __LINE__; goto error_hndl; }
tmp_buffer = allocated_buffer - gap;
max_size = ext * rcount;
/* in-place alltoall slow algorithm (but works) */
for (i = 0 ; i < size ; ++i) {
for (j = i+1 ; j < size ; ++j) {
if (i == rank) {
/* Copy the data into the temporary buffer */
err = ompi_datatype_copy_content_same_ddt (rdtype, rcount, tmp_buffer,
(char *) rbuf + j * max_size);
if (MPI_SUCCESS != err) { line = __LINE__; goto error_hndl; }
/* Exchange data with the peer */
err = MCA_PML_CALL(irecv ((char *) rbuf + max_size * j, rcount, rdtype,
j, MCA_COLL_BASE_TAG_ALLTOALL, comm, &req));
if (MPI_SUCCESS != err) { line = __LINE__; goto error_hndl; }
err = MCA_PML_CALL(send ((char *) tmp_buffer, rcount, rdtype,
j, MCA_COLL_BASE_TAG_ALLTOALL, MCA_PML_BASE_SEND_STANDARD,
comm));
if (MPI_SUCCESS != err) { line = __LINE__; goto error_hndl; }
} else if (j == rank) {
/* Copy the data into the temporary buffer */
err = ompi_datatype_copy_content_same_ddt (rdtype, rcount, tmp_buffer,
(char *) rbuf + i * max_size);
if (MPI_SUCCESS != err) { line = __LINE__; goto error_hndl; }
/* Exchange data with the peer */
err = MCA_PML_CALL(irecv ((char *) rbuf + max_size * i, rcount, rdtype,
i, MCA_COLL_BASE_TAG_ALLTOALL, comm, &req));
if (MPI_SUCCESS != err) { line = __LINE__; goto error_hndl; }
err = MCA_PML_CALL(send ((char *) tmp_buffer, rcount, rdtype,
i, MCA_COLL_BASE_TAG_ALLTOALL, MCA_PML_BASE_SEND_STANDARD,
comm));
if (MPI_SUCCESS != err) { line = __LINE__; goto error_hndl; }
} else {
continue;
}
/* Wait for the requests to complete */
err = ompi_request_wait ( &req, MPI_STATUSES_IGNORE);
if (MPI_SUCCESS != err) { line = __LINE__; goto error_hndl; }
}
}
error_hndl:
/* Free the temporary buffer */
if( NULL != allocated_buffer )
free (allocated_buffer);
if( MPI_SUCCESS != err ) {
OPAL_OUTPUT((ompi_coll_base_framework.framework_output,
"%s:%4d\tError occurred %d, rank %2d", __FILE__, line, err,
rank));
(void)line; // silence compiler warning
}
/* All done */
return err;
}
int ompi_coll_libnbc_igather(const void* sendbuf, int sendcount, MPI_Datatype sendtype, void* recvbuf,
int recvcount, MPI_Datatype recvtype, int root,
struct ompi_communicator_t *comm, ompi_request_t ** request,
struct mca_coll_base_module_2_1_0_t *module) {
int rank, p, res;
MPI_Aint rcvext = 0;
NBC_Schedule *schedule;
char *rbuf, inplace = 0;
NBC_Handle *handle;
ompi_coll_libnbc_module_t *libnbc_module = (ompi_coll_libnbc_module_t*) module;
rank = ompi_comm_rank (comm);
if (root == rank) {
NBC_IN_PLACE(sendbuf, recvbuf, inplace);
}
p = ompi_comm_size (comm);
if (rank == root) {
res = ompi_datatype_type_extent (recvtype, &rcvext);
if (MPI_SUCCESS != res) {
NBC_Error("MPI Error in ompi_datatype_type_extent() (%i)", res);
return res;
}
}
if (inplace) {
sendcount = recvcount;
sendtype = recvtype;
} else if (rank == root) {
rbuf = ((char *)recvbuf) + (rank*recvcount*rcvext);
/* if I am the root - just copy the message (only without MPI_IN_PLACE) */
res = NBC_Copy(sendbuf, sendcount, sendtype, rbuf, recvcount, recvtype, comm);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
return res;
}
}
#ifdef NBC_CACHE_SCHEDULE
NBC_Gather_args *args, *found, search;
/* search schedule in communicator specific tree */
search.sendbuf = sendbuf;
search.sendcount = sendcount;
search.sendtype = sendtype;
search.recvbuf = recvbuf;
search.recvcount = recvcount;
search.recvtype = recvtype;
search.root = root;
found = (NBC_Gather_args *) hb_tree_search ((hb_tree *) libnbc_module->NBC_Dict[NBC_GATHER],
&search);
if (NULL == found) {
#endif
schedule = OBJ_NEW(NBC_Schedule);
if (OPAL_UNLIKELY(NULL == schedule)) {
return OMPI_ERR_OUT_OF_RESOURCE;
}
/* send to root */
if (rank != root) {
/* send msg to root */
res = NBC_Sched_send(sendbuf, false, sendcount, sendtype, root, schedule, false);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
OBJ_RELEASE(schedule);
return res;
}
} else {
for (int i = 0 ; i < p ; ++i) {
rbuf = (char *)recvbuf + i * recvcount * rcvext;
if (i != root) {
/* root receives message to the right buffer */
res = NBC_Sched_recv (rbuf, false, recvcount, recvtype, i, schedule, false);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
OBJ_RELEASE(schedule);
return res;
}
}
}
}
res = NBC_Sched_commit (schedule);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
OBJ_RELEASE(schedule);
return res;
}
#ifdef NBC_CACHE_SCHEDULE
/* save schedule to tree */
args = (NBC_Gather_args *) malloc (sizeof (args));
if (NULL != args) {
args->sendbuf = sendbuf;
args->sendcount = sendcount;
args->sendtype = sendtype;
args->recvbuf = recvbuf;
args->recvcount = recvcount;
args->recvtype = recvtype;
args->root = root;
args->schedule = schedule;
res = hb_tree_insert ((hb_tree *) libnbc_module->NBC_Dict[NBC_GATHER], args, args, 0);
if (0 == res) {
OBJ_RETAIN(schedule);
/* increase number of elements for A2A */
if (++libnbc_module->NBC_Dict_size[NBC_GATHER] > NBC_SCHED_DICT_UPPER) {
NBC_SchedCache_dictwipe ((hb_tree *) libnbc_module->NBC_Dict[NBC_GATHER],
&libnbc_module->NBC_Dict_size[NBC_GATHER]);
}
} else {
NBC_Error("error in dict_insert() (%i)", res);
free (args);
}
}
} else {
/* found schedule */
schedule = found->schedule;
OBJ_RETAIN(schedule);
}
#endif
res = NBC_Init_handle (comm, &handle, libnbc_module);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
OBJ_RELEASE(schedule);
return res;
}
res = NBC_Start (handle, schedule);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
NBC_Return_handle (handle);
return res;
}
*request = (ompi_request_t *) handle;
return OMPI_SUCCESS;
}
int32_t ompi_datatype_create_subarray(int ndims,
int const* size_array,
int const* subsize_array,
int const* start_array,
int order,
const ompi_datatype_t* oldtype,
ompi_datatype_t** newtype)
{
MPI_Datatype last_type;
int32_t i, step, end_loop;
MPI_Aint size, displ, extent;
/**
* If the oldtype contains the original MPI_LB and MPI_UB markers then we
* are forced to follow the MPI standard suggestion and reset these 2
* markers (MPI 3.0 page 96 line 37). Otherwise we can simply resize the
* datatype.
*/
ompi_datatype_type_extent( oldtype, &extent );
/* If the ndims is zero then return the NULL datatype */
if( ndims < 2 ) {
if( 0 == ndims ) {
*newtype = &ompi_mpi_datatype_null.dt;
return MPI_SUCCESS;
}
ompi_datatype_create_contiguous( subsize_array[0], oldtype, &last_type );
size = size_array[0];
displ = start_array[0];
goto replace_subarray_type;
}
if( MPI_ORDER_C == order ) {
i = ndims - 1;
step = -1;
end_loop = -1;
} else {
i = 0;
step = 1;
end_loop = ndims;
}
/* As we know that the ndims is at least 1 we can start by creating the
* first dimension data outside the loop, such that we dont have to create
* a duplicate of the oldtype just to be able to free it.
*/
ompi_datatype_create_vector( subsize_array[i+step], subsize_array[i], size_array[i],
oldtype, newtype );
last_type = *newtype;
size = (MPI_Aint)size_array[i] * (MPI_Aint)size_array[i+step];
displ = (MPI_Aint)start_array[i] + (MPI_Aint)start_array[i+step] * (MPI_Aint)size_array[i];
for( i += 2 * step; i != end_loop; i += step ) {
ompi_datatype_create_hvector( subsize_array[i], 1, size * extent,
last_type, newtype );
ompi_datatype_destroy( &last_type );
displ += size * start_array[i];
size *= size_array[i];
last_type = *newtype;
}
replace_subarray_type:
/**
* We need to shift the content (useful data) of the datatype, so
* we need to force the displacement to be moved. Therefore, we
* cannot use resize as it will only set the soft lb and ub
* markers without moving the data. Instead, we have to create a
* new data, and insert the last_Type with the correct
* displacement.
*/
*newtype = ompi_datatype_create( last_type->super.desc.used );
ompi_datatype_add( *newtype, last_type, 1, displ * extent, size * extent);
ompi_datatype_destroy( &last_type );
return OMPI_SUCCESS;
}
int ompi_coll_libnbc_igather_inter (const void* sendbuf, int sendcount, MPI_Datatype sendtype, void* recvbuf,
int recvcount, MPI_Datatype recvtype, int root,
struct ompi_communicator_t *comm, ompi_request_t ** request,
struct mca_coll_base_module_2_1_0_t *module) {
int res, rsize;
MPI_Aint rcvext = 0;
NBC_Schedule *schedule;
char *rbuf;
NBC_Handle *handle;
ompi_coll_libnbc_module_t *libnbc_module = (ompi_coll_libnbc_module_t*) module;
rsize = ompi_comm_remote_size (comm);
if (root == MPI_ROOT) {
res = ompi_datatype_type_extent(recvtype, &rcvext);
if (MPI_SUCCESS != res) {
NBC_Error("MPI Error in ompi_datatype_type_extent() (%i)", res);
return res;
}
}
schedule = OBJ_NEW(NBC_Schedule);
if (OPAL_UNLIKELY(NULL == schedule)) {
return OMPI_ERR_OUT_OF_RESOURCE;
}
/* send to root */
if (root != MPI_ROOT && root != MPI_PROC_NULL) {
/* send msg to root */
res = NBC_Sched_send (sendbuf, false, sendcount, sendtype, root, schedule, false);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
OBJ_RELEASE(schedule);
return res;
}
} else if (MPI_ROOT == root) {
for (int i = 0 ; i < rsize ; ++i) {
rbuf = ((char *)recvbuf) + (i * recvcount * rcvext);
/* root receives message to the right buffer */
res = NBC_Sched_recv (rbuf, false, recvcount, recvtype, i, schedule, false);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
OBJ_RELEASE(schedule);
return res;
}
}
}
res = NBC_Sched_commit (schedule);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
OBJ_RELEASE(schedule);
return res;
}
res = NBC_Init_handle (comm, &handle, libnbc_module);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
OBJ_RELEASE(schedule);
return res;
}
res = NBC_Start (handle, schedule);
if (OPAL_UNLIKELY(OMPI_SUCCESS != res)) {
NBC_Return_handle (handle);
return res;
}
*request = (ompi_request_t *) handle;
return OMPI_SUCCESS;
}
/*
* Linear functions are copied from the basic coll module. For
* some small number of nodes and/or small data sizes they are just as
* fast as tuned/tree based segmenting operations and as such may be
* selected by the decision functions. These are copied into this module
* due to the way we select modules in V1. i.e. in V2 we will handle this
* differently and so will not have to duplicate code.
* GEF Oct05 after asking Jeff.
*/
int
ompi_coll_tuned_alltoallv_intra_basic_linear(void *sbuf, int *scounts, int *sdisps,
struct ompi_datatype_t *sdtype,
void *rbuf, int *rcounts, int *rdisps,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm,
mca_coll_base_module_t *module)
{
int i, size, rank, err, nreqs;
char *psnd, *prcv;
ptrdiff_t sext, rext;
MPI_Request *preq;
mca_coll_tuned_module_t *tuned_module = (mca_coll_tuned_module_t*) module;
mca_coll_tuned_comm_t *data = tuned_module->tuned_data;
if (MPI_IN_PLACE == sbuf) {
return mca_coll_tuned_alltoallv_intra_basic_inplace (rbuf, rcounts, rdisps,
rdtype, comm, module);
}
size = ompi_comm_size(comm);
rank = ompi_comm_rank(comm);
OPAL_OUTPUT((ompi_coll_tuned_stream,
"coll:tuned:alltoallv_intra_basic_linear rank %d", rank));
ompi_datatype_type_extent(sdtype, &sext);
ompi_datatype_type_extent(rdtype, &rext);
/* Simple optimization - handle send to self first */
psnd = ((char *) sbuf) + (ptrdiff_t)sdisps[rank] * sext;
prcv = ((char *) rbuf) + (ptrdiff_t)rdisps[rank] * rext;
if (0 != scounts[rank]) {
err = ompi_datatype_sndrcv(psnd, scounts[rank], sdtype,
prcv, rcounts[rank], rdtype);
if (MPI_SUCCESS != err) {
return err;
}
}
/* If only one process, we're done. */
if (1 == size) {
return MPI_SUCCESS;
}
/* Now, initiate all send/recv to/from others. */
nreqs = 0;
preq = data->mcct_reqs;
/* Post all receives first */
for (i = 0; i < size; ++i) {
if (i == rank || 0 == rcounts[i]) {
continue;
}
prcv = ((char *) rbuf) + (ptrdiff_t)rdisps[i] * rext;
err = MCA_PML_CALL(irecv_init(prcv, rcounts[i], rdtype,
i, MCA_COLL_BASE_TAG_ALLTOALLV, comm,
preq++));
++nreqs;
if (MPI_SUCCESS != err) {
ompi_coll_tuned_free_reqs(data->mcct_reqs, nreqs);
return err;
}
}
/* Now post all sends */
for (i = 0; i < size; ++i) {
if (i == rank || 0 == scounts[i]) {
continue;
}
psnd = ((char *) sbuf) + (ptrdiff_t)sdisps[i] * sext;
err = MCA_PML_CALL(isend_init(psnd, scounts[i], sdtype,
i, MCA_COLL_BASE_TAG_ALLTOALLV,
MCA_PML_BASE_SEND_STANDARD, comm,
preq++));
++nreqs;
if (MPI_SUCCESS != err) {
ompi_coll_tuned_free_reqs(data->mcct_reqs, nreqs);
return err;
}
}
/* Start your engines. This will never return an error. */
MCA_PML_CALL(start(nreqs, data->mcct_reqs));
/* Wait for them all. If there's an error, note that we don't care
* what the error was -- just that there *was* an error. The PML
* will finish all requests, even if one or more of them fail.
* i.e., by the end of this call, all the requests are free-able.
* So free them anyway -- even if there was an error, and return the
* error after we free everything. */
err = ompi_request_wait_all(nreqs, data->mcct_reqs,
MPI_STATUSES_IGNORE);
/* Free the requests. */
ompi_coll_tuned_free_reqs(data->mcct_reqs, nreqs);
return err;
}
/**
* This is a generic implementation of the reduce protocol. It used the tree
* provided as an argument and execute all operations using a segment of
* count times a datatype.
* For the last communication it will update the count in order to limit
* the number of datatype to the original count (original_count)
*
* Note that for non-commutative operations we cannot save memory copy
* for the first block: thus we must copy sendbuf to accumbuf on intermediate
* to keep the optimized loop happy.
*/
int ompi_coll_base_reduce_generic( const void* sendbuf, void* recvbuf, int original_count,
ompi_datatype_t* datatype, ompi_op_t* op,
int root, ompi_communicator_t* comm,
mca_coll_base_module_t *module,
ompi_coll_tree_t* tree, int count_by_segment,
int max_outstanding_reqs )
{
char *inbuf[2] = {NULL, NULL}, *inbuf_free[2] = {NULL, NULL};
char *accumbuf = NULL, *accumbuf_free = NULL;
char *local_op_buffer = NULL, *sendtmpbuf = NULL;
ptrdiff_t extent, size, gap = 0, segment_increment;
ompi_request_t **sreq = NULL, *reqs[2] = {MPI_REQUEST_NULL, MPI_REQUEST_NULL};
int num_segments, line, ret, segindex, i, rank;
int recvcount, prevcount, inbi;
/**
* Determine number of segments and number of elements
* sent per operation
*/
ompi_datatype_type_extent( datatype, &extent );
num_segments = (int)(((size_t)original_count + (size_t)count_by_segment - (size_t)1) / (size_t)count_by_segment);
segment_increment = (ptrdiff_t)count_by_segment * extent;
sendtmpbuf = (char*) sendbuf;
if( sendbuf == MPI_IN_PLACE ) {
sendtmpbuf = (char *)recvbuf;
}
OPAL_OUTPUT((ompi_coll_base_framework.framework_output, "coll:base:reduce_generic count %d, msg size %ld, segsize %ld, max_requests %d",
original_count, (unsigned long)((ptrdiff_t)num_segments * (ptrdiff_t)segment_increment),
(unsigned long)segment_increment, max_outstanding_reqs));
rank = ompi_comm_rank(comm);
/* non-leaf nodes - wait for children to send me data & forward up
(if needed) */
if( tree->tree_nextsize > 0 ) {
ptrdiff_t real_segment_size;
/* handle non existant recv buffer (i.e. its NULL) and
protect the recv buffer on non-root nodes */
accumbuf = (char*)recvbuf;
if( (NULL == accumbuf) || (root != rank) ) {
/* Allocate temporary accumulator buffer. */
size = opal_datatype_span(&datatype->super, original_count, &gap);
accumbuf_free = (char*)malloc(size);
if (accumbuf_free == NULL) {
line = __LINE__; ret = -1; goto error_hndl;
}
accumbuf = accumbuf_free - gap;
}
/* If this is a non-commutative operation we must copy
sendbuf to the accumbuf, in order to simplfy the loops */
if (!ompi_op_is_commute(op) && MPI_IN_PLACE != sendbuf) {
ompi_datatype_copy_content_same_ddt(datatype, original_count,
(char*)accumbuf,
(char*)sendtmpbuf);
}
/* Allocate two buffers for incoming segments */
real_segment_size = opal_datatype_span(&datatype->super, count_by_segment, &gap);
inbuf_free[0] = (char*) malloc(real_segment_size);
if( inbuf_free[0] == NULL ) {
line = __LINE__; ret = -1; goto error_hndl;
}
inbuf[0] = inbuf_free[0] - gap;
/* if there is chance to overlap communication -
allocate second buffer */
if( (num_segments > 1) || (tree->tree_nextsize > 1) ) {
inbuf_free[1] = (char*) malloc(real_segment_size);
if( inbuf_free[1] == NULL ) {
line = __LINE__; ret = -1; goto error_hndl;
}
inbuf[1] = inbuf_free[1] - gap;
}
/* reset input buffer index and receive count */
inbi = 0;
recvcount = 0;
/* for each segment */
for( segindex = 0; segindex <= num_segments; segindex++ ) {
prevcount = recvcount;
/* recvcount - number of elements in current segment */
recvcount = count_by_segment;
if( segindex == (num_segments-1) )
recvcount = original_count - (ptrdiff_t)count_by_segment * (ptrdiff_t)segindex;
/* for each child */
for( i = 0; i < tree->tree_nextsize; i++ ) {
/**
* We try to overlap communication:
* either with next segment or with the next child
*/
/* post irecv for current segindex on current child */
if( segindex < num_segments ) {
void* local_recvbuf = inbuf[inbi];
if( 0 == i ) {
/* for the first step (1st child per segment) and
* commutative operations we might be able to irecv
* directly into the accumulate buffer so that we can
* reduce(op) this with our sendbuf in one step as
* ompi_op_reduce only has two buffer pointers,
* this avoids an extra memory copy.
*
* BUT if the operation is non-commutative or
* we are root and are USING MPI_IN_PLACE this is wrong!
*/
if( (ompi_op_is_commute(op)) &&
!((MPI_IN_PLACE == sendbuf) && (rank == tree->tree_root)) ) {
local_recvbuf = accumbuf + (ptrdiff_t)segindex * (ptrdiff_t)segment_increment;
}
}
ret = MCA_PML_CALL(irecv(local_recvbuf, recvcount, datatype,
tree->tree_next[i],
MCA_COLL_BASE_TAG_REDUCE, comm,
&reqs[inbi]));
if (ret != MPI_SUCCESS) { line = __LINE__; goto error_hndl;}
}
/* wait for previous req to complete, if any.
if there are no requests reqs[inbi ^1] will be
MPI_REQUEST_NULL. */
/* wait on data from last child for previous segment */
ret = ompi_request_wait(&reqs[inbi ^ 1],
MPI_STATUSES_IGNORE );
if (ret != MPI_SUCCESS) { line = __LINE__; goto error_hndl; }
local_op_buffer = inbuf[inbi ^ 1];
if( i > 0 ) {
/* our first operation is to combine our own [sendbuf] data
* with the data we recvd from down stream (but only
* the operation is commutative and if we are not root and
* not using MPI_IN_PLACE)
*/
if( 1 == i ) {
if( (ompi_op_is_commute(op)) &&
!((MPI_IN_PLACE == sendbuf) && (rank == tree->tree_root)) ) {
local_op_buffer = sendtmpbuf + (ptrdiff_t)segindex * (ptrdiff_t)segment_increment;
}
}
/* apply operation */
ompi_op_reduce(op, local_op_buffer,
accumbuf + (ptrdiff_t)segindex * (ptrdiff_t)segment_increment,
recvcount, datatype );
} else if ( segindex > 0 ) {
void* accumulator = accumbuf + (ptrdiff_t)(segindex-1) * (ptrdiff_t)segment_increment;
if( tree->tree_nextsize <= 1 ) {
if( (ompi_op_is_commute(op)) &&
!((MPI_IN_PLACE == sendbuf) && (rank == tree->tree_root)) ) {
local_op_buffer = sendtmpbuf + (ptrdiff_t)(segindex-1) * (ptrdiff_t)segment_increment;
}
}
ompi_op_reduce(op, local_op_buffer, accumulator, prevcount,
datatype );
/* all reduced on available data this step (i) complete,
* pass to the next process unless you are the root.
*/
if (rank != tree->tree_root) {
/* send combined/accumulated data to parent */
ret = MCA_PML_CALL( send( accumulator, prevcount,
datatype, tree->tree_prev,
MCA_COLL_BASE_TAG_REDUCE,
MCA_PML_BASE_SEND_STANDARD,
comm) );
if (ret != MPI_SUCCESS) {
line = __LINE__; goto error_hndl;
}
}
/* we stop when segindex = number of segments
(i.e. we do num_segment+1 steps for pipelining */
if (segindex == num_segments) break;
}
/* update input buffer index */
inbi = inbi ^ 1;
} /* end of for each child */
} /* end of for each segment */
/* clean up */
if( inbuf_free[0] != NULL) free(inbuf_free[0]);
if( inbuf_free[1] != NULL) free(inbuf_free[1]);
if( accumbuf_free != NULL ) free(accumbuf_free);
}
/* leaf nodes
Depending on the value of max_outstanding_reqs and
the number of segments we have two options:
- send all segments using blocking send to the parent, or
- avoid overflooding the parent nodes by limiting the number of
outstanding requests to max_oustanding_reqs.
TODO/POSSIBLE IMPROVEMENT: If there is a way to determine the eager size
for the current communication, synchronization should be used only
when the message/segment size is smaller than the eager size.
*/
else {
/* If the number of segments is less than a maximum number of oustanding
requests or there is no limit on the maximum number of outstanding
requests, we send data to the parent using blocking send */
if ((0 == max_outstanding_reqs) ||
(num_segments <= max_outstanding_reqs)) {
segindex = 0;
while ( original_count > 0) {
if (original_count < count_by_segment) {
count_by_segment = original_count;
}
ret = MCA_PML_CALL( send((char*)sendbuf +
(ptrdiff_t)segindex * (ptrdiff_t)segment_increment,
count_by_segment, datatype,
tree->tree_prev,
MCA_COLL_BASE_TAG_REDUCE,
MCA_PML_BASE_SEND_STANDARD,
comm) );
if (ret != MPI_SUCCESS) { line = __LINE__; goto error_hndl; }
segindex++;
original_count -= count_by_segment;
}
}
/* Otherwise, introduce flow control:
- post max_outstanding_reqs non-blocking synchronous send,
- for remaining segments
- wait for a ssend to complete, and post the next one.
- wait for all outstanding sends to complete.
*/
else {
int creq = 0;
sreq = ompi_coll_base_comm_get_reqs(module->base_data, max_outstanding_reqs);
if (NULL == sreq) { line = __LINE__; ret = -1; goto error_hndl; }
/* post first group of requests */
for (segindex = 0; segindex < max_outstanding_reqs; segindex++) {
ret = MCA_PML_CALL( isend((char*)sendbuf +
(ptrdiff_t)segindex * (ptrdiff_t)segment_increment,
count_by_segment, datatype,
tree->tree_prev,
MCA_COLL_BASE_TAG_REDUCE,
MCA_PML_BASE_SEND_SYNCHRONOUS, comm,
&sreq[segindex]) );
if (ret != MPI_SUCCESS) { line = __LINE__; goto error_hndl; }
original_count -= count_by_segment;
}
creq = 0;
while ( original_count > 0 ) {
/* wait on a posted request to complete */
ret = ompi_request_wait(&sreq[creq], MPI_STATUS_IGNORE);
if (ret != MPI_SUCCESS) { line = __LINE__; goto error_hndl; }
if( original_count < count_by_segment ) {
count_by_segment = original_count;
}
ret = MCA_PML_CALL( isend((char*)sendbuf +
(ptrdiff_t)segindex * (ptrdiff_t)segment_increment,
count_by_segment, datatype,
tree->tree_prev,
MCA_COLL_BASE_TAG_REDUCE,
MCA_PML_BASE_SEND_SYNCHRONOUS, comm,
&sreq[creq]) );
if (ret != MPI_SUCCESS) { line = __LINE__; goto error_hndl; }
creq = (creq + 1) % max_outstanding_reqs;
segindex++;
original_count -= count_by_segment;
}
/* Wait on the remaining request to complete */
ret = ompi_request_wait_all( max_outstanding_reqs, sreq,
MPI_STATUSES_IGNORE );
if (ret != MPI_SUCCESS) { line = __LINE__; goto error_hndl; }
}
}
return OMPI_SUCCESS;
error_hndl: /* error handler */
OPAL_OUTPUT (( ompi_coll_base_framework.framework_output,
"ERROR_HNDL: node %d file %s line %d error %d\n",
rank, __FILE__, line, ret ));
(void)line; // silence compiler warning
if( inbuf_free[0] != NULL ) free(inbuf_free[0]);
if( inbuf_free[1] != NULL ) free(inbuf_free[1]);
if( accumbuf_free != NULL ) free(accumbuf);
if( NULL != sreq ) {
ompi_coll_base_free_reqs(sreq, max_outstanding_reqs);
}
return ret;
}
static int
mca_coll_tuned_alltoallv_intra_basic_inplace(void *rbuf, const int *rcounts, const int *rdisps,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm,
mca_coll_base_module_t *module)
{
mca_coll_tuned_module_t *tuned_module = (mca_coll_tuned_module_t*) module;
int i, j, size, rank, err;
MPI_Request *preq;
char *tmp_buffer;
size_t max_size;
ptrdiff_t ext;
/* Initialize. */
size = ompi_comm_size(comm);
rank = ompi_comm_rank(comm);
/* If only one process, we're done. */
if (1 == size) {
return MPI_SUCCESS;
}
/* Find the largest receive amount */
ompi_datatype_type_extent (rdtype, &ext);
for (i = 0, max_size = 0 ; i < size ; ++i) {
size_t size = ext * rcounts[rank];
max_size = size > max_size ? size : max_size;
}
/* Allocate a temporary buffer */
tmp_buffer = calloc (max_size, 1);
if (NULL == tmp_buffer) {
return OMPI_ERR_OUT_OF_RESOURCE;
}
/* in-place alltoallv slow algorithm (but works) */
for (i = 0 ; i < size ; ++i) {
for (j = i+1 ; j < size ; ++j) {
/* Initiate all send/recv to/from others. */
preq = tuned_module->tuned_data->mcct_reqs;
if (i == rank && rcounts[j]) {
/* Copy the data into the temporary buffer */
err = ompi_datatype_copy_content_same_ddt (rdtype, rcounts[j],
tmp_buffer, (char *) rbuf + rdisps[j]);
if (MPI_SUCCESS != err) { goto error_hndl; }
/* Exchange data with the peer */
err = MCA_PML_CALL(irecv ((char *) rbuf + rdisps[j], rcounts[j], rdtype,
j, MCA_COLL_BASE_TAG_ALLTOALLV, comm, preq++));
if (MPI_SUCCESS != err) { goto error_hndl; }
err = MCA_PML_CALL(isend ((void *) tmp_buffer, rcounts[j], rdtype,
j, MCA_COLL_BASE_TAG_ALLTOALLV, MCA_PML_BASE_SEND_STANDARD,
comm, preq++));
if (MPI_SUCCESS != err) { goto error_hndl; }
} else if (j == rank && rcounts[i]) {
/* Copy the data into the temporary buffer */
err = ompi_datatype_copy_content_same_ddt (rdtype, rcounts[i],
tmp_buffer, (char *) rbuf + rdisps[i]);
if (MPI_SUCCESS != err) { goto error_hndl; }
/* Exchange data with the peer */
err = MCA_PML_CALL(irecv ((char *) rbuf + rdisps[i], rcounts[i], rdtype,
i, MCA_COLL_BASE_TAG_ALLTOALLV, comm, preq++));
if (MPI_SUCCESS != err) { goto error_hndl; }
err = MCA_PML_CALL(isend ((void *) tmp_buffer, rcounts[i], rdtype,
i, MCA_COLL_BASE_TAG_ALLTOALLV, MCA_PML_BASE_SEND_STANDARD,
comm, preq++));
if (MPI_SUCCESS != err) { goto error_hndl; }
} else {
continue;
}
/* Wait for the requests to complete */
err = ompi_request_wait_all (2, tuned_module->tuned_data->mcct_reqs, MPI_STATUS_IGNORE);
if (MPI_SUCCESS != err) { goto error_hndl; }
/* Free the requests. */
mca_coll_tuned_free_reqs(tuned_module->tuned_data->mcct_reqs, 2);
}
}
error_hndl:
/* Free the temporary buffer */
free (tmp_buffer);
/* All done */
return err;
}
int32_t ompi_datatype_create_darray(int size,
int rank,
int ndims,
int const* gsize_array,
int const* distrib_array,
int const* darg_array,
int const* psize_array,
int order,
const ompi_datatype_t* oldtype,
ompi_datatype_t** newtype)
{
ompi_datatype_t *lastType;
ptrdiff_t orig_extent, *st_offsets = NULL;
int i, start_loop, end_loop, step;
int *coords = NULL, rc = OMPI_SUCCESS;
/* speedy corner case */
if (ndims < 1) {
/* Don't just return MPI_DATATYPE_NULL as that can't be
MPI_TYPE_FREE()ed, and that seems bad */
*newtype = ompi_datatype_create(0);
ompi_datatype_add(*newtype, &ompi_mpi_datatype_null.dt, 0, 0, 0);
return MPI_SUCCESS;
}
rc = ompi_datatype_type_extent(oldtype, &orig_extent);
if (MPI_SUCCESS != rc) goto cleanup;
/* calculate position in grid using row-major ordering */
{
int tmp_rank = rank, procs = size;
coords = (int *) malloc(ndims * sizeof(int));
for (i = 0 ; i < ndims ; i++) {
procs = procs / psize_array[i];
coords[i] = tmp_rank / procs;
tmp_rank = tmp_rank % procs;
}
}
st_offsets = (ptrdiff_t *) malloc(ndims * sizeof(ptrdiff_t));
/* duplicate type to here to 1) deal with constness without
casting and 2) eliminate need to for conditional destroy below.
Lame, yes. But cleaner code all around. */
rc = ompi_datatype_duplicate(oldtype, &lastType);
if (OMPI_SUCCESS != rc) goto cleanup;
/* figure out ordering issues */
if (MPI_ORDER_C == order) {
start_loop = ndims - 1 ; step = -1; end_loop = -1;
} else {
start_loop = 0 ; step = 1; end_loop = ndims;
}
/* Build up array */
for (i = start_loop; i != end_loop; i += step) {
int nprocs, tmp_rank;
switch(distrib_array[i]) {
case MPI_DISTRIBUTE_BLOCK:
rc = block(gsize_array, i, ndims, psize_array[i], coords[i],
darg_array[i], order, orig_extent,
lastType, newtype, st_offsets+i);
break;
case MPI_DISTRIBUTE_CYCLIC:
rc = cyclic(gsize_array, i, ndims, psize_array[i], coords[i],
darg_array[i], order, orig_extent,
lastType, newtype, st_offsets+i);
break;
case MPI_DISTRIBUTE_NONE:
/* treat it as a block distribution on 1 process */
if (order == MPI_ORDER_C) {
nprocs = psize_array[i]; tmp_rank = coords[i];
} else {
nprocs = 1; tmp_rank = 0;
}
rc = block(gsize_array, i, ndims, nprocs, tmp_rank,
MPI_DISTRIBUTE_DFLT_DARG, order, orig_extent,
lastType, newtype, st_offsets+i);
break;
default:
rc = MPI_ERR_ARG;
}
ompi_datatype_destroy(&lastType);
/* need to destroy the old type even in error condition, so
don't check return code from above until after cleanup. */
if (MPI_SUCCESS != rc) goto cleanup;
lastType = *newtype;
}
/* set displacement and UB correctly. Use struct instead of
resized for same reason as subarray */
{
ptrdiff_t displs[3], tmp_size;
ompi_datatype_t *types[3];
int blength[3] = { 1, 1, 1};
displs[1] = st_offsets[start_loop];
tmp_size = 1;
for (i = start_loop + step ; i != end_loop ; i += step) {
tmp_size *= gsize_array[i - step];
displs[1] += tmp_size * st_offsets[i];
}
displs[0] = 0;
displs[1] *= orig_extent;
displs[2] = orig_extent;
for (i = 0 ; i < ndims ; i++) {
displs[2] *= gsize_array[i];
}
types[0] = MPI_LB; types[1] = lastType; types[2] = MPI_UB;
rc = ompi_datatype_create_struct(3, blength, displs, types, newtype);
ompi_datatype_destroy(&lastType);
/* need to destroy the old type even in error condition, so
don't check return code from above until after cleanup. */
if (MPI_SUCCESS != rc) goto cleanup;
}
cleanup:
if (NULL != st_offsets) free(st_offsets);
if (NULL != coords) free(coords);
return OMPI_SUCCESS;
}
/*
* reduce_lin_intra
*
* Function: - reduction using O(N) algorithm
* Accepts: - same as MPI_Reduce()
* Returns: - MPI_SUCCESS or error code
*/
int
ompi_coll_base_reduce_intra_basic_linear(const void *sbuf, void *rbuf, int count,
struct ompi_datatype_t *dtype,
struct ompi_op_t *op,
int root,
struct ompi_communicator_t *comm,
mca_coll_base_module_t *module)
{
int i, rank, err, size;
ptrdiff_t extent, dsize, gap = 0;
char *free_buffer = NULL;
char *pml_buffer = NULL;
char *inplace_temp_free = NULL;
char *inbuf;
/* Initialize */
rank = ompi_comm_rank(comm);
size = ompi_comm_size(comm);
/* If not root, send data to the root. */
if (rank != root) {
err = MCA_PML_CALL(send(sbuf, count, dtype, root,
MCA_COLL_BASE_TAG_REDUCE,
MCA_PML_BASE_SEND_STANDARD, comm));
return err;
}
dsize = opal_datatype_span(&dtype->super, count, &gap);
ompi_datatype_type_extent(dtype, &extent);
if (MPI_IN_PLACE == sbuf) {
sbuf = rbuf;
inplace_temp_free = (char*)malloc(dsize);
if (NULL == inplace_temp_free) {
return OMPI_ERR_OUT_OF_RESOURCE;
}
rbuf = inplace_temp_free - gap;
}
if (size > 1) {
free_buffer = (char*)malloc(dsize);
if (NULL == free_buffer) {
if (NULL != inplace_temp_free) {
free(inplace_temp_free);
}
return OMPI_ERR_OUT_OF_RESOURCE;
}
pml_buffer = free_buffer - gap;
}
/* Initialize the receive buffer. */
if (rank == (size - 1)) {
err = ompi_datatype_copy_content_same_ddt(dtype, count, (char*)rbuf, (char*)sbuf);
} else {
err = MCA_PML_CALL(recv(rbuf, count, dtype, size - 1,
MCA_COLL_BASE_TAG_REDUCE, comm,
MPI_STATUS_IGNORE));
}
if (MPI_SUCCESS != err) {
if (NULL != free_buffer) {
free(free_buffer);
}
return err;
}
/* Loop receiving and calling reduction function (C or Fortran). */
for (i = size - 2; i >= 0; --i) {
if (rank == i) {
inbuf = (char*)sbuf;
} else {
err = MCA_PML_CALL(recv(pml_buffer, count, dtype, i,
MCA_COLL_BASE_TAG_REDUCE, comm,
MPI_STATUS_IGNORE));
if (MPI_SUCCESS != err) {
if (NULL != free_buffer) {
free(free_buffer);
}
return err;
}
inbuf = pml_buffer;
}
/* Perform the reduction */
ompi_op_reduce(op, inbuf, rbuf, count, dtype);
}
if (NULL != inplace_temp_free) {
err = ompi_datatype_copy_content_same_ddt(dtype, count, (char*)sbuf, rbuf);
free(inplace_temp_free);
}
if (NULL != free_buffer) {
free(free_buffer);
}
/* All done */
return MPI_SUCCESS;
}
