int MPIR_Scan_intra_smp(const void *sendbuf, void *recvbuf, int count,
MPI_Datatype datatype, MPI_Op op, MPIR_Comm * comm_ptr,
MPIR_Errflag_t * errflag)
{
int mpi_errno = MPI_SUCCESS;
int mpi_errno_ret = MPI_SUCCESS;
MPIR_CHKLMEM_DECL(3);
int rank = comm_ptr->rank;
MPI_Status status;
void *tempbuf = NULL, *localfulldata = NULL, *prefulldata = NULL;
MPI_Aint true_lb, true_extent, extent;
int noneed = 1; /* noneed=1 means no need to bcast tempbuf and
* reduce tempbuf & recvbuf */
MPIR_Type_get_true_extent_impl(datatype, &true_lb, &true_extent);
MPIR_Datatype_get_extent_macro(datatype, extent);
MPIR_Ensure_Aint_fits_in_pointer(count * MPL_MAX(extent, true_extent));
MPIR_CHKLMEM_MALLOC(tempbuf, void *, count * (MPL_MAX(extent, true_extent)),
mpi_errno, "temporary buffer", MPL_MEM_BUFFER);
tempbuf = (void *) ((char *) tempbuf - true_lb);
/* Create prefulldata and localfulldata on local roots of all nodes */
if (comm_ptr->node_roots_comm != NULL) {
MPIR_CHKLMEM_MALLOC(prefulldata, void *, count * (MPL_MAX(extent, true_extent)),
mpi_errno, "prefulldata for scan", MPL_MEM_BUFFER);
prefulldata = (void *) ((char *) prefulldata - true_lb);
if (comm_ptr->node_comm != NULL) {
MPIR_CHKLMEM_MALLOC(localfulldata, void *, count * (MPL_MAX(extent, true_extent)),
mpi_errno, "localfulldata for scan", MPL_MEM_BUFFER);
localfulldata = (void *) ((char *) localfulldata - true_lb);
}
int MPIR_Reduce_intra_reduce_scatter_gather (
const void *sendbuf,
void *recvbuf,
int count,
MPI_Datatype datatype,
MPI_Op op,
int root,
MPIR_Comm *comm_ptr,
MPIR_Errflag_t *errflag )
{
int mpi_errno = MPI_SUCCESS;
int mpi_errno_ret = MPI_SUCCESS;
int comm_size, rank, type_size ATTRIBUTE((unused)), pof2, rem, newrank;
int mask, *cnts, *disps, i, j, send_idx=0;
int recv_idx, last_idx=0, newdst;
int dst, send_cnt, recv_cnt, newroot, newdst_tree_root, newroot_tree_root;
MPI_Aint true_lb, true_extent, extent;
void *tmp_buf;
MPIR_CHKLMEM_DECL(4);
comm_size = comm_ptr->local_size;
rank = comm_ptr->rank;
/* set op_errno to 0. stored in perthread structure */
{
MPIR_Per_thread_t *per_thread = NULL;
int err = 0;
MPID_THREADPRIV_KEY_GET_ADDR(MPIR_ThreadInfo.isThreaded, MPIR_Per_thread_key,
MPIR_Per_thread, per_thread, &err);
MPIR_Assert(err == 0);
per_thread->op_errno = 0;
}
/* Create a temporary buffer */
MPIR_Type_get_true_extent_impl(datatype, &true_lb, &true_extent);
MPIR_Datatype_get_extent_macro(datatype, extent);
/* I think this is the worse case, so we can avoid an assert()
* inside the for loop */
/* should be buf+{this}? */
MPIR_Ensure_Aint_fits_in_pointer(count * MPL_MAX(extent, true_extent));
MPIR_CHKLMEM_MALLOC(tmp_buf, void *, count*(MPL_MAX(extent,true_extent)),
mpi_errno, "temporary buffer", MPL_MEM_BUFFER);
/* adjust for potential negative lower bound in datatype */
tmp_buf = (void *)((char*)tmp_buf - true_lb);
/* If I'm not the root, then my recvbuf may not be valid, therefore
I have to allocate a temporary one */
if (rank != root) {
MPIR_CHKLMEM_MALLOC(recvbuf, void *,
count*(MPL_MAX(extent,true_extent)),
mpi_errno, "receive buffer", MPL_MEM_BUFFER);
recvbuf = (void *)((char*)recvbuf - true_lb);
}
int MPIR_Ireduce_sched_intra_binomial(const void *sendbuf, void *recvbuf, int count,
MPI_Datatype datatype, MPI_Op op, int root,
MPIR_Comm * comm_ptr, MPIR_Sched_t s)
{
int mpi_errno = MPI_SUCCESS;
int comm_size, rank, is_commutative;
int mask, relrank, source, lroot;
MPI_Aint true_lb, true_extent, extent;
void *tmp_buf;
MPIR_SCHED_CHKPMEM_DECL(2);
MPIR_Assert(comm_ptr->comm_kind == MPIR_COMM_KIND__INTRACOMM);
if (count == 0)
return MPI_SUCCESS;
comm_size = comm_ptr->local_size;
rank = comm_ptr->rank;
/* set op_errno to 0. stored in perthread structure */
{
MPIR_Per_thread_t *per_thread = NULL;
int err = 0;
MPID_THREADPRIV_KEY_GET_ADDR(MPIR_ThreadInfo.isThreaded, MPIR_Per_thread_key,
MPIR_Per_thread, per_thread, &err);
MPIR_Assert(err == 0);
per_thread->op_errno = 0;
}
/* Create a temporary buffer */
MPIR_Type_get_true_extent_impl(datatype, &true_lb, &true_extent);
MPIR_Datatype_get_extent_macro(datatype, extent);
is_commutative = MPIR_Op_is_commutative(op);
/* I think this is the worse case, so we can avoid an assert()
* inside the for loop */
/* should be buf+{this}? */
MPIR_Ensure_Aint_fits_in_pointer(count * MPL_MAX(extent, true_extent));
MPIR_SCHED_CHKPMEM_MALLOC(tmp_buf, void *, count * (MPL_MAX(extent, true_extent)),
mpi_errno, "temporary buffer", MPL_MEM_BUFFER);
/* adjust for potential negative lower bound in datatype */
tmp_buf = (void *) ((char *) tmp_buf - true_lb);
/* If I'm not the root, then my recvbuf may not be valid, therefore
* I have to allocate a temporary one */
if (rank != root) {
MPIR_SCHED_CHKPMEM_MALLOC(recvbuf, void *,
count * (MPL_MAX(extent, true_extent)),
mpi_errno, "receive buffer", MPL_MEM_BUFFER);
recvbuf = (void *) ((char *) recvbuf - true_lb);
}
int MPIR_Iscan_SMP(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPIR_Comm *comm_ptr, MPIR_Sched_t s)
{
int mpi_errno = MPI_SUCCESS;
int rank = comm_ptr->rank;
MPIR_Comm *node_comm;
MPIR_Comm *roots_comm;
MPI_Aint true_extent, true_lb, extent;
void *tempbuf = NULL;
void *prefulldata = NULL;
void *localfulldata = NULL;
MPIR_SCHED_CHKPMEM_DECL(3);
/* In order to use the SMP-aware algorithm, the "op" can be
either commutative or non-commutative, but we require a
communicator in which all the nodes contain processes with
consecutive ranks. */
if (!MPII_Comm_is_node_consecutive(comm_ptr)) {
/* We can't use the SMP-aware algorithm, use the generic one */
return MPIR_Iscan_rec_dbl(sendbuf, recvbuf, count, datatype, op, comm_ptr, s);
}
node_comm = comm_ptr->node_comm;
roots_comm = comm_ptr->node_roots_comm;
if (node_comm) {
MPIR_Assert(node_comm->coll_fns && node_comm->coll_fns->Iscan_sched && node_comm->coll_fns->Ibcast_sched);
}
if (roots_comm) {
MPIR_Assert(roots_comm->coll_fns && roots_comm->coll_fns->Iscan_sched);
}
MPIR_Type_get_true_extent_impl(datatype, &true_lb, &true_extent);
MPID_Datatype_get_extent_macro(datatype, extent);
MPIR_Ensure_Aint_fits_in_pointer(count * MPL_MAX(extent, true_extent));
MPIR_SCHED_CHKPMEM_MALLOC(tempbuf, void *, count*(MPL_MAX(extent, true_extent)),
mpi_errno, "temporary buffer");
tempbuf = (void *)((char*)tempbuf - true_lb);
/* Create prefulldata and localfulldata on local roots of all nodes */
if (comm_ptr->node_roots_comm != NULL) {
MPIR_SCHED_CHKPMEM_MALLOC(prefulldata, void *, count*(MPL_MAX(extent, true_extent)),
mpi_errno, "prefulldata for scan");
prefulldata = (void *)((char*)prefulldata - true_lb);
if (node_comm != NULL) {
MPIR_SCHED_CHKPMEM_MALLOC(localfulldata, void *, count*(MPL_MAX(extent, true_extent)),
mpi_errno, "localfulldata for scan");
localfulldata = (void *)((char*)localfulldata - true_lb);
}
int MPIR_Scan(
const void *sendbuf,
void *recvbuf,
int count,
MPI_Datatype datatype,
MPI_Op op,
MPID_Comm *comm_ptr,
MPIR_Errflag_t *errflag )
{
int mpi_errno = MPI_SUCCESS;
int mpi_errno_ret = MPI_SUCCESS;
MPIU_CHKLMEM_DECL(3);
int rank = comm_ptr->rank;
MPI_Status status;
void *tempbuf = NULL, *localfulldata = NULL, *prefulldata = NULL;
MPI_Aint true_lb, true_extent, extent;
int noneed = 1; /* noneed=1 means no need to bcast tempbuf and
reduce tempbuf & recvbuf */
/* In order to use the SMP-aware algorithm, the "op" can be
either commutative or non-commutative, but we require a
communicator in which all the nodes contain processes with
consecutive ranks. */
if (!MPIR_Comm_is_node_consecutive(comm_ptr)) {
/* We can't use the SMP-aware algorithm, use the generic one */
return MPIR_Scan_generic(sendbuf, recvbuf, count, datatype, op, comm_ptr, errflag);
}
MPIR_Type_get_true_extent_impl(datatype, &true_lb, &true_extent);
MPID_Datatype_get_extent_macro(datatype, extent);
MPIU_Ensure_Aint_fits_in_pointer(count * MPL_MAX(extent, true_extent));
MPIU_CHKLMEM_MALLOC(tempbuf, void *, count*(MPL_MAX(extent, true_extent)),
mpi_errno, "temporary buffer");
tempbuf = (void *)((char*)tempbuf - true_lb);
/* Create prefulldata and localfulldata on local roots of all nodes */
if (comm_ptr->node_roots_comm != NULL) {
MPIU_CHKLMEM_MALLOC(prefulldata, void *, count*(MPL_MAX(extent, true_extent)),
mpi_errno, "prefulldata for scan");
prefulldata = (void *)((char*)prefulldata - true_lb);
if (comm_ptr->node_comm != NULL) {
MPIU_CHKLMEM_MALLOC(localfulldata, void *, count*(MPL_MAX(extent, true_extent)),
mpi_errno, "localfulldata for scan");
localfulldata = (void *)((char*)localfulldata - true_lb);
}
int MPIR_Iallgather_sched_inter_local_gather_remote_bcast(const void *sendbuf, int sendcount,
MPI_Datatype sendtype, void *recvbuf,
int recvcount, MPI_Datatype recvtype,
MPIR_Comm * comm_ptr, MPIR_Sched_t s)
{
int mpi_errno = MPI_SUCCESS;
int rank, local_size, remote_size, root;
MPI_Aint true_extent, true_lb = 0, extent, send_extent;
void *tmp_buf = NULL;
MPIR_Comm *newcomm_ptr = NULL;
MPIR_SCHED_CHKPMEM_DECL(1);
local_size = comm_ptr->local_size;
remote_size = comm_ptr->remote_size;
rank = comm_ptr->rank;
if ((rank == 0) && (sendcount != 0)) {
/* In each group, rank 0 allocates temp. buffer for local
* gather */
MPIR_Type_get_true_extent_impl(sendtype, &true_lb, &true_extent);
MPIR_Datatype_get_extent_macro(sendtype, send_extent);
extent = MPL_MAX(send_extent, true_extent);
MPIR_Ensure_Aint_fits_in_pointer(extent * sendcount * local_size);
MPIR_SCHED_CHKPMEM_MALLOC(tmp_buf, void *, extent * sendcount * local_size, mpi_errno,
"tmp_buf", MPL_MEM_BUFFER);
/* adjust for potential negative lower bound in datatype */
tmp_buf = (void *) ((char *) tmp_buf - true_lb);
}
void ADIOI_Calc_file_realms_fsize (ADIO_File fd, int nprocs_for_coll,
ADIO_Offset max_end_offset,
ADIO_Offset *file_realm_st_offs,
MPI_Datatype *file_realm_types)
{
int fr_size, aligned_fr_size, error_code, i;
int fsize;
ADIO_Offset aligned_fr_off;
ADIO_Fcntl_t fcntl_struct;
MPI_Datatype simpletype;
ADIO_Fcntl (fd, ADIO_FCNTL_GET_FSIZE, &fcntl_struct, &error_code);
/* use impending file size since a write call may lengthen the file */
fsize = MPL_MAX (fcntl_struct.fsize, max_end_offset+1);
fr_size = (fsize + nprocs_for_coll - 1) / nprocs_for_coll;
align_fr(fr_size, 0, fd->hints->cb_fr_alignment,
&aligned_fr_size, &aligned_fr_off);
ADIOI_Create_fr_simpletype (fr_size, nprocs_for_coll, &simpletype);
for (i=0; i < nprocs_for_coll; i++)
{
file_realm_st_offs[i] = fr_size * i;
file_realm_types[i] = simpletype;
}
}
int MPIR_Reduce_scatter_block_inter_remote_reduce_local_scatter(const void *sendbuf,
void *recvbuf,
int recvcount,
MPI_Datatype datatype,
MPI_Op op,
MPIR_Comm * comm_ptr,
MPIR_Errflag_t * errflag)
{
int rank, mpi_errno, root, local_size, total_count;
int mpi_errno_ret = MPI_SUCCESS;
MPI_Aint true_extent, true_lb = 0, extent;
void *tmp_buf = NULL;
MPIR_Comm *newcomm_ptr = NULL;
MPIR_CHKLMEM_DECL(1);
rank = comm_ptr->rank;
local_size = comm_ptr->local_size;
total_count = local_size * recvcount;
if (rank == 0) {
/* In each group, rank 0 allocates a temp. buffer for the
* reduce */
MPIR_Type_get_true_extent_impl(datatype, &true_lb, &true_extent);
MPIR_Datatype_get_extent_macro(datatype, extent);
MPIR_CHKLMEM_MALLOC(tmp_buf, void *, total_count * (MPL_MAX(extent, true_extent)),
mpi_errno, "tmp_buf", MPL_MEM_BUFFER);
/* adjust for potential negative lower bound in datatype */
tmp_buf = (void *) ((char *) tmp_buf - true_lb);
}
/* This function implements a binomial tree reduce.
Cost = lgp.alpha + n.lgp.beta + n.lgp.gamma
*/
int MPIR_Reduce_intra_binomial(const void *sendbuf,
void *recvbuf,
int count,
MPI_Datatype datatype,
MPI_Op op, int root, MPIR_Comm * comm_ptr, MPIR_Errflag_t * errflag)
{
int mpi_errno = MPI_SUCCESS;
int mpi_errno_ret = MPI_SUCCESS;
MPI_Status status;
int comm_size, rank, is_commutative, type_size ATTRIBUTE((unused));
int mask, relrank, source, lroot;
MPI_Aint true_lb, true_extent, extent;
void *tmp_buf;
MPIR_CHKLMEM_DECL(2);
if (count == 0)
return MPI_SUCCESS;
comm_size = comm_ptr->local_size;
rank = comm_ptr->rank;
/* Create a temporary buffer */
MPIR_Type_get_true_extent_impl(datatype, &true_lb, &true_extent);
MPIR_Datatype_get_extent_macro(datatype, extent);
is_commutative = MPIR_Op_is_commutative(op);
MPIR_CHKLMEM_MALLOC(tmp_buf, void *, count * (MPL_MAX(extent, true_extent)),
mpi_errno, "temporary buffer", MPL_MEM_BUFFER);
/* adjust for potential negative lower bound in datatype */
tmp_buf = (void *) ((char *) tmp_buf - true_lb);
/* If I'm not the root, then my recvbuf may not be valid, therefore
* I have to allocate a temporary one */
if (rank != root) {
MPIR_CHKLMEM_MALLOC(recvbuf, void *,
count * (MPL_MAX(extent, true_extent)),
mpi_errno, "receive buffer", MPL_MEM_BUFFER);
recvbuf = (void *) ((char *) recvbuf - true_lb);
}
int MPIR_Allreduce_intra_reduce_scatter_allgather(
const void *sendbuf,
void *recvbuf,
int count,
MPI_Datatype datatype,
MPI_Op op,
MPIR_Comm * comm_ptr,
MPIR_Errflag_t * errflag)
{
MPIR_CHKLMEM_DECL(3);
#ifdef MPID_HAS_HETERO
int is_homogeneous;
int rc;
#endif
int comm_size, rank;
int mpi_errno = MPI_SUCCESS;
int mpi_errno_ret = MPI_SUCCESS;
int mask, dst, pof2, newrank, rem, newdst, i,
send_idx, recv_idx, last_idx, send_cnt, recv_cnt, *cnts, *disps;
MPI_Aint true_extent, true_lb, extent;
void *tmp_buf;
comm_size = comm_ptr->local_size;
rank = comm_ptr->rank;
/* need to allocate temporary buffer to store incoming data*/
MPIR_Type_get_true_extent_impl(datatype, &true_lb, &true_extent);
MPIR_Datatype_get_extent_macro(datatype, extent);
MPIR_Ensure_Aint_fits_in_pointer(count * MPL_MAX(extent, true_extent));
MPIR_CHKLMEM_MALLOC(tmp_buf, void *, count*(MPL_MAX(extent,true_extent)), mpi_errno, "temporary buffer", MPL_MEM_BUFFER);
/* adjust for potential negative lower bound in datatype */
tmp_buf = (void *)((char*)tmp_buf - true_lb);
/* copy local data into recvbuf */
if (sendbuf != MPI_IN_PLACE) {
mpi_errno = MPIR_Localcopy(sendbuf, count, datatype, recvbuf,
count, datatype);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
}
/* get nearest power-of-two less than or equal to comm_size */
pof2 = comm_ptr->pof2;
rem = comm_size - pof2;
/* In the non-power-of-two case, all even-numbered
processes of rank < 2*rem send their data to
(rank+1). These even-numbered processes no longer
participate in the algorithm until the very end. The
remaining processes form a nice power-of-two. */
if (rank < 2*rem) {
if (rank % 2 == 0) { /* even */
mpi_errno = MPIC_Send(recvbuf, count,
datatype, rank+1,
MPIR_ALLREDUCE_TAG, comm_ptr, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag = MPIR_ERR_GET_CLASS(mpi_errno);
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
/* temporarily set the rank to -1 so that this
process does not pariticipate in recursive
doubling */
newrank = -1;
}
else { /* odd */
mpi_errno = MPIC_Recv(tmp_buf, count,
datatype, rank-1,
MPIR_ALLREDUCE_TAG, comm_ptr,
MPI_STATUS_IGNORE, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag = MPIR_ERR_GET_CLASS(mpi_errno);
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
/* do the reduction on received data. since the
ordering is right, it doesn't matter whether
the operation is commutative or not. */
mpi_errno = MPIR_Reduce_local(tmp_buf, recvbuf, count, datatype, op);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
/* change the rank */
newrank = rank / 2;
}
}
else /* rank >= 2*rem */
newrank = rank - rem;
/* If op is user-defined or count is less than pof2, use
recursive doubling algorithm. Otherwise do a reduce-scatter
followed by allgather. (If op is user-defined,
derived datatypes are allowed and the user could pass basic
datatypes on one process and derived on another as long as
the type maps are the same. Breaking up derived
datatypes to do the reduce-scatter is tricky, therefore
using recursive doubling in that case.) */
#ifdef HAVE_ERROR_CHECKING
MPIR_Assert(HANDLE_GET_KIND(op)==HANDLE_KIND_BUILTIN);
MPIR_Assert(count >= pof2);
#endif /* HAVE_ERROR_CHECKING */
if (newrank != -1) {
MPIR_CHKLMEM_MALLOC(cnts, int *, pof2*sizeof(int), mpi_errno, "counts", MPL_MEM_BUFFER);
MPIR_CHKLMEM_MALLOC(disps, int *, pof2*sizeof(int), mpi_errno, "displacements", MPL_MEM_BUFFER);
for (i=0; i<pof2; i++)
cnts[i] = count/pof2;
if ((count % pof2) > 0) {
for (i=0; i<(count % pof2); i++)
cnts[i] += 1;
}
disps[0] = 0;
for (i=1; i<pof2; i++)
disps[i] = disps[i-1] + cnts[i-1];
mask = 0x1;
send_idx = recv_idx = 0;
last_idx = pof2;
while (mask < pof2) {
newdst = newrank ^ mask;
/* find real rank of dest */
dst = (newdst < rem) ? newdst*2 + 1 : newdst + rem;
send_cnt = recv_cnt = 0;
if (newrank < newdst) {
send_idx = recv_idx + pof2/(mask*2);
for (i=send_idx; i<last_idx; i++)
send_cnt += cnts[i];
for (i=recv_idx; i<send_idx; i++)
recv_cnt += cnts[i];
}
else {
recv_idx = send_idx + pof2/(mask*2);
for (i=send_idx; i<recv_idx; i++)
send_cnt += cnts[i];
for (i=recv_idx; i<last_idx; i++)
recv_cnt += cnts[i];
}
/* Send data from recvbuf. Recv into tmp_buf */
mpi_errno = MPIC_Sendrecv((char *) recvbuf +
disps[send_idx]*extent,
send_cnt, datatype,
dst, MPIR_ALLREDUCE_TAG,
(char *) tmp_buf +
disps[recv_idx]*extent,
recv_cnt, datatype, dst,
MPIR_ALLREDUCE_TAG, comm_ptr,
MPI_STATUS_IGNORE, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag = MPIR_ERR_GET_CLASS(mpi_errno);
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
/* tmp_buf contains data received in this step.
recvbuf contains data accumulated so far */
/* This algorithm is used only for predefined ops
and predefined ops are always commutative. */
mpi_errno = MPIR_Reduce_local(((char *) tmp_buf + disps[recv_idx]*extent),
((char *) recvbuf + disps[recv_idx]*extent),
recv_cnt, datatype, op);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
/* update send_idx for next iteration */
send_idx = recv_idx;
mask <<= 1;
/* update last_idx, but not in last iteration
because the value is needed in the allgather
step below. */
if (mask < pof2)
last_idx = recv_idx + pof2/mask;
}
/* now do the allgather */
mask >>= 1;
while (mask > 0) {
newdst = newrank ^ mask;
/* find real rank of dest */
dst = (newdst < rem) ? newdst*2 + 1 : newdst + rem;
send_cnt = recv_cnt = 0;
if (newrank < newdst) {
/* update last_idx except on first iteration */
if (mask != pof2/2)
last_idx = last_idx + pof2/(mask*2);
recv_idx = send_idx + pof2/(mask*2);
for (i=send_idx; i<recv_idx; i++)
send_cnt += cnts[i];
for (i=recv_idx; i<last_idx; i++)
recv_cnt += cnts[i];
}
else {
recv_idx = send_idx - pof2/(mask*2);
for (i=send_idx; i<last_idx; i++)
send_cnt += cnts[i];
for (i=recv_idx; i<send_idx; i++)
recv_cnt += cnts[i];
}
mpi_errno = MPIC_Sendrecv((char *) recvbuf +
disps[send_idx]*extent,
send_cnt, datatype,
dst, MPIR_ALLREDUCE_TAG,
(char *) recvbuf +
disps[recv_idx]*extent,
recv_cnt, datatype, dst,
MPIR_ALLREDUCE_TAG, comm_ptr,
MPI_STATUS_IGNORE, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag = MPIR_ERR_GET_CLASS(mpi_errno);
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
if (newrank > newdst) send_idx = recv_idx;
mask >>= 1;
}
}
int MPIR_Allgather_intra_brucks (
const void *sendbuf,
int sendcount,
MPI_Datatype sendtype,
void *recvbuf,
int recvcount,
MPI_Datatype recvtype,
MPIR_Comm *comm_ptr,
MPIR_Errflag_t *errflag )
{
int comm_size, rank;
int mpi_errno = MPI_SUCCESS;
int mpi_errno_ret = MPI_SUCCESS;
MPI_Aint recvtype_extent;
MPI_Aint recvtype_true_extent, recvbuf_extent, recvtype_true_lb;
int pof2, src, rem;
void *tmp_buf = NULL;
int curr_cnt, dst;
MPIR_CHKLMEM_DECL(1);
if (((sendcount == 0) && (sendbuf != MPI_IN_PLACE)) || (recvcount == 0))
return MPI_SUCCESS;
comm_size = comm_ptr->local_size;
rank = comm_ptr->rank;
MPIR_Datatype_get_extent_macro( recvtype, recvtype_extent );
/* This is the largest offset we add to recvbuf */
MPIR_Ensure_Aint_fits_in_pointer(MPIR_VOID_PTR_CAST_TO_MPI_AINT recvbuf +
(comm_size * recvcount * recvtype_extent));
/* allocate a temporary buffer of the same size as recvbuf. */
/* get true extent of recvtype */
MPIR_Type_get_true_extent_impl(recvtype, &recvtype_true_lb, &recvtype_true_extent);
recvbuf_extent = recvcount * comm_size * (MPL_MAX(recvtype_true_extent, recvtype_extent));
MPIR_CHKLMEM_MALLOC(tmp_buf, void*, recvbuf_extent, mpi_errno, "tmp_buf", MPL_MEM_BUFFER);
/* adjust for potential negative lower bound in datatype */
tmp_buf = (void *)((char*)tmp_buf - recvtype_true_lb);
/* copy local data to the top of tmp_buf */
if (sendbuf != MPI_IN_PLACE) {
mpi_errno = MPIR_Localcopy (sendbuf, sendcount, sendtype,
tmp_buf, recvcount, recvtype);
if (mpi_errno) {
MPIR_ERR_POP(mpi_errno);
}
}
else {
mpi_errno = MPIR_Localcopy (((char *)recvbuf +
rank * recvcount * recvtype_extent),
recvcount, recvtype, tmp_buf,
recvcount, recvtype);
if (mpi_errno) {
MPIR_ERR_POP(mpi_errno);
}
}
/* do the first \floor(\lg p) steps */
curr_cnt = recvcount;
pof2 = 1;
while (pof2 <= comm_size/2) {
src = (rank + pof2) % comm_size;
dst = (rank - pof2 + comm_size) % comm_size;
mpi_errno = MPIC_Sendrecv(tmp_buf, curr_cnt, recvtype, dst,
MPIR_ALLGATHER_TAG,
((char *)tmp_buf + curr_cnt*recvtype_extent),
curr_cnt, recvtype,
src, MPIR_ALLGATHER_TAG, comm_ptr,
MPI_STATUS_IGNORE, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag = MPIR_ERR_GET_CLASS(mpi_errno);
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
curr_cnt *= 2;
pof2 *= 2;
}
/* if comm_size is not a power of two, one more step is needed */
rem = comm_size - pof2;
if (rem) {
src = (rank + pof2) % comm_size;
dst = (rank - pof2 + comm_size) % comm_size;
mpi_errno = MPIC_Sendrecv(tmp_buf, rem * recvcount, recvtype,
dst, MPIR_ALLGATHER_TAG,
((char *)tmp_buf + curr_cnt*recvtype_extent),
rem * recvcount, recvtype,
src, MPIR_ALLGATHER_TAG, comm_ptr,
MPI_STATUS_IGNORE, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag = MPIR_ERR_GET_CLASS(mpi_errno);
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
}
/* Rotate blocks in tmp_buf down by (rank) blocks and store
* result in recvbuf. */
mpi_errno = MPIR_Localcopy(tmp_buf, (comm_size-rank)*recvcount,
recvtype, (char *) recvbuf + rank*recvcount*recvtype_extent,
(comm_size-rank)*recvcount, recvtype);
if (mpi_errno) {
MPIR_ERR_POP(mpi_errno);
}
if (rank) {
mpi_errno = MPIR_Localcopy((char *) tmp_buf +
(comm_size-rank)*recvcount*recvtype_extent,
rank*recvcount, recvtype, recvbuf,
rank*recvcount, recvtype);
if (mpi_errno) {
MPIR_ERR_POP(mpi_errno);
}
}
fn_exit:
MPIR_CHKLMEM_FREEALL();
if (mpi_errno_ret)
mpi_errno = mpi_errno_ret;
else if (*errflag != MPIR_ERR_NONE)
MPIR_ERR_SET(mpi_errno, *errflag, "**coll_fail");
return mpi_errno;
fn_fail:
goto fn_exit;
}
/* If successful, error_code is set to MPI_SUCCESS. Otherwise an error
* code is created and returned in error_code.
*/
static void ADIOI_LUSTRE_Exch_and_write(ADIO_File fd, const void *buf,
MPI_Datatype datatype, int nprocs,
int myrank, ADIOI_Access *others_req,
ADIOI_Access *my_req,
ADIO_Offset *offset_list,
ADIO_Offset *len_list,
int contig_access_count,
int *striping_info, int **buf_idx,
int *error_code)
{
/* Send data to appropriate processes and write in sizes of no more
* than lustre stripe_size.
* The idea is to reduce the amount of extra memory required for
* collective I/O. If all data were written all at once, which is much
* easier, it would require temp space more than the size of user_buf,
* which is often unacceptable. For example, to write a distributed
* array to a file, where each local array is 8Mbytes, requiring
* at least another 8Mbytes of temp space is unacceptable.
*/
int hole, i, j, m, flag, ntimes = 1 , max_ntimes, buftype_is_contig;
ADIO_Offset st_loc = -1, end_loc = -1, min_st_loc, max_end_loc;
ADIO_Offset off, req_off, send_off, iter_st_off, *off_list;
ADIO_Offset max_size, step_size = 0;
int real_size, req_len, send_len;
int *recv_curr_offlen_ptr, *recv_count, *recv_size;
int *send_curr_offlen_ptr, *send_size;
int *sent_to_proc, *recv_start_pos;
int *send_buf_idx, *curr_to_proc, *done_to_proc;
int *this_buf_idx;
char *write_buf = NULL;
MPI_Status status;
ADIOI_Flatlist_node *flat_buf = NULL;
MPI_Aint buftype_extent;
int stripe_size = striping_info[0], avail_cb_nodes = striping_info[2];
int data_sieving = 0;
ADIO_Offset *srt_off = NULL;
int *srt_len = NULL;
int srt_num = 0;
ADIO_Offset block_offset;
int block_len;
*error_code = MPI_SUCCESS; /* changed below if error */
/* only I/O errors are currently reported */
/* calculate the number of writes of stripe size to be done.
* That gives the no. of communication phases as well.
* Note:
* Because we redistribute data in stripe-contiguous pattern for Lustre,
* each process has the same no. of communication phases.
*/
for (i = 0; i < nprocs; i++) {
if (others_req[i].count) {
st_loc = others_req[i].offsets[0];
end_loc = others_req[i].offsets[0];
break;
}
}
for (i = 0; i < nprocs; i++) {
for (j = 0; j < others_req[i].count; j++) {
st_loc = MPL_MIN(st_loc, others_req[i].offsets[j]);
end_loc = MPL_MAX(end_loc, (others_req[i].offsets[j] +
others_req[i].lens[j] - 1));
}
}
/* this process does no writing. */
if ((st_loc == -1) && (end_loc == -1))
ntimes = 0;
MPI_Allreduce(&end_loc, &max_end_loc, 1, MPI_LONG_LONG_INT, MPI_MAX, fd->comm);
/* avoid min_st_loc be -1 */
if (st_loc == -1)
st_loc = max_end_loc;
MPI_Allreduce(&st_loc, &min_st_loc, 1, MPI_LONG_LONG_INT, MPI_MIN, fd->comm);
/* align downward */
min_st_loc -= min_st_loc % (ADIO_Offset)stripe_size;
/* Each time, only avail_cb_nodes number of IO clients perform IO,
* so, step_size=avail_cb_nodes*stripe_size IO will be performed at most,
* and ntimes=whole_file_portion/step_size
*/
step_size = (ADIO_Offset) avail_cb_nodes * stripe_size;
max_ntimes = (max_end_loc - min_st_loc + 1) / step_size
+ (((max_end_loc - min_st_loc + 1) % step_size) ? 1 : 0);
/* max_ntimes = (int)((max_end_loc - min_st_loc) / step_size + 1); */
if (ntimes)
write_buf = (char *) ADIOI_Malloc(stripe_size);
/* calculate the start offset for each iteration */
off_list = (ADIO_Offset *) ADIOI_Malloc(max_ntimes * sizeof(ADIO_Offset));
for (m = 0; m < max_ntimes; m ++)
off_list[m] = max_end_loc;
for (i = 0; i < nprocs; i++) {
for (j = 0; j < others_req[i].count; j ++) {
req_off = others_req[i].offsets[j];
m = (int)((req_off - min_st_loc) / step_size);
off_list[m] = MPL_MIN(off_list[m], req_off);
}
}
recv_curr_offlen_ptr = (int *) ADIOI_Calloc(nprocs, sizeof(int));
send_curr_offlen_ptr = (int *) ADIOI_Calloc(nprocs, sizeof(int));
/* their use is explained below. calloc initializes to 0. */
recv_count = (int *) ADIOI_Malloc(nprocs * sizeof(int));
/* to store count of how many off-len pairs per proc are satisfied
in an iteration. */
send_size = (int *) ADIOI_Malloc(nprocs * sizeof(int));
/* total size of data to be sent to each proc. in an iteration.
Of size nprocs so that I can use MPI_Alltoall later. */
recv_size = (int *) ADIOI_Malloc(nprocs * sizeof(int));
/* total size of data to be recd. from each proc. in an iteration. */
sent_to_proc = (int *) ADIOI_Calloc(nprocs, sizeof(int));
/* amount of data sent to each proc so far. Used in
ADIOI_Fill_send_buffer. initialized to 0 here. */
send_buf_idx = (int *) ADIOI_Malloc(nprocs * sizeof(int));
curr_to_proc = (int *) ADIOI_Malloc(nprocs * sizeof(int));
done_to_proc = (int *) ADIOI_Malloc(nprocs * sizeof(int));
/* Above three are used in ADIOI_Fill_send_buffer */
this_buf_idx = (int *) ADIOI_Malloc(nprocs * sizeof(int));
recv_start_pos = (int *) ADIOI_Malloc(nprocs * sizeof(int));
/* used to store the starting value of recv_curr_offlen_ptr[i] in
this iteration */
ADIOI_Datatype_iscontig(datatype, &buftype_is_contig);
if (!buftype_is_contig) {
flat_buf = ADIOI_Flatten_and_find(datatype);
}
MPI_Type_extent(datatype, &buftype_extent);
/* I need to check if there are any outstanding nonblocking writes to
* the file, which could potentially interfere with the writes taking
* place in this collective write call. Since this is not likely to be
* common, let me do the simplest thing possible here: Each process
* completes all pending nonblocking operations before completing.
*/
/*ADIOI_Complete_async(error_code);
if (*error_code != MPI_SUCCESS) return;
MPI_Barrier(fd->comm);
*/
iter_st_off = min_st_loc;
/* Although we have recognized the data according to OST index,
* a read-modify-write will be done if there is a hole between the data.
* For example: if blocksize=60, xfersize=30 and stripe_size=100,
* then rank0 will collect data [0, 30] and [60, 90] then write. There
* is a hole in [30, 60], which will cause a read-modify-write in [0, 90].
*
* To reduce its impact on the performance, we can disable data sieving
* by hint "ds_in_coll".
*/
/* check the hint for data sieving */
data_sieving = fd->hints->fs_hints.lustre.ds_in_coll;
for (m = 0; m < max_ntimes; m++) {
/* go through all others_req and my_req to check which will be received
* and sent in this iteration.
*/
/* Note that MPI guarantees that displacements in filetypes are in
monotonically nondecreasing order and that, for writes, the
filetypes cannot specify overlapping regions in the file. This
simplifies implementation a bit compared to reads. */
/*
off = start offset in the file for the data to be written in
this iteration
iter_st_off = start offset of this iteration
real_size = size of data written (bytes) corresponding to off
max_size = possible maximum size of data written in this iteration
req_off = offset in the file for a particular contiguous request minus
what was satisfied in previous iteration
send_off = offset the request needed by other processes in this iteration
req_len = size corresponding to req_off
send_len = size corresponding to send_off
*/
/* first calculate what should be communicated */
for (i = 0; i < nprocs; i++)
recv_count[i] = recv_size[i] = send_size[i] = 0;
off = off_list[m];
max_size = MPL_MIN(step_size, max_end_loc - iter_st_off + 1);
real_size = (int) MPL_MIN((off / stripe_size + 1) * stripe_size -
off,
end_loc - off + 1);
for (i = 0; i < nprocs; i++) {
if (my_req[i].count) {
this_buf_idx[i] = buf_idx[i][send_curr_offlen_ptr[i]];
for (j = send_curr_offlen_ptr[i]; j < my_req[i].count; j++) {
send_off = my_req[i].offsets[j];
send_len = my_req[i].lens[j];
if (send_off < iter_st_off + max_size) {
send_size[i] += send_len;
} else {
break;
}
}
send_curr_offlen_ptr[i] = j;
}
if (others_req[i].count) {
recv_start_pos[i] = recv_curr_offlen_ptr[i];
for (j = recv_curr_offlen_ptr[i]; j < others_req[i].count; j++) {
req_off = others_req[i].offsets[j];
req_len = others_req[i].lens[j];
if (req_off < iter_st_off + max_size) {
recv_count[i]++;
ADIOI_Assert((((ADIO_Offset)(MPIU_Upint)write_buf)+req_off-off) == (ADIO_Offset)(MPIU_Upint)(write_buf+req_off-off));
MPI_Address(write_buf + req_off - off,
&(others_req[i].mem_ptrs[j]));
recv_size[i] += req_len;
} else {
break;
}
}
recv_curr_offlen_ptr[i] = j;
}
}
/* use variable "hole" to pass data_sieving flag into W_Exchange_data */
hole = data_sieving;
ADIOI_LUSTRE_W_Exchange_data(fd, buf, write_buf, flat_buf, offset_list,
len_list, send_size, recv_size, off, real_size,
recv_count, recv_start_pos,
sent_to_proc, nprocs, myrank,
buftype_is_contig, contig_access_count,
striping_info, others_req, send_buf_idx,
curr_to_proc, done_to_proc, &hole, m,
buftype_extent, this_buf_idx,
&srt_off, &srt_len, &srt_num, error_code);
if (*error_code != MPI_SUCCESS)
goto over;
flag = 0;
for (i = 0; i < nprocs; i++)
if (recv_count[i]) {
flag = 1;
break;
}
if (flag) {
/* check whether to do data sieving */
if(data_sieving == ADIOI_HINT_ENABLE) {
ADIO_WriteContig(fd, write_buf, real_size, MPI_BYTE,
ADIO_EXPLICIT_OFFSET, off, &status,
error_code);
} else {
/* if there is no hole, write data in one time;
* otherwise, write data in several times */
if (!hole) {
ADIO_WriteContig(fd, write_buf, real_size, MPI_BYTE,
ADIO_EXPLICIT_OFFSET, off, &status,
error_code);
} else {
block_offset = -1;
block_len = 0;
for (i = 0; i < srt_num; ++i) {
if (srt_off[i] < off + real_size &&
srt_off[i] >= off) {
if (block_offset == -1) {
block_offset = srt_off[i];
block_len = srt_len[i];
} else {
if (srt_off[i] == block_offset + block_len) {
block_len += srt_len[i];
} else {
ADIO_WriteContig(fd,
write_buf + block_offset - off,
block_len,
MPI_BYTE, ADIO_EXPLICIT_OFFSET,
block_offset, &status,
error_code);
if (*error_code != MPI_SUCCESS)
goto over;
block_offset = srt_off[i];
block_len = srt_len[i];
}
}
}
}
if (block_offset != -1) {
ADIO_WriteContig(fd,
write_buf + block_offset - off,
block_len,
MPI_BYTE, ADIO_EXPLICIT_OFFSET,
block_offset, &status,
error_code);
if (*error_code != MPI_SUCCESS)
goto over;
}
}
}
if (*error_code != MPI_SUCCESS)
goto over;
}
iter_st_off += max_size;
}
over:
if (srt_off)
ADIOI_Free(srt_off);
if (srt_len)
ADIOI_Free(srt_len);
if (ntimes)
ADIOI_Free(write_buf);
ADIOI_Free(recv_curr_offlen_ptr);
ADIOI_Free(send_curr_offlen_ptr);
ADIOI_Free(recv_count);
ADIOI_Free(send_size);
ADIOI_Free(recv_size);
ADIOI_Free(sent_to_proc);
ADIOI_Free(recv_start_pos);
ADIOI_Free(send_buf_idx);
ADIOI_Free(curr_to_proc);
ADIOI_Free(done_to_proc);
ADIOI_Free(this_buf_idx);
ADIOI_Free(off_list);
}
/* ADIOI_Exchange_file_views - Sends all the aggregators the file
* views and file view states of the clients. It fills in the
* client_file_view_state_arr for the aggregators and the
* my_mem_view_state for the client. It also initializes the
* agg_file_view_state for all clients, which is the view for each
* aggregator of a client's filetype. */
void ADIOI_Exch_file_views(int myrank, int nprocs, int file_ptr_type,
ADIO_File fd, int count,
MPI_Datatype datatype, ADIO_Offset off,
view_state * my_mem_view_state_arr,
view_state * agg_file_view_state_arr,
view_state * client_file_view_state_arr)
{
/* Convert my own fileview to an ADIOI_Flattened type and a
* disp. MPI_Alltoall the count of ADIOI_Flatlist nodes.
* MPI_Isend/Irecv the block_lens, indices of ADIOI_Flatlist node
* to/from each of the aggregators with the rest of the file view
* state. */
int i = -1, j = -1;
amount_and_extra_data_t *send_count_arr = NULL;
amount_and_extra_data_t *recv_count_arr = NULL;
int send_req_arr_sz = 0;
int recv_req_arr_sz = 0;
MPI_Request *send_req_arr = NULL, *recv_req_arr = NULL;
MPI_Status *statuses = NULL;
ADIO_Offset disp_off_sz_ext_typesz[6];
MPI_Aint memtype_extent, filetype_extent;
int ret = -1;
/* parameters for datatypes */
ADIOI_Flatlist_node *flat_mem_p = NULL, *flat_file_p = NULL;
MPI_Count memtype_sz = -1;
int memtype_is_contig = -1;
ADIO_Offset filetype_sz = -1;
#ifdef AGGREGATION_PROFILE
MPE_Log_event(5014, 0, NULL);
#endif
/* The memtype will be freed after the call. The filetype will be
* freed in the close and should have been flattened in the file
* view. */
MPI_Type_size_x(datatype, &memtype_sz);
MPI_Type_extent(datatype, &memtype_extent);
if (memtype_sz == memtype_extent) {
memtype_is_contig = 1;
flat_mem_p = ADIOI_Flatten_and_find(datatype);
flat_mem_p->blocklens[0] = memtype_sz * count;
} else {
flat_mem_p = ADIOI_Flatten_and_find(datatype);
}
MPI_Type_extent(fd->filetype, &filetype_extent);
MPI_Type_size_x(fd->filetype, &filetype_sz);
flat_file_p = ADIOI_Flatten_and_find(fd->filetype);
if (filetype_extent == filetype_sz) {
flat_file_p->blocklens[0] = memtype_sz * count;
filetype_extent = memtype_sz * count;
filetype_sz = filetype_extent;
}
disp_off_sz_ext_typesz[0] = fd->fp_ind;
disp_off_sz_ext_typesz[1] = fd->disp;
disp_off_sz_ext_typesz[2] = off;
disp_off_sz_ext_typesz[3] = memtype_sz * count;
disp_off_sz_ext_typesz[4] = (ADIO_Offset) filetype_extent;
disp_off_sz_ext_typesz[5] = (ADIO_Offset) filetype_sz;
if (fd->hints->cb_alltoall != ADIOI_HINT_DISABLE) {
recv_count_arr = ADIOI_Calloc(nprocs, sizeof(amount_and_extra_data_t));
send_count_arr = ADIOI_Calloc(nprocs, sizeof(amount_and_extra_data_t));
} else {
send_count_arr = ADIOI_Calloc(fd->hints->cb_nodes, sizeof(amount_and_extra_data_t));
/* only aggregators receive data */
if (fd->is_agg) {
recv_count_arr = ADIOI_Calloc(nprocs, sizeof(amount_and_extra_data_t));
recv_req_arr = ADIOI_Malloc(nprocs * sizeof(MPI_Request));
for (i = 0; i < nprocs; i++)
MPI_Irecv(&recv_count_arr[i], sizeof(amount_and_extra_data_t),
MPI_BYTE, i, COUNT_EXCH, fd->comm, &recv_req_arr[i]);
}
/* only send data to aggregators */
send_req_arr = ADIOI_Calloc(fd->hints->cb_nodes, sizeof(MPI_Request));
for (i = 0; i < fd->hints->cb_nodes; i++) {
send_count_arr[i].count = flat_file_p->count;
send_count_arr[i].fp_ind = disp_off_sz_ext_typesz[0];
send_count_arr[i].disp = disp_off_sz_ext_typesz[1];
send_count_arr[i].byte_off = disp_off_sz_ext_typesz[2];
send_count_arr[i].sz = disp_off_sz_ext_typesz[3];
send_count_arr[i].ext = disp_off_sz_ext_typesz[4];
send_count_arr[i].type_sz = disp_off_sz_ext_typesz[5];
MPI_Isend(&send_count_arr[i], sizeof(amount_and_extra_data_t),
MPI_BYTE, fd->hints->ranklist[i], COUNT_EXCH, fd->comm, &send_req_arr[i]);
}
}
/* Every client has to build mem and file view_states for each aggregator.
* We initialize their values here. and we also initialize
* send_count_arr */
if (memtype_is_contig) {
/* if memory is contigous, we now replace memtype_sz and
* memtype_extent with the full access size */
memtype_sz *= count;
memtype_extent = memtype_sz;
}
for (i = 0; i < fd->hints->cb_nodes; i++) {
int tmp_agg_idx = fd->hints->ranklist[i];
memset(&(my_mem_view_state_arr[tmp_agg_idx]), 0, sizeof(view_state));
my_mem_view_state_arr[tmp_agg_idx].sz = disp_off_sz_ext_typesz[3];
my_mem_view_state_arr[tmp_agg_idx].ext = (ADIO_Offset) memtype_extent;
my_mem_view_state_arr[tmp_agg_idx].type_sz = (ADIO_Offset) memtype_sz;
my_mem_view_state_arr[tmp_agg_idx].flat_type_p = flat_mem_p;
ADIOI_init_view_state(file_ptr_type, 1, &(my_mem_view_state_arr[tmp_agg_idx]), TEMP_OFF);
ADIOI_init_view_state(file_ptr_type, 1, &(my_mem_view_state_arr[tmp_agg_idx]), REAL_OFF);
memset(&(agg_file_view_state_arr[tmp_agg_idx]), 0, sizeof(view_state));
agg_file_view_state_arr[tmp_agg_idx].fp_ind = disp_off_sz_ext_typesz[0];
agg_file_view_state_arr[tmp_agg_idx].disp = disp_off_sz_ext_typesz[1];
agg_file_view_state_arr[tmp_agg_idx].byte_off = disp_off_sz_ext_typesz[2];
agg_file_view_state_arr[tmp_agg_idx].sz = disp_off_sz_ext_typesz[3];
agg_file_view_state_arr[tmp_agg_idx].ext = disp_off_sz_ext_typesz[4];
agg_file_view_state_arr[tmp_agg_idx].type_sz = disp_off_sz_ext_typesz[5];
agg_file_view_state_arr[tmp_agg_idx].flat_type_p = flat_file_p;
ADIOI_init_view_state(file_ptr_type, 1, &(agg_file_view_state_arr[tmp_agg_idx]), TEMP_OFF);
ADIOI_init_view_state(file_ptr_type, 1, &(agg_file_view_state_arr[tmp_agg_idx]), REAL_OFF);
if (fd->hints->cb_alltoall != ADIOI_HINT_DISABLE) {
send_count_arr[tmp_agg_idx].count = flat_file_p->count;
send_count_arr[tmp_agg_idx].fp_ind = disp_off_sz_ext_typesz[0];
send_count_arr[tmp_agg_idx].disp = disp_off_sz_ext_typesz[1];
send_count_arr[tmp_agg_idx].byte_off = disp_off_sz_ext_typesz[2];
send_count_arr[tmp_agg_idx].sz = disp_off_sz_ext_typesz[3];
send_count_arr[tmp_agg_idx].ext = disp_off_sz_ext_typesz[4];
send_count_arr[tmp_agg_idx].type_sz = disp_off_sz_ext_typesz[5];
}
}
#ifdef DEBUG2
fprintf(stderr, "my own flattened memtype: ");
ADIOI_Print_flatlist_node(flat_mem_p);
fprintf(stderr, "my own flattened filetype: ");
ADIOI_Print_flatlist_node(flat_file_p);
#endif
if (fd->hints->cb_alltoall != ADIOI_HINT_DISABLE) {
ret = MPI_Alltoall(send_count_arr, sizeof(amount_and_extra_data_t),
MPI_BYTE,
recv_count_arr, sizeof(amount_and_extra_data_t), MPI_BYTE, fd->comm);
if (ret != MPI_SUCCESS) {
fprintf(stderr, "ADIOI_Exchange_file_views: MPI_Alltoall failed " "with error %d", ret);
return;
}
} else {
#ifdef MPI_STATUSES_IGNORE
statuses = MPI_STATUSES_IGNORE;
#else
statuses = (MPI_Status *) ADIOI_Malloc(1 + nprocs * sizeof(MPI_Status));
#endif
if (fd->is_agg) {
MPI_Waitall(nprocs, recv_req_arr, statuses);
ADIOI_Free(recv_req_arr);
}
MPI_Waitall(fd->hints->cb_nodes, send_req_arr, statuses);
#ifndef MPI_STATUSES_IGNORE
ADIOI_Free(statuses);
#endif
ADIOI_Free(send_req_arr);
}
#ifdef DEBUG2
if (fd->hints->cb_alltoall != ADIOI_HINT_DISABLE) {
fprintf(stderr, "send_count_arr:");
for (i = 0; i < nprocs; i++) {
fprintf(stderr, "[%d]=%d ", i, send_count_arr[i].count);
}
fprintf(stderr, "\n");
fprintf(stderr, "recv_count_arr:");
for (i = 0; i < nprocs; i++) {
fprintf(stderr, "[%d]=%d ", i, recv_count_arr[i].count);
}
fprintf(stderr, "\n");
} else {
fprintf(stderr, "send_count_arr:");
for (i = 0; i < fd->hints->cb_nodes; i++) {
fprintf(stderr, "[%d]=%d ", i, send_count_arr[i].count);
}
fprintf(stderr, "\n");
if (fd->is_agg) {
fprintf(stderr, "recv_count_arr:");
for (i = 0; i < nprocs; i++) {
fprintf(stderr, "[%d]=%d ", i, recv_count_arr[i].count);
}
fprintf(stderr, "\n");
}
}
#endif
if (fd->hints->cb_alltoall == ADIOI_HINT_DISABLE) {
for (i = 0; i < fd->hints->cb_nodes; i++)
if (send_count_arr[i].count > 0)
send_req_arr_sz++;
}
/* Figure out how many counts to send/recv */
for (i = 0; i < nprocs; i++) {
if (fd->hints->cb_alltoall != ADIOI_HINT_DISABLE) {
if (send_count_arr[i].count > 0)
send_req_arr_sz++;
}
/* Only aggregators should recv */
if (fd->is_agg) {
if (recv_count_arr[i].count > 0) {
if ((client_file_view_state_arr[i].flat_type_p =
(ADIOI_Flatlist_node *) ADIOI_Malloc(sizeof(ADIOI_Flatlist_node))) == NULL) {
fprintf(stderr, "ADIOI_Exchange_file_views: malloc " "flat_type_p failed\n");
}
client_file_view_state_arr[i].flat_type_p->count = recv_count_arr[i].count;
client_file_view_state_arr[i].flat_type_p->indices =
(ADIO_Offset *) ADIOI_Calloc(recv_count_arr[i].count, sizeof(ADIO_Offset));
client_file_view_state_arr[i].flat_type_p->blocklens =
(ADIO_Offset *) ADIOI_Calloc(recv_count_arr[i].count, sizeof(ADIO_Offset));
/* Copy the extra data out of the stuff we Alltoall'd */
memcpy(&client_file_view_state_arr[i].fp_ind,
&recv_count_arr[i].fp_ind, 6 * sizeof(ADIO_Offset));
recv_req_arr_sz++;
}
}
}
/* Since ADIOI_Calloc may do other things we add the +1
* to avoid a 0-size malloc */
send_req_arr = (MPI_Request *) ADIOI_Calloc(2 * (send_req_arr_sz) + 1, sizeof(MPI_Request));
j = 0;
if (recv_req_arr_sz > 0) {
assert(fd->is_agg);
recv_req_arr = (MPI_Request *) ADIOI_Calloc(2 * (recv_req_arr_sz), sizeof(MPI_Request));
for (i = 0; i < nprocs; i++) {
if (recv_count_arr[i].count > 0) {
MPI_Irecv(client_file_view_state_arr[i].flat_type_p->indices,
recv_count_arr[i].count, ADIO_OFFSET, i,
INDICES, fd->comm, &recv_req_arr[j]);
j++;
MPI_Irecv(client_file_view_state_arr[i].flat_type_p->blocklens,
recv_count_arr[i].count, ADIO_OFFSET, i,
BLOCK_LENS, fd->comm, &recv_req_arr[j]);
j++;
}
}
}
if (fd->hints->cb_alltoall != ADIOI_HINT_DISABLE) {
j = 0;
for (i = 0; i < nprocs; i++) {
if (send_count_arr[i].count > 0) {
MPI_Isend(flat_file_p->indices,
send_count_arr[i].count, ADIO_OFFSET, i,
INDICES, fd->comm, &send_req_arr[j]);
j++;
MPI_Isend(flat_file_p->blocklens,
send_count_arr[i].count, ADIO_OFFSET, i,
BLOCK_LENS, fd->comm, &send_req_arr[j]);
j++;
}
}
} else {
j = 0;
for (i = 0; i < fd->hints->cb_nodes; i++) {
if (send_count_arr[i].count > 0) {
MPI_Isend(flat_file_p->indices,
send_count_arr[i].count, ADIO_OFFSET,
fd->hints->ranklist[i], INDICES, fd->comm, &send_req_arr[j]);
j++;
MPI_Isend(flat_file_p->blocklens,
send_count_arr[i].count, ADIO_OFFSET,
fd->hints->ranklist[i], BLOCK_LENS, fd->comm, &send_req_arr[j]);
j++;
}
}
}
/* Since ADIOI_Malloc may do other things we add the +1
* to avoid a 0-size malloc */
#ifdef MPI_STATUSES_IGNORE
statuses = MPI_STATUSES_IGNORE;
#else
statuses = (MPI_Status *)
ADIOI_Malloc(1 + 2 * MPL_MAX(send_req_arr_sz, recv_req_arr_sz)
* sizeof(MPI_Status));
#endif
if (send_req_arr_sz > 0) {
MPI_Waitall(2 * send_req_arr_sz, send_req_arr, statuses);
ADIOI_Free(send_count_arr);
ADIOI_Free(send_req_arr);
}
if (recv_req_arr_sz > 0) {
MPI_Waitall(2 * recv_req_arr_sz, recv_req_arr, statuses);
ADIOI_Free(recv_count_arr);
ADIOI_Free(recv_req_arr);
}
#ifndef MPI_STATUSES_IGNORE
ADIOI_Free(statuses);
#endif
if (fd->is_agg == 1) {
ADIOI_init_view_state(file_ptr_type, nprocs, client_file_view_state_arr, TEMP_OFF);
ADIOI_init_view_state(file_ptr_type, nprocs, client_file_view_state_arr, REAL_OFF);
}
#ifdef DEBUG
if (fd->is_agg == 1) {
ADIOI_Flatlist_node *fr_node_p;
for (i = 0; i < nprocs; i++) {
fprintf(stderr, "client_file_view_state_arr[%d]=(fp_ind=%Ld,"
"disp=%Ld,byte_off=%Ld,sz=%Ld,ext=%Ld\n", i,
client_file_view_state_arr[i].fp_ind,
client_file_view_state_arr[i].disp,
client_file_view_state_arr[i].byte_off,
client_file_view_state_arr[i].sz, client_file_view_state_arr[i].ext);
}
fr_node_p = ADIOI_Flatten_and_find(fd->file_realm_types[fd->my - cb_nodes_index]);
assert(fr_node_p != NULL);
fprintf(stderr, "my file realm (idx=%d,st_off=%Ld) ",
fd->my_cb_nodes_index, fd->file_realm_st_offs[fd->my_cb_nodes_index]);
ADIOI_Print_flatlist_node(fr_node_p);
}
#endif
#ifdef DEBUG2
if (fd->is_agg == 1) {
for (i = 0; i < nprocs; i++) {
fprintf(stderr, "client_file_view_state_arr[%d]: ", i);
ADIOI_Print_flatlist_node(client_file_view_state_arr[i].flat_type_p);
}
}
#endif
#ifdef AGGREGATION_PROFILE
MPE_Log_event(5015, 0, NULL);
#endif
}
int MPIR_Alltoallv_inter(const void *sendbuf, const int *sendcounts, const int *sdispls,
MPI_Datatype sendtype, void *recvbuf, const int *recvcounts,
const int *rdispls, MPI_Datatype recvtype, MPID_Comm *comm_ptr,
MPIR_Errflag_t *errflag)
{
/* Intercommunicator alltoallv. We use a pairwise exchange algorithm
similar to the one used in intracommunicator alltoallv. Since the
local and remote groups can be of different
sizes, we first compute the max of local_group_size,
remote_group_size. At step i, 0 <= i < max_size, each process
receives from src = (rank - i + max_size) % max_size if src <
remote_size, and sends to dst = (rank + i) % max_size if dst <
remote_size.
FIXME: change algorithm to match intracommunicator alltoallv
*/
int local_size, remote_size, max_size, i;
MPI_Aint send_extent, recv_extent;
int mpi_errno = MPI_SUCCESS;
int mpi_errno_ret = MPI_SUCCESS;
MPI_Status status;
int src, dst, rank, sendcount, recvcount;
char *sendaddr, *recvaddr;
local_size = comm_ptr->local_size;
remote_size = comm_ptr->remote_size;
rank = comm_ptr->rank;
/* Get extent of send and recv types */
MPID_Datatype_get_extent_macro(sendtype, send_extent);
MPID_Datatype_get_extent_macro(recvtype, recv_extent);
/* check if multiple threads are calling this collective function */
MPIDU_ERR_CHECK_MULTIPLE_THREADS_ENTER( comm_ptr );
/* Use pairwise exchange algorithm. */
max_size = MPL_MAX(local_size, remote_size);
for (i=0; i<max_size; i++) {
src = (rank - i + max_size) % max_size;
dst = (rank + i) % max_size;
if (src >= remote_size) {
src = MPI_PROC_NULL;
recvaddr = NULL;
recvcount = 0;
}
else {
MPIU_Ensure_Aint_fits_in_pointer(MPIU_VOID_PTR_CAST_TO_MPI_AINT recvbuf +
rdispls[src]*recv_extent);
recvaddr = (char *)recvbuf + rdispls[src]*recv_extent;
recvcount = recvcounts[src];
}
if (dst >= remote_size) {
dst = MPI_PROC_NULL;
sendaddr = NULL;
sendcount = 0;
}
else {
MPIU_Ensure_Aint_fits_in_pointer(MPIU_VOID_PTR_CAST_TO_MPI_AINT sendbuf +
sdispls[dst]*send_extent);
sendaddr = (char *)sendbuf + sdispls[dst]*send_extent;
sendcount = sendcounts[dst];
}
mpi_errno = MPIC_Sendrecv(sendaddr, sendcount, sendtype, dst,
MPIR_ALLTOALLV_TAG, recvaddr, recvcount,
recvtype, src, MPIR_ALLTOALLV_TAG,
comm_ptr, &status, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag = MPIR_ERR_GET_CLASS(mpi_errno);
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
}
fn_exit:
/* check if multiple threads are calling this collective function */
MPIDU_ERR_CHECK_MULTIPLE_THREADS_EXIT( comm_ptr );
if (mpi_errno_ret)
mpi_errno = mpi_errno_ret;
else if (*errflag != MPIR_ERR_NONE)
MPIR_ERR_SET(mpi_errno, *errflag, "**coll_fail");
return mpi_errno;
fn_fail:
goto fn_exit;
}
int MPIR_Ialltoallw_sched_inter_pairwise_exchange(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[],
MPIR_Comm * comm_ptr, MPIR_Sched_t s)
{
/* Intercommunicator alltoallw. We use a pairwise exchange algorithm
similar to the one used in intracommunicator alltoallw. Since the local and
remote groups can be of different sizes, we first compute the max of
local_group_size, remote_group_size. At step i, 0 <= i < max_size, each
process receives from src = (rank - i + max_size) % max_size if src < remote_size,
and sends to dst = (rank + i) % max_size if dst < remote_size.
FIXME: change algorithm to match intracommunicator alltoallw
*/
int mpi_errno = MPI_SUCCESS;
int local_size, remote_size, max_size, i;
int src, dst, rank, sendcount, recvcount;
char *sendaddr, *recvaddr;
MPI_Datatype sendtype, recvtype;
local_size = comm_ptr->local_size;
remote_size = comm_ptr->remote_size;
rank = comm_ptr->rank;
/* Use pairwise exchange algorithm. */
max_size = MPL_MAX(local_size, remote_size);
for (i = 0; i < max_size; i++) {
src = (rank - i + max_size) % max_size;
dst = (rank + i) % max_size;
if (src >= remote_size) {
src = MPI_PROC_NULL;
recvaddr = NULL;
recvcount = 0;
recvtype = MPI_DATATYPE_NULL;
} else {
recvaddr = (char *) recvbuf + rdispls[src];
recvcount = recvcounts[src];
recvtype = recvtypes[src];
}
if (dst >= remote_size) {
dst = MPI_PROC_NULL;
sendaddr = NULL;
sendcount = 0;
sendtype = MPI_DATATYPE_NULL;
} else {
sendaddr = (char *) sendbuf + sdispls[dst];
sendcount = sendcounts[dst];
sendtype = sendtypes[dst];
}
mpi_errno = MPIR_Sched_send(sendaddr, sendcount, sendtype, dst, comm_ptr, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* sendrecv, no barrier here */
mpi_errno = MPIR_Sched_recv(recvaddr, recvcount, recvtype, src, comm_ptr, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
}
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
}
/* Avery Ching and Kenin Columa's reworked two-phase algorithm. Key features
* - persistent file domains
* - an option to use alltoall instead of point-to-point
*/
void ADIOI_IOStridedColl(ADIO_File fd, void *buf, int count, int rdwr,
MPI_Datatype datatype, int file_ptr_type,
ADIO_Offset offset, ADIO_Status * status, int *error_code)
{
ADIO_Offset min_st_offset = 0, max_end_offset = 0;
ADIO_Offset st_end_offset[2];
ADIO_Offset *all_st_end_offsets = NULL;
int filetype_is_contig, buftype_is_contig, is_contig;
ADIO_Offset off;
int interleave_count = 0, i, nprocs, myrank, nprocs_for_coll;
int cb_enable;
ADIO_Offset bufsize;
MPI_Aint extent;
#ifdef DEBUG2
MPI_Aint bufextent;
#endif
MPI_Count size;
int agg_rank;
ADIO_Offset agg_disp; /* aggregated file offset */
MPI_Datatype agg_dtype; /* aggregated file datatype */
int aggregators_done = 0;
ADIO_Offset buffered_io_size = 0;
int *alltoallw_disps;
int *alltoallw_counts;
int *client_alltoallw_counts;
int *agg_alltoallw_counts;
char *cb_buf = NULL;
MPI_Datatype *client_comm_dtype_arr; /* aggregator perspective */
MPI_Datatype *agg_comm_dtype_arr; /* client perspective */
ADIO_Offset *client_comm_sz_arr; /* aggregator perspective */
ADIO_Offset *agg_comm_sz_arr; /* client perspective */
/* file views for each client and aggregator */
view_state *client_file_view_state_arr = NULL;
view_state *agg_file_view_state_arr = NULL;
/* mem views for local process */
view_state *my_mem_view_state_arr = NULL;
MPI_Status *agg_comm_statuses = NULL;
MPI_Request *agg_comm_requests = NULL;
MPI_Status *client_comm_statuses = NULL;
MPI_Request *client_comm_requests = NULL;
int aggs_client_count = 0;
int clients_agg_count = 0;
MPI_Comm_size(fd->comm, &nprocs);
MPI_Comm_rank(fd->comm, &myrank);
#ifdef DEBUG
fprintf(stderr, "p%d: entering ADIOI_IOStridedColl\n", myrank);
#endif
#ifdef AGGREGATION_PROFILE
if (rdwr == ADIOI_READ)
MPE_Log_event(5010, 0, NULL);
else
MPE_Log_event(5012, 0, NULL);
#endif
/* I need to check if there are any outstanding nonblocking writes
* to the file, which could potentially interfere with the writes
* taking place in this collective write call. Since this is not
* likely to be common, let me do the simplest thing possible here:
* Each process completes all pending nonblocking operations before
* completing. */
nprocs_for_coll = fd->hints->cb_nodes;
if (rdwr == ADIOI_READ)
cb_enable = fd->hints->cb_read;
else
cb_enable = fd->hints->cb_write;
/* only check for interleaving if cb_read isn't disabled */
if (cb_enable != ADIOI_HINT_DISABLE) {
/* find the starting and ending byte of my I/O access */
ADIOI_Calc_bounds(fd, count, datatype, file_ptr_type, offset,
&st_end_offset[0], &st_end_offset[1]);
/* allocate an array of start/end pairs */
all_st_end_offsets = (ADIO_Offset *)
ADIOI_Malloc(2 * nprocs * sizeof(ADIO_Offset));
MPI_Allgather(st_end_offset, 2, ADIO_OFFSET, all_st_end_offsets, 2, ADIO_OFFSET, fd->comm);
min_st_offset = all_st_end_offsets[0];
max_end_offset = all_st_end_offsets[1];
for (i = 1; i < nprocs; i++) {
/* are the accesses of different processes interleaved? */
if ((all_st_end_offsets[i * 2] < all_st_end_offsets[i * 2 - 1]) &&
(all_st_end_offsets[i * 2] <= all_st_end_offsets[i * 2 + 1]))
interleave_count++;
/* This is a rudimentary check for interleaving, but should
* suffice for the moment. */
min_st_offset = MPL_MIN(all_st_end_offsets[i * 2], min_st_offset);
max_end_offset = MPL_MAX(all_st_end_offsets[i * 2 + 1], max_end_offset);
}
}
ADIOI_Datatype_iscontig(datatype, &buftype_is_contig);
ADIOI_Datatype_iscontig(fd->filetype, &filetype_is_contig);
if ((cb_enable == ADIOI_HINT_DISABLE || (!interleave_count && (cb_enable == ADIOI_HINT_AUTO)))
&& (fd->hints->cb_pfr != ADIOI_HINT_ENABLE)) {
if (cb_enable != ADIOI_HINT_DISABLE) {
ADIOI_Free(all_st_end_offsets);
}
if (buftype_is_contig && filetype_is_contig) {
if (file_ptr_type == ADIO_EXPLICIT_OFFSET) {
off = fd->disp + (fd->etype_size) * offset;
if (rdwr == ADIOI_READ)
ADIO_ReadContig(fd, buf, count, datatype,
ADIO_EXPLICIT_OFFSET, off, status, error_code);
else
ADIO_WriteContig(fd, buf, count, datatype,
ADIO_EXPLICIT_OFFSET, off, status, error_code);
} else {
if (rdwr == ADIOI_READ)
ADIO_ReadContig(fd, buf, count, datatype, ADIO_INDIVIDUAL,
0, status, error_code);
else
ADIO_WriteContig(fd, buf, count, datatype, ADIO_INDIVIDUAL,
0, status, error_code);
}
} else {
if (rdwr == ADIOI_READ)
ADIO_ReadStrided(fd, buf, count, datatype, file_ptr_type,
offset, status, error_code);
else
ADIO_WriteStrided(fd, buf, count, datatype, file_ptr_type,
offset, status, error_code);
}
return;
}
MPI_Type_extent(datatype, &extent);
#ifdef DEBUG2
bufextent = extent * count;
#endif
MPI_Type_size_x(datatype, &size);
bufsize = size * (MPI_Count) count;
/* Calculate file realms */
if ((fd->hints->cb_pfr != ADIOI_HINT_ENABLE) || (fd->file_realm_types == NULL))
ADIOI_Calc_file_realms(fd, min_st_offset, max_end_offset);
my_mem_view_state_arr = (view_state *)
ADIOI_Calloc(1, nprocs * sizeof(view_state));
agg_file_view_state_arr = (view_state *)
ADIOI_Calloc(1, nprocs * sizeof(view_state));
client_comm_sz_arr = (ADIO_Offset *)
ADIOI_Calloc(1, nprocs * sizeof(ADIO_Offset));
if (fd->is_agg) {
client_file_view_state_arr = (view_state *)
ADIOI_Calloc(1, nprocs * sizeof(view_state));
} else {
client_file_view_state_arr = NULL;
}
/* Alltoallw doesn't like a null array even if the counts are
* zero. If you do not include this code, it will fail. */
client_comm_dtype_arr = (MPI_Datatype *)
ADIOI_Calloc(1, nprocs * sizeof(MPI_Datatype));
if (!fd->is_agg)
for (i = 0; i < nprocs; i++)
client_comm_dtype_arr[i] = MPI_BYTE;
ADIOI_Exch_file_views(myrank, nprocs, file_ptr_type, fd, count,
datatype, offset, my_mem_view_state_arr,
agg_file_view_state_arr, client_file_view_state_arr);
agg_comm_sz_arr = (ADIO_Offset *)
ADIOI_Calloc(1, nprocs * sizeof(ADIO_Offset));
agg_comm_dtype_arr = (MPI_Datatype *)
ADIOI_Malloc(nprocs * sizeof(MPI_Datatype));
if (fd->is_agg) {
ADIOI_Build_agg_reqs(fd, rdwr, nprocs,
client_file_view_state_arr,
client_comm_dtype_arr, client_comm_sz_arr, &agg_disp, &agg_dtype);
buffered_io_size = 0;
for (i = 0; i < nprocs; i++) {
if (client_comm_sz_arr[i] > 0)
buffered_io_size += client_comm_sz_arr[i];
}
}
#ifdef USE_PRE_REQ
else {
/* Example use of ADIOI_Build_client_pre_req. to an
* appropriate section */
for (i = 0; i < fd->hints->cb_nodes; i++) {
agg_rank = fd->hints->ranklist[(i + myrank) % fd->hints->cb_nodes];
#ifdef AGGREGATION_PROFILE
MPE_Log_event(5040, 0, NULL);
#endif
ADIOI_Build_client_pre_req(fd, agg_rank, (i + myrank) % fd->hints->cb_nodes,
&(my_mem_view_state_arr[agg_rank]),
&(agg_file_view_state_arr[agg_rank]),
2 * 1024 * 1024, 64 * 1024);
#ifdef AGGREGATION_PROFILE
MPE_Log_event(5041, 0, NULL);
#endif
}
}
#endif
if (fd->is_agg)
cb_buf = (char *) ADIOI_Malloc(fd->hints->cb_buffer_size);
alltoallw_disps = (int *) ADIOI_Calloc(nprocs, sizeof(int));
alltoallw_counts = client_alltoallw_counts = (int *)
ADIOI_Calloc(2 * nprocs, sizeof(int));
agg_alltoallw_counts = &alltoallw_counts[nprocs];
if (fd->hints->cb_alltoall == ADIOI_HINT_DISABLE) {
/* aggregators pre-post all Irecv's for incoming data from clients */
if ((fd->is_agg) && (rdwr == ADIOI_WRITE))
post_aggregator_comm(fd->comm, rdwr, nprocs, cb_buf,
client_comm_dtype_arr,
client_comm_sz_arr, &agg_comm_requests, &aggs_client_count);
}
/* Aggregators send amounts for data requested to clients */
Exch_data_amounts(fd, nprocs, client_comm_sz_arr, agg_comm_sz_arr,
client_alltoallw_counts, agg_alltoallw_counts, &aggregators_done);
#ifdef DEBUG
fprintf(stderr, "client_alltoallw_counts[ ");
for (i = 0; i < nprocs; i++) {
fprintf(stderr, "%d ", client_alltoallw_counts[i]);
}
fprintf(stderr, "]\n");
fprintf(stderr, "agg_alltoallw_counts[ ");
for (i = 0; i < nprocs; i++) {
fprintf(stderr, "%d ", agg_alltoallw_counts[i]);
}
fprintf(stderr, "]\n");
#endif
/* keep looping while aggregators still have I/O to do */
while (aggregators_done != nprocs_for_coll) {
if (fd->hints->cb_alltoall == ADIOI_HINT_DISABLE) {
/* clients should build datatypes for local memory locations
* for data communication with aggregators and post
* communication as the datatypes are built */
client_comm_requests = (MPI_Request *)
ADIOI_Calloc(fd->hints->cb_nodes, sizeof(MPI_Request));
for (i = 0; i < fd->hints->cb_nodes; i++) {
clients_agg_count = 0;
agg_rank = fd->hints->ranklist[(i + myrank) % fd->hints->cb_nodes];
if (agg_comm_sz_arr[agg_rank] > 0) {
ADIOI_Build_client_req(fd, agg_rank,
(i + myrank) % fd->hints->cb_nodes,
&(my_mem_view_state_arr[agg_rank]),
&(agg_file_view_state_arr[agg_rank]),
agg_comm_sz_arr[agg_rank],
&(agg_comm_dtype_arr[agg_rank]));
#ifdef AGGREGATION_PROFILE
if (i == 0)
MPE_Log_event(5038, 0, NULL);
#endif
post_client_comm(fd, rdwr, agg_rank, buf,
agg_comm_dtype_arr[agg_rank],
agg_alltoallw_counts[agg_rank],
&client_comm_requests[clients_agg_count]);
clients_agg_count++;
}
}
#ifdef AGGREGATION_PROFILE
if (!clients_agg_count)
MPE_Log_event(5039, 0, NULL);
#endif
if (rdwr == ADIOI_READ) {
if (fd->is_agg && buffered_io_size) {
ADIOI_IOFiletype(fd, cb_buf, buffered_io_size, MPI_BYTE,
ADIO_EXPLICIT_OFFSET, agg_disp, agg_dtype,
ADIOI_READ, status, error_code);
if (*error_code != MPI_SUCCESS)
return;
MPI_Type_free(&agg_dtype);
}
#ifdef DEBUG
fprintf(stderr, "expecting from [agg](disp,size,cnt)=");
for (i = 0; i < nprocs; i++) {
MPI_Type_size_x(agg_comm_dtype_arr[i], &size);
fprintf(stderr, "[%d](%d,%d,%d)", i, alltoallw_disps[i],
size, agg_alltoallw_counts[i]);
if (i != nprocs - 1)
fprintf(stderr, ",");
}
fprintf(stderr, "]\n");
if (fd->is_agg) {
fprintf(stderr, "sending to [client](disp,size,cnt)=");
for (i = 0; i < nprocs; i++) {
if (fd->is_agg)
MPI_Type_size_x(client_comm_dtype_arr[i], &size);
else
size = -1;
fprintf(stderr, "[%d](%d,%d,%d)", i, alltoallw_disps[i],
size, client_alltoallw_counts[i]);
if (i != nprocs - 1)
fprintf(stderr, ",");
}
fprintf(stderr, "\n");
}
fflush(NULL);
#endif
/* aggregators post all Isends for outgoing data to clients */
if (fd->is_agg)
post_aggregator_comm(fd->comm, rdwr, nprocs, cb_buf,
client_comm_dtype_arr,
client_comm_sz_arr,
&agg_comm_requests, &aggs_client_count);
if (fd->is_agg && aggs_client_count) {
#ifdef MPI_STATUSES_IGNORE
agg_comm_statuses = MPI_STATUSES_IGNORE;
#else
agg_comm_statuses = ADIOI_Malloc(aggs_client_count * sizeof(MPI_Status));
#endif
MPI_Waitall(aggs_client_count, agg_comm_requests, agg_comm_statuses);
#ifdef AGGREGATION_PROFILE
MPE_Log_event(5033, 0, NULL);
#endif
ADIOI_Free(agg_comm_requests);
#ifndef MPI_STATUSES_IGNORE
ADIOI_Free(agg_comm_statuses);
#endif
}
if (clients_agg_count) {
#ifdef MPI_STATUSES_IGNORE
client_comm_statuses = MPI_STATUSES_IGNORE;
#else
client_comm_statuses = ADIOI_Malloc(clients_agg_count * sizeof(MPI_Status));
#endif
MPI_Waitall(clients_agg_count, client_comm_requests, client_comm_statuses);
#ifdef AGGREGATION_PROFILE
MPE_Log_event(5039, 0, NULL);
#endif
ADIOI_Free(client_comm_requests);
#ifndef MPI_STATUSES_IGNORE
ADIOI_Free(client_comm_statuses);
#endif
}
#ifdef DEBUG2
fprintf(stderr, "buffered_io_size = %lld\n", buffered_io_size);
if (fd->is_agg && buffered_io_size) {
fprintf(stderr, "buf = [");
for (i = 0; i < bufextent; i++)
fprintf(stderr, "%c", ((char *) buf)[i]);
fprintf(stderr, "]\n");
fprintf(stderr, "cb_buf = [");
for (i = 0; i < buffered_io_size; i++)
fprintf(stderr, "%c", cb_buf[i]);
fprintf(stderr, "]\n");
fflush(NULL);
}
#endif
} else { /* Write Case */
#ifdef DEBUG
fprintf(stderr, "sending to [agg](disp,size,cnt)=");
for (i = 0; i < nprocs; i++) {
MPI_Type_size_x(agg_comm_dtype_arr[i], &size);
fprintf(stderr, "[%d](%d,%d,%d)", i, alltoallw_disps[i],
size, agg_alltoallw_counts[i]);
if (i != nprocs - 1)
fprintf(stderr, ",");
}
fprintf(stderr, "]\n");
fprintf(stderr, "expecting from [client](disp,size,cnt)=");
for (i = 0; i < nprocs; i++) {
if (fd->is_agg)
MPI_Type_size_x(client_comm_dtype_arr[i], &size);
else
size = -1;
fprintf(stderr, "[%d](%d,%d,%d)", i, alltoallw_disps[i],
size, client_alltoallw_counts[i]);
if (i != nprocs - 1)
fprintf(stderr, ",");
}
fprintf(stderr, "\n");
fflush(NULL);
#endif
#ifdef DEBUG
fprintf(stderr, "buffered_io_size = %lld\n", buffered_io_size);
#endif
if (clients_agg_count) {
#ifdef MPI_STATUSES_IGNORE
client_comm_statuses = MPI_STATUSES_IGNORE;
#else
client_comm_statuses = ADIOI_Malloc(clients_agg_count * sizeof(MPI_Status));
#endif
MPI_Waitall(clients_agg_count, client_comm_requests, client_comm_statuses);
#ifdef AGGREGATION_PROFILE
MPE_Log_event(5039, 0, NULL);
#endif
ADIOI_Free(client_comm_requests);
#ifndef MPI_STATUSES_IGNORE
ADIOI_Free(client_comm_statuses);
#endif
}
#ifdef DEBUG2
if (bufextent) {
fprintf(stderr, "buf = [");
for (i = 0; i < bufextent; i++)
fprintf(stderr, "%c", ((char *) buf)[i]);
fprintf(stderr, "]\n");
}
#endif
if (fd->is_agg && buffered_io_size) {
ADIOI_Assert(aggs_client_count != 0);
/* make sure we actually have the data to write out */
#ifdef MPI_STATUSES_IGNORE
agg_comm_statuses = MPI_STATUSES_IGNORE;
#else
agg_comm_statuses = (MPI_Status *)
ADIOI_Malloc(aggs_client_count * sizeof(MPI_Status));
#endif
MPI_Waitall(aggs_client_count, agg_comm_requests, agg_comm_statuses);
#ifdef AGGREGATION_PROFILE
MPE_Log_event(5033, 0, NULL);
#endif
ADIOI_Free(agg_comm_requests);
#ifndef MPI_STATUSES_IGNORE
ADIOI_Free(agg_comm_statuses);
#endif
#ifdef DEBUG2
fprintf(stderr, "cb_buf = [");
for (i = 0; i < buffered_io_size; i++)
fprintf(stderr, "%c", cb_buf[i]);
fprintf(stderr, "]\n");
fflush(NULL);
#endif
ADIOI_IOFiletype(fd, cb_buf, buffered_io_size, MPI_BYTE,
ADIO_EXPLICIT_OFFSET, agg_disp, agg_dtype,
ADIOI_WRITE, status, error_code);
if (*error_code != MPI_SUCCESS)
return;
MPI_Type_free(&agg_dtype);
}
}
} else {
/* Alltoallw version of everything */
ADIOI_Build_client_reqs(fd, nprocs, my_mem_view_state_arr,
agg_file_view_state_arr, agg_comm_sz_arr, agg_comm_dtype_arr);
if (rdwr == ADIOI_READ) {
if (fd->is_agg && buffered_io_size) {
ADIOI_IOFiletype(fd, cb_buf, buffered_io_size, MPI_BYTE,
ADIO_EXPLICIT_OFFSET, agg_disp, agg_dtype,
ADIOI_READ, status, error_code);
if (*error_code != MPI_SUCCESS)
return;
MPI_Type_free(&agg_dtype);
}
#ifdef AGGREGATION_PROFILE
MPE_Log_event(5032, 0, NULL);
#endif
MPI_Alltoallw(cb_buf, client_alltoallw_counts, alltoallw_disps,
client_comm_dtype_arr,
buf, agg_alltoallw_counts, alltoallw_disps,
agg_comm_dtype_arr, fd->comm);
#ifdef AGGREGATION_PROFILE
MPE_Log_event(5033, 0, NULL);
#endif
} else { /* Write Case */
#ifdef AGGREGATION_PROFILE
MPE_Log_event(5032, 0, NULL);
#endif
MPI_Alltoallw(buf, agg_alltoallw_counts, alltoallw_disps,
agg_comm_dtype_arr,
cb_buf, client_alltoallw_counts, alltoallw_disps,
client_comm_dtype_arr, fd->comm);
#ifdef AGGREGATION_PROFILE
MPE_Log_event(5033, 0, NULL);
#endif
if (fd->is_agg && buffered_io_size) {
ADIOI_IOFiletype(fd, cb_buf, buffered_io_size, MPI_BYTE,
ADIO_EXPLICIT_OFFSET, agg_disp, agg_dtype,
ADIOI_WRITE, status, error_code);
if (*error_code != MPI_SUCCESS)
return;
MPI_Type_free(&agg_dtype);
}
}
}
/* Free (uncommit) datatypes for reuse */
if (fd->is_agg) {
if (buffered_io_size > 0) {
for (i = 0; i < nprocs; i++) {
if (client_comm_sz_arr[i] > 0)
MPI_Type_free(&client_comm_dtype_arr[i]);
}
}
}
for (i = 0; i < nprocs; i++) {
if (agg_comm_sz_arr[i] > 0)
MPI_Type_free(&agg_comm_dtype_arr[i]);
}
/* figure out next set up requests */
if (fd->is_agg) {
ADIOI_Build_agg_reqs(fd, rdwr, nprocs,
client_file_view_state_arr,
client_comm_dtype_arr, client_comm_sz_arr, &agg_disp, &agg_dtype);
buffered_io_size = 0;
for (i = 0; i < nprocs; i++) {
if (client_comm_sz_arr[i] > 0)
buffered_io_size += client_comm_sz_arr[i];
}
}
#ifdef USE_PRE_REQ
else {
/* Example use of ADIOI_Build_client_pre_req. to an
* appropriate section */
for (i = 0; i < fd->hints->cb_nodes; i++) {
agg_rank = fd->hints->ranklist[(i + myrank) % fd->hints->cb_nodes];
#ifdef AGGREGATION_PROFILE
MPE_Log_event(5040, 0, NULL);
#endif
ADIOI_Build_client_pre_req(fd, agg_rank, (i + myrank) % fd->hints->cb_nodes,
&(my_mem_view_state_arr[agg_rank]),
&(agg_file_view_state_arr[agg_rank]),
2 * 1024 * 1024, 64 * 1024);
#ifdef AGGREGATION_PROFILE
MPE_Log_event(5041, 0, NULL);
#endif
}
}
#endif
/* aggregators pre-post all Irecv's for incoming data from
* clients. if nothing is needed, agg_comm_requests is not
* allocated */
if (fd->hints->cb_alltoall == ADIOI_HINT_DISABLE) {
if ((fd->is_agg) && (rdwr == ADIOI_WRITE))
post_aggregator_comm(fd->comm, rdwr, nprocs, cb_buf,
client_comm_dtype_arr,
client_comm_sz_arr, &agg_comm_requests, &aggs_client_count);
}
/* Aggregators send amounts for data requested to clients */
Exch_data_amounts(fd, nprocs, client_comm_sz_arr, agg_comm_sz_arr,
client_alltoallw_counts, agg_alltoallw_counts, &aggregators_done);
}
/* Clean up */
if (fd->hints->cb_pfr != ADIOI_HINT_ENABLE) {
/* AAR, FSIZE, and User provided uniform File realms */
if (1) {
MPI_Type_free(&fd->file_realm_types[0]);
} else {
for (i = 0; i < fd->hints->cb_nodes; i++) {
ADIOI_Datatype_iscontig(fd->file_realm_types[i], &is_contig);
MPI_Type_free(&fd->file_realm_types[i]);
}
}
ADIOI_Free(fd->file_realm_types);
ADIOI_Free(fd->file_realm_st_offs);
}
if (fd->is_agg) {
if (buffered_io_size > 0)
MPI_Type_free(&agg_dtype);
for (i = 0; i < nprocs; i++) {
MPI_Type_free(&client_comm_dtype_arr[i]);
ADIOI_Free(client_file_view_state_arr[i].flat_type_p->indices);
ADIOI_Free(client_file_view_state_arr[i].flat_type_p->blocklens);
ADIOI_Free(client_file_view_state_arr[i].flat_type_p);
}
ADIOI_Free(client_file_view_state_arr);
ADIOI_Free(cb_buf);
}
for (i = 0; i < nprocs; i++)
if (agg_comm_sz_arr[i] > 0)
MPI_Type_free(&agg_comm_dtype_arr[i]);
ADIOI_Free(client_comm_sz_arr);
ADIOI_Free(client_comm_dtype_arr);
ADIOI_Free(my_mem_view_state_arr);
ADIOI_Free(agg_file_view_state_arr);
ADIOI_Free(agg_comm_sz_arr);
ADIOI_Free(agg_comm_dtype_arr);
ADIOI_Free(alltoallw_disps);
ADIOI_Free(alltoallw_counts);
ADIOI_Free(all_st_end_offsets);
#ifdef HAVE_STATUS_SET_BYTES
MPIR_Status_set_bytes(status, datatype, bufsize);
/* This is a temporary way of filling in status. The right way is
* to keep track of how much data was actually read and placed in
* buf during collective I/O. */
#endif
fd->fp_sys_posn = -1; /* set it to null. */
#ifdef AGGREGATION_PROFILE
if (rdwr == ADIOI_READ)
MPE_Log_event(5011, 0, NULL);
else
MPE_Log_event(5013, 0, NULL);
#endif
}
int MPIR_Allreduce_intra_recursive_doubling(
const void *sendbuf,
void *recvbuf,
int count,
MPI_Datatype datatype,
MPI_Op op,
MPIR_Comm * comm_ptr,
MPIR_Errflag_t * errflag)
{
MPIR_CHKLMEM_DECL(1);
#ifdef MPID_HAS_HETERO
int is_homogeneous;
int rc;
#endif
int comm_size, rank;
int mpi_errno = MPI_SUCCESS;
int mpi_errno_ret = MPI_SUCCESS;
int mask, dst, is_commutative, pof2, newrank, rem, newdst;
MPI_Aint true_extent, true_lb, extent;
void *tmp_buf;
comm_size = comm_ptr->local_size;
rank = comm_ptr->rank;
is_commutative = MPIR_Op_is_commutative(op);
/* need to allocate temporary buffer to store incoming data*/
MPIR_Type_get_true_extent_impl(datatype, &true_lb, &true_extent);
MPIR_Datatype_get_extent_macro(datatype, extent);
MPIR_Ensure_Aint_fits_in_pointer(count * MPL_MAX(extent, true_extent));
MPIR_CHKLMEM_MALLOC(tmp_buf, void *, count*(MPL_MAX(extent,true_extent)), mpi_errno, "temporary buffer", MPL_MEM_BUFFER);
/* adjust for potential negative lower bound in datatype */
tmp_buf = (void *)((char*)tmp_buf - true_lb);
/* copy local data into recvbuf */
if (sendbuf != MPI_IN_PLACE) {
mpi_errno = MPIR_Localcopy(sendbuf, count, datatype, recvbuf,
count, datatype);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
}
/* get nearest power-of-two less than or equal to comm_size */
pof2 = comm_ptr->pof2;
rem = comm_size - pof2;
/* In the non-power-of-two case, all even-numbered
processes of rank < 2*rem send their data to
(rank+1). These even-numbered processes no longer
participate in the algorithm until the very end. The
remaining processes form a nice power-of-two. */
if (rank < 2*rem) {
if (rank % 2 == 0) { /* even */
mpi_errno = MPIC_Send(recvbuf, count,
datatype, rank+1,
MPIR_ALLREDUCE_TAG, comm_ptr, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag = MPIR_ERR_GET_CLASS(mpi_errno);
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
/* temporarily set the rank to -1 so that this
process does not pariticipate in recursive
doubling */
newrank = -1;
}
else { /* odd */
mpi_errno = MPIC_Recv(tmp_buf, count,
datatype, rank-1,
MPIR_ALLREDUCE_TAG, comm_ptr,
MPI_STATUS_IGNORE, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag = MPIR_ERR_GET_CLASS(mpi_errno);
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
/* do the reduction on received data. since the
ordering is right, it doesn't matter whether
the operation is commutative or not. */
mpi_errno = MPIR_Reduce_local(tmp_buf, recvbuf, count, datatype, op);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
/* change the rank */
newrank = rank / 2;
}
}
else /* rank >= 2*rem */
newrank = rank - rem;
/* If op is user-defined or count is less than pof2, use
recursive doubling algorithm. Otherwise do a reduce-scatter
followed by allgather. (If op is user-defined,
derived datatypes are allowed and the user could pass basic
datatypes on one process and derived on another as long as
the type maps are the same. Breaking up derived
datatypes to do the reduce-scatter is tricky, therefore
using recursive doubling in that case.) */
if (newrank != -1) {
mask = 0x1;
while (mask < pof2) {
newdst = newrank ^ mask;
/* find real rank of dest */
dst = (newdst < rem) ? newdst*2 + 1 : newdst + rem;
/* Send the most current data, which is in recvbuf. Recv
into tmp_buf */
mpi_errno = MPIC_Sendrecv(recvbuf, count, datatype,
dst, MPIR_ALLREDUCE_TAG, tmp_buf,
count, datatype, dst,
MPIR_ALLREDUCE_TAG, comm_ptr,
MPI_STATUS_IGNORE, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag = MPIR_ERR_GET_CLASS(mpi_errno);
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
/* tmp_buf contains data received in this step.
recvbuf contains data accumulated so far */
if (is_commutative || (dst < rank)) {
/* op is commutative OR the order is already right */
mpi_errno = MPIR_Reduce_local(tmp_buf, recvbuf, count, datatype, op);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
}
else {
/* op is noncommutative and the order is not right */
mpi_errno = MPIR_Reduce_local(recvbuf, tmp_buf, count, datatype, op);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
/* copy result back into recvbuf */
mpi_errno = MPIR_Localcopy(tmp_buf, count, datatype,
recvbuf, count, datatype);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
}
mask <<= 1;
}
}
/* In the non-power-of-two case, all odd-numbered
processes of rank < 2*rem send the result to
(rank-1), the ranks who didn't participate above. */
if (rank < 2*rem) {
if (rank % 2) /* odd */
mpi_errno = MPIC_Send(recvbuf, count,
datatype, rank-1,
MPIR_ALLREDUCE_TAG, comm_ptr, errflag);
else /* even */
mpi_errno = MPIC_Recv(recvbuf, count,
datatype, rank+1,
MPIR_ALLREDUCE_TAG, comm_ptr,
MPI_STATUS_IGNORE, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag = MPIR_ERR_GET_CLASS(mpi_errno);
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
}
fn_exit:
MPIR_CHKLMEM_FREEALL();
return mpi_errno;
fn_fail:
goto fn_exit;
}
int MPIR_Iscan_rec_dbl(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPIR_Comm *comm_ptr, MPIR_Sched_t s)
{
int mpi_errno = MPI_SUCCESS;
MPI_Aint true_extent, true_lb, extent;
int is_commutative;
int mask, dst, rank, comm_size;
void *partial_scan = NULL;
void *tmp_buf = NULL;
MPIR_SCHED_CHKPMEM_DECL(2);
if (count == 0)
goto fn_exit;
comm_size = comm_ptr->local_size;
rank = comm_ptr->rank;
is_commutative = MPIR_Op_is_commutative(op);
/* need to allocate temporary buffer to store partial scan*/
MPIR_Type_get_true_extent_impl(datatype, &true_lb, &true_extent);
MPID_Datatype_get_extent_macro(datatype, extent);
MPIR_SCHED_CHKPMEM_MALLOC(partial_scan, void *, count*(MPL_MAX(extent,true_extent)), mpi_errno, "partial_scan");
/* This eventually gets malloc()ed as a temp buffer, not added to
* any user buffers */
MPIR_Ensure_Aint_fits_in_pointer(count * MPL_MAX(extent, true_extent));
/* adjust for potential negative lower bound in datatype */
partial_scan = (void *)((char*)partial_scan - true_lb);
/* need to allocate temporary buffer to store incoming data*/
MPIR_SCHED_CHKPMEM_MALLOC(tmp_buf, void *, count*(MPL_MAX(extent,true_extent)), mpi_errno, "tmp_buf");
/* adjust for potential negative lower bound in datatype */
tmp_buf = (void *)((char*)tmp_buf - true_lb);
/* Since this is an inclusive scan, copy local contribution into
recvbuf. */
if (sendbuf != MPI_IN_PLACE) {
mpi_errno = MPIR_Sched_copy(sendbuf, count, datatype,
recvbuf, count, datatype, s);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
}
if (sendbuf != MPI_IN_PLACE)
mpi_errno = MPIR_Sched_copy(sendbuf, count, datatype,
partial_scan, count, datatype, s);
else
mpi_errno = MPIR_Sched_copy(recvbuf, count, datatype,
partial_scan, count, datatype, s);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
mask = 0x1;
while (mask < comm_size) {
dst = rank ^ mask;
if (dst < comm_size) {
/* Send partial_scan to dst. Recv into tmp_buf */
mpi_errno = MPIR_Sched_send(partial_scan, count, datatype, dst, comm_ptr, s);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
/* sendrecv, no barrier here */
mpi_errno = MPIR_Sched_recv(tmp_buf, count, datatype, dst, comm_ptr, s);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
if (rank > dst) {
mpi_errno = MPIR_Sched_reduce(tmp_buf, partial_scan, count, datatype, op, s);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIR_Sched_reduce(tmp_buf, recvbuf, count, datatype, op, s);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
}
else {
if (is_commutative) {
mpi_errno = MPIR_Sched_reduce(tmp_buf, partial_scan, count, datatype, op, s);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
}
else {
mpi_errno = MPIR_Sched_reduce(partial_scan, tmp_buf, count, datatype, op, s);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
mpi_errno = MPIR_Sched_copy(tmp_buf, count, datatype,
partial_scan, count, datatype, s);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
}
}
}
mask <<= 1;
}
MPIR_SCHED_CHKPMEM_COMMIT(s);
fn_exit:
return mpi_errno;
fn_fail:
MPIR_SCHED_CHKPMEM_REAP(s);
goto fn_exit;
}
int MPIR_Ireduce_scatter_sched_intra_recursive_halving(const void *sendbuf, void *recvbuf,
const int recvcounts[],
MPI_Datatype datatype, MPI_Op op,
MPIR_Comm * comm_ptr, MPIR_Sched_t s)
{
int mpi_errno = MPI_SUCCESS;
int rank, comm_size, i;
MPI_Aint extent, true_extent, true_lb;
int *disps;
void *tmp_recvbuf, *tmp_results;
int type_size ATTRIBUTE((unused)), total_count, dst;
int mask;
int *newcnts, *newdisps, rem, newdst, send_idx, recv_idx, last_idx, send_cnt, recv_cnt;
int pof2, old_i, newrank;
MPIR_SCHED_CHKPMEM_DECL(5);
comm_size = comm_ptr->local_size;
rank = comm_ptr->rank;
MPIR_Datatype_get_extent_macro(datatype, extent);
MPIR_Type_get_true_extent_impl(datatype, &true_lb, &true_extent);
#ifdef HAVE_ERROR_CHECKING
MPIR_Assert(MPIR_Op_is_commutative(op));
#endif
MPIR_SCHED_CHKPMEM_MALLOC(disps, int *, comm_size * sizeof(int), mpi_errno, "disps",
MPL_MEM_BUFFER);
total_count = 0;
for (i = 0; i < comm_size; i++) {
disps[i] = total_count;
total_count += recvcounts[i];
}
if (total_count == 0) {
goto fn_exit;
}
MPIR_Datatype_get_size_macro(datatype, type_size);
/* allocate temp. buffer to receive incoming data */
MPIR_SCHED_CHKPMEM_MALLOC(tmp_recvbuf, void *, total_count * (MPL_MAX(true_extent, extent)),
mpi_errno, "tmp_recvbuf", MPL_MEM_BUFFER);
/* adjust for potential negative lower bound in datatype */
tmp_recvbuf = (void *) ((char *) tmp_recvbuf - true_lb);
/* need to allocate another temporary buffer to accumulate
* results because recvbuf may not be big enough */
MPIR_SCHED_CHKPMEM_MALLOC(tmp_results, void *, total_count * (MPL_MAX(true_extent, extent)),
mpi_errno, "tmp_results", MPL_MEM_BUFFER);
/* adjust for potential negative lower bound in datatype */
tmp_results = (void *) ((char *) tmp_results - true_lb);
/* copy sendbuf into tmp_results */
if (sendbuf != MPI_IN_PLACE)
mpi_errno = MPIR_Sched_copy(sendbuf, total_count, datatype,
tmp_results, total_count, datatype, s);
else
mpi_errno = MPIR_Sched_copy(recvbuf, total_count, datatype,
tmp_results, total_count, datatype, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
pof2 = comm_ptr->pof2;
rem = comm_size - pof2;
/* In the non-power-of-two case, all even-numbered
* processes of rank < 2*rem send their data to
* (rank+1). These even-numbered processes no longer
* participate in the algorithm until the very end. The
* remaining processes form a nice power-of-two. */
if (rank < 2 * rem) {
if (rank % 2 == 0) { /* even */
mpi_errno = MPIR_Sched_send(tmp_results, total_count, datatype, rank + 1, comm_ptr, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
/* temporarily set the rank to -1 so that this
* process does not pariticipate in recursive
* doubling */
newrank = -1;
} else { /* odd */
mpi_errno = MPIR_Sched_recv(tmp_recvbuf, total_count, datatype, rank - 1, comm_ptr, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
/* do the reduction on received data. since the
* ordering is right, it doesn't matter whether
* the operation is commutative or not. */
mpi_errno = MPIR_Sched_reduce(tmp_recvbuf, tmp_results, total_count, datatype, op, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
/* change the rank */
newrank = rank / 2;
}
} else /* rank >= 2*rem */
newrank = rank - rem;
if (newrank != -1) {
/* recalculate the recvcounts and disps arrays because the
* even-numbered processes who no longer participate will
* have their result calculated by the process to their
* right (rank+1). */
MPIR_SCHED_CHKPMEM_MALLOC(newcnts, int *, pof2 * sizeof(int), mpi_errno, "newcnts",
MPL_MEM_BUFFER);
MPIR_SCHED_CHKPMEM_MALLOC(newdisps, int *, pof2 * sizeof(int), mpi_errno, "newdisps",
MPL_MEM_BUFFER);
for (i = 0; i < pof2; i++) {
/* what does i map to in the old ranking? */
old_i = (i < rem) ? i * 2 + 1 : i + rem;
if (old_i < 2 * rem) {
/* This process has to also do its left neighbor's
* work */
newcnts[i] = recvcounts[old_i] + recvcounts[old_i - 1];
} else
newcnts[i] = recvcounts[old_i];
}
newdisps[0] = 0;
for (i = 1; i < pof2; i++)
newdisps[i] = newdisps[i - 1] + newcnts[i - 1];
mask = pof2 >> 1;
send_idx = recv_idx = 0;
last_idx = pof2;
while (mask > 0) {
newdst = newrank ^ mask;
/* find real rank of dest */
dst = (newdst < rem) ? newdst * 2 + 1 : newdst + rem;
send_cnt = recv_cnt = 0;
if (newrank < newdst) {
send_idx = recv_idx + mask;
for (i = send_idx; i < last_idx; i++)
send_cnt += newcnts[i];
for (i = recv_idx; i < send_idx; i++)
recv_cnt += newcnts[i];
} else {
recv_idx = send_idx + mask;
for (i = send_idx; i < recv_idx; i++)
send_cnt += newcnts[i];
for (i = recv_idx; i < last_idx; i++)
recv_cnt += newcnts[i];
}
/* Send data from tmp_results. Recv into tmp_recvbuf */
{
/* avoid sending and receiving pointless 0-byte messages */
int send_dst = (send_cnt ? dst : MPI_PROC_NULL);
int recv_dst = (recv_cnt ? dst : MPI_PROC_NULL);
mpi_errno = MPIR_Sched_send(((char *) tmp_results + newdisps[send_idx] * extent),
send_cnt, datatype, send_dst, comm_ptr, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIR_Sched_recv(((char *) tmp_recvbuf + newdisps[recv_idx] * extent),
recv_cnt, datatype, recv_dst, comm_ptr, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
}
/* tmp_recvbuf contains data received in this step.
* tmp_results contains data accumulated so far */
if (recv_cnt) {
mpi_errno = MPIR_Sched_reduce(((char *) tmp_recvbuf + newdisps[recv_idx] * extent),
((char *) tmp_results + newdisps[recv_idx] * extent),
recv_cnt, datatype, op, s);
MPIR_SCHED_BARRIER(s);
}
/* update send_idx for next iteration */
send_idx = recv_idx;
last_idx = recv_idx + mask;
mask >>= 1;
}
/* copy this process's result from tmp_results to recvbuf */
if (recvcounts[rank]) {
mpi_errno = MPIR_Sched_copy(((char *) tmp_results + disps[rank] * extent),
recvcounts[rank], datatype,
recvbuf, recvcounts[rank], datatype, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
}
}
int MPIR_Alltoall_intra(
const void *sendbuf,
int sendcount,
MPI_Datatype sendtype,
void *recvbuf,
int recvcount,
MPI_Datatype recvtype,
MPIR_Comm *comm_ptr,
MPIR_Errflag_t *errflag )
{
int comm_size, i, j, pof2;
MPI_Aint sendtype_extent, recvtype_extent;
MPI_Aint recvtype_true_extent, recvbuf_extent, recvtype_true_lb;
int mpi_errno=MPI_SUCCESS, src, dst, rank, nbytes;
int mpi_errno_ret = MPI_SUCCESS;
MPI_Status status;
int sendtype_size, block, *displs, count;
MPI_Aint pack_size, position;
MPI_Datatype newtype = MPI_DATATYPE_NULL;
void *tmp_buf;
MPIR_Request **reqarray;
MPI_Status *starray;
MPIR_CHKLMEM_DECL(6);
if (recvcount == 0) return MPI_SUCCESS;
comm_size = comm_ptr->local_size;
rank = comm_ptr->rank;
/* Get extent of send and recv types */
MPID_Datatype_get_extent_macro(recvtype, recvtype_extent);
MPID_Datatype_get_extent_macro(sendtype, sendtype_extent);
MPID_Datatype_get_size_macro(sendtype, sendtype_size);
nbytes = sendtype_size * sendcount;
if (sendbuf == MPI_IN_PLACE) {
/* We use pair-wise sendrecv_replace in order to conserve memory usage,
* which is keeping with the spirit of the MPI-2.2 Standard. But
* because of this approach all processes must agree on the global
* schedule of sendrecv_replace operations to avoid deadlock.
*
* Note that this is not an especially efficient algorithm in terms of
* time and there will be multiple repeated malloc/free's rather than
* maintaining a single buffer across the whole loop. Something like
* MADRE is probably the best solution for the MPI_IN_PLACE scenario. */
for (i = 0; i < comm_size; ++i) {
/* start inner loop at i to avoid re-exchanging data */
for (j = i; j < comm_size; ++j) {
if (rank == i) {
/* also covers the (rank == i && rank == j) case */
mpi_errno = MPIC_Sendrecv_replace(((char *)recvbuf + j*recvcount*recvtype_extent),
recvcount, recvtype,
j, MPIR_ALLTOALL_TAG,
j, MPIR_ALLTOALL_TAG,
comm_ptr, &status, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag = MPIR_ERR_GET_CLASS(mpi_errno);
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
}
else if (rank == j) {
/* same as above with i/j args reversed */
mpi_errno = MPIC_Sendrecv_replace(((char *)recvbuf + i*recvcount*recvtype_extent),
recvcount, recvtype,
i, MPIR_ALLTOALL_TAG,
i, MPIR_ALLTOALL_TAG,
comm_ptr, &status, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag = MPIR_ERR_GET_CLASS(mpi_errno);
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
}
}
}
}
else if ((nbytes <= MPIR_CVAR_ALLTOALL_SHORT_MSG_SIZE) && (comm_size >= 8)) {
/* use the indexing algorithm by Jehoshua Bruck et al,
* IEEE TPDS, Nov. 97 */
/* allocate temporary buffer */
MPIR_Pack_size_impl(recvcount*comm_size, recvtype, &pack_size);
MPIR_CHKLMEM_MALLOC(tmp_buf, void *, pack_size, mpi_errno, "tmp_buf");
/* Do Phase 1 of the algorithim. Shift the data blocks on process i
* upwards by a distance of i blocks. Store the result in recvbuf. */
mpi_errno = MPIR_Localcopy((char *) sendbuf +
rank*sendcount*sendtype_extent,
(comm_size - rank)*sendcount, sendtype, recvbuf,
(comm_size - rank)*recvcount, recvtype);
if (mpi_errno) { MPIR_ERR_POP(mpi_errno); }
mpi_errno = MPIR_Localcopy(sendbuf, rank*sendcount, sendtype,
(char *) recvbuf +
(comm_size-rank)*recvcount*recvtype_extent,
rank*recvcount, recvtype);
if (mpi_errno) { MPIR_ERR_POP(mpi_errno); }
/* Input data is now stored in recvbuf with datatype recvtype */
/* Now do Phase 2, the communication phase. It takes
ceiling(lg p) steps. In each step i, each process sends to rank+2^i
and receives from rank-2^i, and exchanges all data blocks
whose ith bit is 1. */
/* allocate displacements array for indexed datatype used in
communication */
MPIR_CHKLMEM_MALLOC(displs, int *, comm_size * sizeof(int), mpi_errno, "displs");
pof2 = 1;
while (pof2 < comm_size) {
dst = (rank + pof2) % comm_size;
src = (rank - pof2 + comm_size) % comm_size;
/* Exchange all data blocks whose ith bit is 1 */
/* Create an indexed datatype for the purpose */
count = 0;
for (block=1; block<comm_size; block++) {
if (block & pof2) {
displs[count] = block * recvcount;
count++;
}
}
mpi_errno = MPIR_Type_create_indexed_block_impl(count, recvcount,
displs, recvtype, &newtype);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIR_Type_commit_impl(&newtype);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
position = 0;
mpi_errno = MPIR_Pack_impl(recvbuf, 1, newtype, tmp_buf, pack_size, &position);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIC_Sendrecv(tmp_buf, position, MPI_PACKED, dst,
MPIR_ALLTOALL_TAG, recvbuf, 1, newtype,
src, MPIR_ALLTOALL_TAG, comm_ptr,
MPI_STATUS_IGNORE, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag = MPIR_ERR_GET_CLASS(mpi_errno);
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
MPIR_Type_free_impl(&newtype);
pof2 *= 2;
}
/* Rotate blocks in recvbuf upwards by (rank + 1) blocks. Need
* a temporary buffer of the same size as recvbuf. */
/* get true extent of recvtype */
MPIR_Type_get_true_extent_impl(recvtype, &recvtype_true_lb, &recvtype_true_extent);
recvbuf_extent = recvcount * comm_size *
(MPL_MAX(recvtype_true_extent, recvtype_extent));
MPIR_CHKLMEM_MALLOC(tmp_buf, void *, recvbuf_extent, mpi_errno, "tmp_buf");
/* adjust for potential negative lower bound in datatype */
tmp_buf = (void *)((char*)tmp_buf - recvtype_true_lb);
mpi_errno = MPIR_Localcopy((char *) recvbuf + (rank+1)*recvcount*recvtype_extent,
(comm_size - rank - 1)*recvcount, recvtype, tmp_buf,
(comm_size - rank - 1)*recvcount, recvtype);
if (mpi_errno) { MPIR_ERR_POP(mpi_errno); }
mpi_errno = MPIR_Localcopy(recvbuf, (rank+1)*recvcount, recvtype,
(char *) tmp_buf + (comm_size-rank-1)*recvcount*recvtype_extent,
(rank+1)*recvcount, recvtype);
if (mpi_errno) { MPIR_ERR_POP(mpi_errno); }
/* Blocks are in the reverse order now (comm_size-1 to 0).
* Reorder them to (0 to comm_size-1) and store them in recvbuf. */
for (i=0; i<comm_size; i++){
mpi_errno = MPIR_Localcopy((char *) tmp_buf + i*recvcount*recvtype_extent,
recvcount, recvtype,
(char *) recvbuf + (comm_size-i-1)*recvcount*recvtype_extent,
recvcount, recvtype);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
}
}
/* Algorithm: Recursive halving
*
* This is a recursive-halving algorithm in which the first p/2 processes send
* the second n/2 data to their counterparts in the other half and receive the
* first n/2 data from them. This procedure continues recursively, halving the
* data communicated at each step, for a total of lgp steps. If the number of
* processes is not a power-of-two, we convert it to the nearest lower
* power-of-two by having the first few even-numbered processes send their data
* to the neighboring odd-numbered process at (rank+1). Those odd-numbered
* processes compute the result for their left neighbor as well in the
* recursive halving algorithm, and then at the end send the result back to
* the processes that didn't participate. Therefore, if p is a power-of-two:
*
* Cost = lgp.alpha + n.((p-1)/p).beta + n.((p-1)/p).gamma
*
* If p is not a power-of-two:
*
* Cost = (floor(lgp)+2).alpha + n.(1+(p-1+n)/p).beta + n.(1+(p-1)/p).gamma
*
* The above cost in the non power-of-two case is approximate because there is
* some imbalance in the amount of work each process does because some
* processes do the work of their neighbors as well.
*/
int MPIR_Reduce_scatter_block_intra_recursive_halving (
const void *sendbuf,
void *recvbuf,
int recvcount,
MPI_Datatype datatype,
MPI_Op op,
MPIR_Comm *comm_ptr,
MPIR_Errflag_t *errflag )
{
int rank, comm_size, i;
MPI_Aint extent, true_extent, true_lb;
int *disps;
void *tmp_recvbuf, *tmp_results;
int mpi_errno = MPI_SUCCESS;
int mpi_errno_ret = MPI_SUCCESS;
int total_count, dst;
int mask;
int *newcnts, *newdisps, rem, newdst, send_idx, recv_idx,
last_idx, send_cnt, recv_cnt;
int pof2, old_i, newrank;
MPIR_CHKLMEM_DECL(5);
comm_size = comm_ptr->local_size;
rank = comm_ptr->rank;
#ifdef HAVE_ERROR_CHECKING
{
int is_commutative;
is_commutative = MPIR_Op_is_commutative(op);
MPIR_Assert(is_commutative);
}
#endif /* HAVE_ERROR_CHECKING */
/* set op_errno to 0. stored in perthread structure */
{
MPIR_Per_thread_t *per_thread = NULL;
int err = 0;
MPID_THREADPRIV_KEY_GET_ADDR(MPIR_ThreadInfo.isThreaded, MPIR_Per_thread_key,
MPIR_Per_thread, per_thread, &err);
MPIR_Assert(err == 0);
per_thread->op_errno = 0;
}
if (recvcount == 0) {
goto fn_exit;
}
MPIR_Datatype_get_extent_macro(datatype, extent);
MPIR_Type_get_true_extent_impl(datatype, &true_lb, &true_extent);
MPIR_CHKLMEM_MALLOC(disps, int *, comm_size * sizeof(int), mpi_errno, "disps", MPL_MEM_BUFFER);
total_count = comm_size*recvcount;
for (i=0; i<comm_size; i++) {
disps[i] = i*recvcount;
}
/* total_count*extent eventually gets malloced. it isn't added to
* a user-passed in buffer */
MPIR_Ensure_Aint_fits_in_pointer(total_count * MPL_MAX(true_extent, extent));
/* commutative and short. use recursive halving algorithm */
/* allocate temp. buffer to receive incoming data */
MPIR_CHKLMEM_MALLOC(tmp_recvbuf, void *, total_count*(MPL_MAX(true_extent,extent)), mpi_errno, "tmp_recvbuf", MPL_MEM_BUFFER);
/* adjust for potential negative lower bound in datatype */
tmp_recvbuf = (void *)((char*)tmp_recvbuf - true_lb);
/* need to allocate another temporary buffer to accumulate
results because recvbuf may not be big enough */
MPIR_CHKLMEM_MALLOC(tmp_results, void *, total_count*(MPL_MAX(true_extent,extent)), mpi_errno, "tmp_results", MPL_MEM_BUFFER);
/* adjust for potential negative lower bound in datatype */
tmp_results = (void *)((char*)tmp_results - true_lb);
/* copy sendbuf into tmp_results */
if (sendbuf != MPI_IN_PLACE)
mpi_errno = MPIR_Localcopy(sendbuf, total_count, datatype,
tmp_results, total_count, datatype);
else
mpi_errno = MPIR_Localcopy(recvbuf, total_count, datatype,
tmp_results, total_count, datatype);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
pof2 = comm_ptr->pof2;
rem = comm_size - pof2;
/* In the non-power-of-two case, all even-numbered
processes of rank < 2*rem send their data to
(rank+1). These even-numbered processes no longer
participate in the algorithm until the very end. The
remaining processes form a nice power-of-two. */
if (rank < 2*rem) {
if (rank % 2 == 0) { /* even */
mpi_errno = MPIC_Send(tmp_results, total_count,
datatype, rank+1,
MPIR_REDUCE_SCATTER_BLOCK_TAG, comm_ptr, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag = MPIR_ERR_GET_CLASS(mpi_errno);
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
/* temporarily set the rank to -1 so that this
process does not pariticipate in recursive
doubling */
newrank = -1;
}
else { /* odd */
mpi_errno = MPIC_Recv(tmp_recvbuf, total_count,
datatype, rank-1,
MPIR_REDUCE_SCATTER_BLOCK_TAG, comm_ptr,
MPI_STATUS_IGNORE, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag = MPIR_ERR_GET_CLASS(mpi_errno);
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
/* do the reduction on received data. since the
ordering is right, it doesn't matter whether
the operation is commutative or not. */
mpi_errno = MPIR_Reduce_local( tmp_recvbuf, tmp_results,
total_count, datatype, op);
/* change the rank */
newrank = rank / 2;
}
}
else /* rank >= 2*rem */
newrank = rank - rem;
if (newrank != -1) {
/* recalculate the recvcnts and disps arrays because the
even-numbered processes who no longer participate will
have their result calculated by the process to their
right (rank+1). */
MPIR_CHKLMEM_MALLOC(newcnts, int *, pof2*sizeof(int), mpi_errno, "newcnts", MPL_MEM_BUFFER);
MPIR_CHKLMEM_MALLOC(newdisps, int *, pof2*sizeof(int), mpi_errno, "newdisps", MPL_MEM_BUFFER);
for (i=0; i<pof2; i++) {
/* what does i map to in the old ranking? */
old_i = (i < rem) ? i*2 + 1 : i + rem;
if (old_i < 2*rem) {
/* This process has to also do its left neighbor's
work */
newcnts[i] = 2 * recvcount;
}
else
newcnts[i] = recvcount;
}
newdisps[0] = 0;
for (i=1; i<pof2; i++)
newdisps[i] = newdisps[i-1] + newcnts[i-1];
mask = pof2 >> 1;
send_idx = recv_idx = 0;
last_idx = pof2;
while (mask > 0) {
newdst = newrank ^ mask;
/* find real rank of dest */
dst = (newdst < rem) ? newdst*2 + 1 : newdst + rem;
send_cnt = recv_cnt = 0;
if (newrank < newdst) {
send_idx = recv_idx + mask;
for (i=send_idx; i<last_idx; i++)
send_cnt += newcnts[i];
for (i=recv_idx; i<send_idx; i++)
recv_cnt += newcnts[i];
}
else {
recv_idx = send_idx + mask;
for (i=send_idx; i<recv_idx; i++)
send_cnt += newcnts[i];
for (i=recv_idx; i<last_idx; i++)
recv_cnt += newcnts[i];
}
/* printf("Rank %d, send_idx %d, recv_idx %d, send_cnt %d, recv_cnt %d, last_idx %d\n", newrank, send_idx, recv_idx,
send_cnt, recv_cnt, last_idx);
*/
/* Send data from tmp_results. Recv into tmp_recvbuf */
if ((send_cnt != 0) && (recv_cnt != 0))
mpi_errno = MPIC_Sendrecv((char *) tmp_results +
newdisps[send_idx]*extent,
send_cnt, datatype,
dst, MPIR_REDUCE_SCATTER_BLOCK_TAG,
(char *) tmp_recvbuf +
newdisps[recv_idx]*extent,
recv_cnt, datatype, dst,
MPIR_REDUCE_SCATTER_BLOCK_TAG, comm_ptr,
MPI_STATUS_IGNORE, errflag);
else if ((send_cnt == 0) && (recv_cnt != 0))
mpi_errno = MPIC_Recv((char *) tmp_recvbuf +
newdisps[recv_idx]*extent,
recv_cnt, datatype, dst,
MPIR_REDUCE_SCATTER_BLOCK_TAG, comm_ptr,
MPI_STATUS_IGNORE, errflag);
else if ((recv_cnt == 0) && (send_cnt != 0))
mpi_errno = MPIC_Send((char *) tmp_results +
newdisps[send_idx]*extent,
send_cnt, datatype,
dst, MPIR_REDUCE_SCATTER_BLOCK_TAG,
comm_ptr, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag = MPIR_ERR_GET_CLASS(mpi_errno);
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
/* tmp_recvbuf contains data received in this step.
tmp_results contains data accumulated so far */
if (recv_cnt) {
mpi_errno = MPIR_Reduce_local(
(char *) tmp_recvbuf + newdisps[recv_idx]*extent,
(char *) tmp_results + newdisps[recv_idx]*extent,
recv_cnt, datatype, op);
}
/* update send_idx for next iteration */
send_idx = recv_idx;
last_idx = recv_idx + mask;
mask >>= 1;
}
/* copy this process's result from tmp_results to recvbuf */
mpi_errno = MPIR_Localcopy((char *)tmp_results +
disps[rank]*extent,
recvcount, datatype, recvbuf,
recvcount, datatype);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
}
/* If successful, error_code is set to MPI_SUCCESS. Otherwise an error
* code is created and returned in error_code.
*/
static void ADIOI_Exch_and_write(ADIO_File fd, void *buf, MPI_Datatype
datatype, int nprocs,
int myrank,
ADIOI_Access
* others_req, ADIO_Offset * offset_list,
ADIO_Offset * len_list, int contig_access_count,
ADIO_Offset min_st_offset, ADIO_Offset fd_size,
ADIO_Offset * fd_start, ADIO_Offset * fd_end,
MPI_Aint * buf_idx, int *error_code)
{
/* Send data to appropriate processes and write in sizes of no more
than coll_bufsize.
The idea is to reduce the amount of extra memory required for
collective I/O. If all data were written all at once, which is much
easier, it would require temp space more than the size of user_buf,
which is often unacceptable. For example, to write a distributed
array to a file, where each local array is 8Mbytes, requiring
at least another 8Mbytes of temp space is unacceptable. */
/* Not convinced end_loc-st_loc couldn't be > int, so make these offsets */
ADIO_Offset size = 0;
int hole, i, j, m, ntimes, max_ntimes, buftype_is_contig;
ADIO_Offset st_loc = -1, end_loc = -1, off, done, req_off;
char *write_buf = NULL;
int *curr_offlen_ptr, *count, *send_size, req_len, *recv_size;
int *partial_recv, *sent_to_proc, *start_pos, flag;
int *send_buf_idx, *curr_to_proc, *done_to_proc;
MPI_Status status;
ADIOI_Flatlist_node *flat_buf = NULL;
MPI_Aint buftype_extent;
int info_flag, coll_bufsize;
char *value;
static char myname[] = "ADIOI_EXCH_AND_WRITE";
*error_code = MPI_SUCCESS; /* changed below if error */
/* only I/O errors are currently reported */
/* calculate the number of writes of size coll_bufsize
to be done by each process and the max among all processes.
That gives the no. of communication phases as well. */
value = (char *) ADIOI_Malloc((MPI_MAX_INFO_VAL + 1) * sizeof(char));
ADIOI_Info_get(fd->info, "cb_buffer_size", MPI_MAX_INFO_VAL, value, &info_flag);
coll_bufsize = atoi(value);
ADIOI_Free(value);
for (i = 0; i < nprocs; i++) {
if (others_req[i].count) {
st_loc = others_req[i].offsets[0];
end_loc = others_req[i].offsets[0];
break;
}
}
for (i = 0; i < nprocs; i++)
for (j = 0; j < others_req[i].count; j++) {
st_loc = MPL_MIN(st_loc, others_req[i].offsets[j]);
end_loc = MPL_MAX(end_loc, (others_req[i].offsets[j]
+ others_req[i].lens[j] - 1));
}
/* ntimes=ceiling_div(end_loc - st_loc + 1, coll_bufsize)*/
ntimes = (int) ((end_loc - st_loc + coll_bufsize) / coll_bufsize);
if ((st_loc == -1) && (end_loc == -1)) {
ntimes = 0; /* this process does no writing. */
}
MPI_Allreduce(&ntimes, &max_ntimes, 1, MPI_INT, MPI_MAX, fd->comm);
write_buf = fd->io_buf;
curr_offlen_ptr = (int *) ADIOI_Calloc(nprocs * 10, sizeof(int));
/* its use is explained below. calloc initializes to 0. */
count = curr_offlen_ptr + nprocs;
/* to store count of how many off-len pairs per proc are satisfied
* in an iteration. */
partial_recv = count + nprocs;
/* if only a portion of the last off-len pair is recd. from a process
* in a particular iteration, the length recd. is stored here.
* calloc initializes to 0. */
send_size = partial_recv + nprocs;
/* total size of data to be sent to each proc. in an iteration.
* Of size nprocs so that I can use MPI_Alltoall later. */
recv_size = send_size + nprocs;
/* total size of data to be recd. from each proc. in an iteration. */
sent_to_proc = recv_size + nprocs;
/* amount of data sent to each proc so far. Used in
* ADIOI_Fill_send_buffer. initialized to 0 here. */
send_buf_idx = sent_to_proc + nprocs;
curr_to_proc = send_buf_idx + nprocs;
done_to_proc = curr_to_proc + nprocs;
/* Above three are used in ADIOI_Fill_send_buffer */
start_pos = done_to_proc + nprocs;
/* used to store the starting value of curr_offlen_ptr[i] in
* this iteration */
ADIOI_Datatype_iscontig(datatype, &buftype_is_contig);
if (!buftype_is_contig) {
flat_buf = ADIOI_Flatten_and_find(datatype);
}
MPI_Type_extent(datatype, &buftype_extent);
/* I need to check if there are any outstanding nonblocking writes to
the file, which could potentially interfere with the writes taking
place in this collective write call. Since this is not likely to be
common, let me do the simplest thing possible here: Each process
completes all pending nonblocking operations before completing. */
/*ADIOI_Complete_async(error_code);
* if (*error_code != MPI_SUCCESS) return;
* MPI_Barrier(fd->comm);
*/
done = 0;
off = st_loc;
for (m = 0; m < ntimes; m++) {
/* go through all others_req and check which will be satisfied
* by the current write */
/* Note that MPI guarantees that displacements in filetypes are in
* monotonically nondecreasing order and that, for writes, the
* filetypes cannot specify overlapping regions in the file. This
* simplifies implementation a bit compared to reads. */
/* off = start offset in the file for the data to be written in
* this iteration
* size = size of data written (bytes) corresponding to off
* req_off = off in file for a particular contiguous request
* minus what was satisfied in previous iteration
* req_size = size corresponding to req_off */
/* first calculate what should be communicated */
for (i = 0; i < nprocs; i++)
count[i] = recv_size[i] = 0;
size = MPL_MIN((unsigned) coll_bufsize, end_loc - st_loc + 1 - done);
for (i = 0; i < nprocs; i++) {
if (others_req[i].count) {
start_pos[i] = curr_offlen_ptr[i];
for (j = curr_offlen_ptr[i]; j < others_req[i].count; j++) {
if (partial_recv[i]) {
/* this request may have been partially
* satisfied in the previous iteration. */
req_off = others_req[i].offsets[j] + partial_recv[i];
req_len = others_req[i].lens[j] - partial_recv[i];
partial_recv[i] = 0;
/* modify the off-len pair to reflect this change */
others_req[i].offsets[j] = req_off;
others_req[i].lens[j] = req_len;
} else {
req_off = others_req[i].offsets[j];
req_len = others_req[i].lens[j];
}
if (req_off < off + size) {
count[i]++;
ADIOI_Assert((((ADIO_Offset) (uintptr_t) write_buf) + req_off - off) ==
(ADIO_Offset) (uintptr_t) (write_buf + req_off - off));
MPI_Address(write_buf + req_off - off, &(others_req[i].mem_ptrs[j]));
ADIOI_Assert((off + size - req_off) == (int) (off + size - req_off));
recv_size[i] += (int) (MPL_MIN(off + size - req_off, (unsigned) req_len));
if (off + size - req_off < (unsigned) req_len) {
partial_recv[i] = (int) (off + size - req_off);
/* --BEGIN ERROR HANDLING-- */
if ((j + 1 < others_req[i].count) &&
(others_req[i].offsets[j + 1] < off + size)) {
*error_code = MPIO_Err_create_code(MPI_SUCCESS,
MPIR_ERR_RECOVERABLE,
myname,
__LINE__,
MPI_ERR_ARG,
"Filetype specifies overlapping write regions (which is illegal according to the MPI-2 specification)",
0);
/* allow to continue since additional
* communication might have to occur
*/
}
/* --END ERROR HANDLING-- */
break;
}
} else
break;
}
curr_offlen_ptr[i] = j;
}
}
ADIOI_W_Exchange_data(fd, buf, write_buf, flat_buf, offset_list,
len_list, send_size, recv_size, off, size, count,
start_pos, partial_recv,
sent_to_proc, nprocs, myrank,
buftype_is_contig, contig_access_count,
min_st_offset, fd_size, fd_start, fd_end,
others_req, send_buf_idx, curr_to_proc,
done_to_proc, &hole, m, buftype_extent, buf_idx, error_code);
if (*error_code != MPI_SUCCESS)
return;
flag = 0;
for (i = 0; i < nprocs; i++)
if (count[i])
flag = 1;
if (flag) {
ADIOI_Assert(size == (int) size);
ADIO_WriteContig(fd, write_buf, (int) size, MPI_BYTE, ADIO_EXPLICIT_OFFSET,
off, &status, error_code);
if (*error_code != MPI_SUCCESS)
return;
}
off += size;
done += size;
}
for (i = 0; i < nprocs; i++)
count[i] = recv_size[i] = 0;
for (m = ntimes; m < max_ntimes; m++) {
ADIOI_Assert(size == (int) size);
/* nothing to recv, but check for send. */
ADIOI_W_Exchange_data(fd, buf, write_buf, flat_buf, offset_list,
len_list, send_size, recv_size, off, (int) size, count,
start_pos, partial_recv,
sent_to_proc, nprocs, myrank,
buftype_is_contig, contig_access_count,
min_st_offset, fd_size, fd_start, fd_end,
others_req, send_buf_idx,
curr_to_proc, done_to_proc, &hole, m,
buftype_extent, buf_idx, error_code);
if (*error_code != MPI_SUCCESS)
return;
}
ADIOI_Free(curr_offlen_ptr);
}
static int MPIR_Scan_generic (
const void *sendbuf,
void *recvbuf,
int count,
MPI_Datatype datatype,
MPI_Op op,
MPID_Comm *comm_ptr,
MPIR_Errflag_t *errflag )
{
MPI_Status status;
int rank, comm_size;
int mpi_errno = MPI_SUCCESS;
int mpi_errno_ret = MPI_SUCCESS;
int mask, dst, is_commutative;
MPI_Aint true_extent, true_lb, extent;
void *partial_scan, *tmp_buf;
MPID_Op *op_ptr;
MPIU_CHKLMEM_DECL(2);
if (count == 0) return MPI_SUCCESS;
/* check if multiple threads are calling this collective function */
MPIDU_ERR_CHECK_MULTIPLE_THREADS_ENTER( comm_ptr );
comm_size = comm_ptr->local_size;
rank = comm_ptr->rank;
/* set op_errno to 0. stored in perthread structure */
{
MPIR_Per_thread_t *per_thread = NULL;
int err = 0;
MPID_THREADPRIV_KEY_GET_ADDR(MPIR_ThreadInfo.isThreaded, MPIR_Per_thread_key,
MPIR_Per_thread, per_thread, &err);
MPIU_Assert(err == 0);
per_thread->op_errno = 0;
}
if (HANDLE_GET_KIND(op) == HANDLE_KIND_BUILTIN) {
is_commutative = 1;
}
else {
MPID_Op_get_ptr(op, op_ptr);
if (op_ptr->kind == MPID_OP_USER_NONCOMMUTE)
is_commutative = 0;
else
is_commutative = 1;
}
/* need to allocate temporary buffer to store partial scan*/
MPIR_Type_get_true_extent_impl(datatype, &true_lb, &true_extent);
MPID_Datatype_get_extent_macro(datatype, extent);
MPIU_CHKLMEM_MALLOC(partial_scan, void *, count*(MPL_MAX(extent,true_extent)), mpi_errno, "partial_scan");
/* This eventually gets malloc()ed as a temp buffer, not added to
* any user buffers */
MPIU_Ensure_Aint_fits_in_pointer(count * MPL_MAX(extent, true_extent));
/* adjust for potential negative lower bound in datatype */
partial_scan = (void *)((char*)partial_scan - true_lb);
/* need to allocate temporary buffer to store incoming data*/
MPIU_CHKLMEM_MALLOC(tmp_buf, void *, count*(MPL_MAX(extent,true_extent)), mpi_errno, "tmp_buf");
/* adjust for potential negative lower bound in datatype */
tmp_buf = (void *)((char*)tmp_buf - true_lb);
/* Since this is an inclusive scan, copy local contribution into
recvbuf. */
if (sendbuf != MPI_IN_PLACE) {
mpi_errno = MPIR_Localcopy(sendbuf, count, datatype,
recvbuf, count, datatype);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
}
if (sendbuf != MPI_IN_PLACE)
mpi_errno = MPIR_Localcopy(sendbuf, count, datatype,
partial_scan, count, datatype);
else
mpi_errno = MPIR_Localcopy(recvbuf, count, datatype,
partial_scan, count, datatype);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
mask = 0x1;
while (mask < comm_size) {
dst = rank ^ mask;
if (dst < comm_size) {
/* Send partial_scan to dst. Recv into tmp_buf */
mpi_errno = MPIC_Sendrecv(partial_scan, count, datatype,
dst, MPIR_SCAN_TAG, tmp_buf,
count, datatype, dst,
MPIR_SCAN_TAG, comm_ptr,
&status, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag = MPIR_ERR_GET_CLASS(mpi_errno);
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
if (rank > dst) {
mpi_errno = MPIR_Reduce_local_impl(
tmp_buf, partial_scan, count, datatype, op);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIR_Reduce_local_impl(
tmp_buf, recvbuf, count, datatype, op);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
}
else {
if (is_commutative) {
mpi_errno = MPIR_Reduce_local_impl(
tmp_buf, partial_scan, count, datatype, op);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
}
else {
mpi_errno = MPIR_Reduce_local_impl(
partial_scan, tmp_buf, count, datatype, op);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIR_Localcopy(tmp_buf, count, datatype,
partial_scan,
count, datatype);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
}
}
}
mask <<= 1;
}
{
MPIR_Per_thread_t *per_thread = NULL;
int err = 0;
MPID_THREADPRIV_KEY_GET_ADDR(MPIR_ThreadInfo.isThreaded, MPIR_Per_thread_key,
MPIR_Per_thread, per_thread, &err);
MPIU_Assert(err == 0);
if (per_thread->op_errno) {
mpi_errno = per_thread->op_errno;
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
}
}
fn_exit:
MPIU_CHKLMEM_FREEALL();
/* check if multiple threads are calling this collective function */
MPIDU_ERR_CHECK_MULTIPLE_THREADS_EXIT( comm_ptr );
if (mpi_errno_ret)
mpi_errno = mpi_errno_ret;
else if (*errflag != MPIR_ERR_NONE)
MPIR_ERR_SET(mpi_errno, *errflag, "**coll_fail");
return mpi_errno;
fn_fail:
goto fn_exit;
}
int MPIR_Ireduce_scatter_sched_intra_recursive_doubling(const void *sendbuf, void *recvbuf, const int recvcounts[],
MPI_Datatype datatype, MPI_Op op, MPIR_Comm *comm_ptr,
MPIR_Sched_t s)
{
int mpi_errno = MPI_SUCCESS;
int rank, comm_size, i;
MPI_Aint extent, true_extent, true_lb;
int *disps;
void *tmp_recvbuf, *tmp_results;
int type_size ATTRIBUTE((unused)), dis[2], blklens[2], total_count, dst;
int mask, dst_tree_root, my_tree_root, j, k;
int received;
MPI_Datatype sendtype, recvtype;
int nprocs_completed, tmp_mask, tree_root, is_commutative;
MPIR_SCHED_CHKPMEM_DECL(5);
comm_size = comm_ptr->local_size;
rank = comm_ptr->rank;
MPIR_Datatype_get_extent_macro(datatype, extent);
MPIR_Type_get_true_extent_impl(datatype, &true_lb, &true_extent);
is_commutative = MPIR_Op_is_commutative(op);
MPIR_SCHED_CHKPMEM_MALLOC(disps, int *, comm_size * sizeof(int), mpi_errno, "disps", MPL_MEM_BUFFER);
total_count = 0;
for (i=0; i<comm_size; i++) {
disps[i] = total_count;
total_count += recvcounts[i];
}
if (total_count == 0) {
goto fn_exit;
}
MPIR_Datatype_get_size_macro(datatype, type_size);
/* total_count*extent eventually gets malloced. it isn't added to
* a user-passed in buffer */
MPIR_Ensure_Aint_fits_in_pointer(total_count * MPL_MAX(true_extent, extent));
/* need to allocate temporary buffer to receive incoming data*/
MPIR_SCHED_CHKPMEM_MALLOC(tmp_recvbuf, void *, total_count*(MPL_MAX(true_extent,extent)), mpi_errno, "tmp_recvbuf", MPL_MEM_BUFFER);
/* adjust for potential negative lower bound in datatype */
tmp_recvbuf = (void *)((char*)tmp_recvbuf - true_lb);
/* need to allocate another temporary buffer to accumulate
results */
MPIR_SCHED_CHKPMEM_MALLOC(tmp_results, void *, total_count*(MPL_MAX(true_extent,extent)), mpi_errno, "tmp_results", MPL_MEM_BUFFER);
/* adjust for potential negative lower bound in datatype */
tmp_results = (void *)((char*)tmp_results - true_lb);
/* copy sendbuf into tmp_results */
if (sendbuf != MPI_IN_PLACE)
mpi_errno = MPIR_Sched_copy(sendbuf, total_count, datatype,
tmp_results, total_count, datatype, s);
else
mpi_errno = MPIR_Sched_copy(recvbuf, total_count, datatype,
tmp_results, total_count, datatype, s);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
mask = 0x1;
i = 0;
while (mask < comm_size) {
dst = rank ^ mask;
dst_tree_root = dst >> i;
dst_tree_root <<= i;
my_tree_root = rank >> i;
my_tree_root <<= i;
/* At step 1, processes exchange (n-n/p) amount of
data; at step 2, (n-2n/p) amount of data; at step 3, (n-4n/p)
amount of data, and so forth. We use derived datatypes for this.
At each step, a process does not need to send data
indexed from my_tree_root to
my_tree_root+mask-1. Similarly, a process won't receive
data indexed from dst_tree_root to dst_tree_root+mask-1. */
/* calculate sendtype */
blklens[0] = blklens[1] = 0;
for (j=0; j<my_tree_root; j++)
blklens[0] += recvcounts[j];
for (j=my_tree_root+mask; j<comm_size; j++)
blklens[1] += recvcounts[j];
dis[0] = 0;
dis[1] = blklens[0];
for (j=my_tree_root; (j<my_tree_root+mask) && (j<comm_size); j++)
dis[1] += recvcounts[j];
mpi_errno = MPIR_Type_indexed_impl(2, blklens, dis, datatype, &sendtype);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIR_Type_commit_impl(&sendtype);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
/* calculate recvtype */
blklens[0] = blklens[1] = 0;
for (j=0; j<dst_tree_root && j<comm_size; j++)
blklens[0] += recvcounts[j];
for (j=dst_tree_root+mask; j<comm_size; j++)
blklens[1] += recvcounts[j];
dis[0] = 0;
dis[1] = blklens[0];
for (j=dst_tree_root; (j<dst_tree_root+mask) && (j<comm_size); j++)
dis[1] += recvcounts[j];
mpi_errno = MPIR_Type_indexed_impl(2, blklens, dis, datatype, &recvtype);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIR_Type_commit_impl(&recvtype);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
received = 0;
if (dst < comm_size) {
/* tmp_results contains data to be sent in each step. Data is
received in tmp_recvbuf and then accumulated into
tmp_results. accumulation is done later below. */
mpi_errno = MPIR_Sched_send(tmp_results, 1, sendtype, dst, comm_ptr, s);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIR_Sched_recv(tmp_recvbuf, 1, recvtype, dst, comm_ptr, s);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
received = 1;
}
/* if some processes in this process's subtree in this step
did not have any destination process to communicate with
because of non-power-of-two, we need to send them the
result. We use a logarithmic recursive-halfing algorithm
for this. */
if (dst_tree_root + mask > comm_size) {
nprocs_completed = comm_size - my_tree_root - mask;
/* nprocs_completed is the number of processes in this
subtree that have all the data. Send data to others
in a tree fashion. First find root of current tree
that is being divided into two. k is the number of
least-significant bits in this process's rank that
must be zeroed out to find the rank of the root */
j = mask;
k = 0;
while (j) {
j >>= 1;
k++;
}
k--;
tmp_mask = mask >> 1;
while (tmp_mask) {
dst = rank ^ tmp_mask;
tree_root = rank >> k;
tree_root <<= k;
/* send only if this proc has data and destination
doesn't have data. at any step, multiple processes
can send if they have the data */
if ((dst > rank) &&
(rank < tree_root + nprocs_completed)
&& (dst >= tree_root + nprocs_completed))
{
/* send the current result */
mpi_errno = MPIR_Sched_send(tmp_recvbuf, 1, recvtype, dst, comm_ptr, s);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
}
/* recv only if this proc. doesn't have data and sender
has data */
else if ((dst < rank) &&
(dst < tree_root + nprocs_completed) &&
(rank >= tree_root + nprocs_completed))
{
mpi_errno = MPIR_Sched_recv(tmp_recvbuf, 1, recvtype, dst, comm_ptr, s);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
received = 1;
}
tmp_mask >>= 1;
k--;
}
}
/* N.B. The following comment comes from the FT version of
* MPI_Reduce_scatter. It does not currently apply to this code, but
* will in the future when we update the NBC code to be fault-tolerant
* in roughly the same fashion. [goodell@ 2011-03-03] */
/* The following reduction is done here instead of after
the MPIC_Sendrecv or MPIC_Recv above. This is
because to do it above, in the noncommutative
case, we would need an extra temp buffer so as not to
overwrite temp_recvbuf, because temp_recvbuf may have
to be communicated to other processes in the
non-power-of-two case. To avoid that extra allocation,
we do the reduce here. */
if (received) {
if (is_commutative || (dst_tree_root < my_tree_root)) {
mpi_errno = MPIR_Sched_reduce(tmp_recvbuf, tmp_results, blklens[0], datatype, op, s);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIR_Sched_reduce(((char *)tmp_recvbuf + dis[1]*extent),
((char *)tmp_results + dis[1]*extent),
blklens[1], datatype, op, s);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
}
else {
mpi_errno = MPIR_Sched_reduce(tmp_results, tmp_recvbuf, blklens[0], datatype, op, s);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIR_Sched_reduce(((char *)tmp_results + dis[1]*extent),
((char *)tmp_recvbuf + dis[1]*extent),
blklens[1], datatype, op, s);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
/* copy result back into tmp_results */
mpi_errno = MPIR_Sched_copy(tmp_recvbuf, 1, recvtype,
tmp_results, 1, recvtype, s);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
}
}
MPIR_Type_free_impl(&sendtype);
MPIR_Type_free_impl(&recvtype);
mask <<= 1;
i++;
}
int MPIR_Iallreduce_sched_intra_reduce_scatter_allgather(const void *sendbuf, void *recvbuf,
int count, MPI_Datatype datatype,
MPI_Op op, MPIR_Comm * comm_ptr,
MPIR_Sched_t s)
{
int mpi_errno = MPI_SUCCESS;
int comm_size, rank, newrank, pof2, rem;
int i, send_idx, recv_idx, last_idx, mask, newdst, dst, send_cnt, recv_cnt;
MPI_Aint true_lb, true_extent, extent;
void *tmp_buf = NULL;
int *cnts, *disps;
MPIR_SCHED_CHKPMEM_DECL(1);
MPIR_CHKLMEM_DECL(2);
#ifdef HAVE_ERROR_CHECKING
/* we only support builtin datatypes for now, breaking up user types to do
* the reduce-scatter is tricky */
MPIR_Assert(HANDLE_GET_KIND(op) == HANDLE_KIND_BUILTIN);
#endif
comm_size = comm_ptr->local_size;
rank = comm_ptr->rank;
/* need to allocate temporary buffer to store incoming data */
MPIR_Type_get_true_extent_impl(datatype, &true_lb, &true_extent);
MPIR_Datatype_get_extent_macro(datatype, extent);
MPIR_Ensure_Aint_fits_in_pointer(count * MPL_MAX(extent, true_extent));
MPIR_SCHED_CHKPMEM_MALLOC(tmp_buf, void *, count * (MPL_MAX(extent, true_extent)), mpi_errno,
"temporary buffer", MPL_MEM_BUFFER);
/* adjust for potential negative lower bound in datatype */
tmp_buf = (void *) ((char *) tmp_buf - true_lb);
/* copy local data into recvbuf */
if (sendbuf != MPI_IN_PLACE) {
mpi_errno = MPIR_Sched_copy(sendbuf, count, datatype, recvbuf, count, datatype, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
}
/* get nearest power-of-two less than or equal to comm_size */
pof2 = comm_ptr->pof2;
rem = comm_size - pof2;
/* In the non-power-of-two case, all even-numbered
* processes of rank < 2*rem send their data to
* (rank+1). These even-numbered processes no longer
* participate in the algorithm until the very end. The
* remaining processes form a nice power-of-two. */
if (rank < 2 * rem) {
if (rank % 2 == 0) { /* even */
mpi_errno = MPIR_Sched_send(recvbuf, count, datatype, rank + 1, comm_ptr, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
/* temporarily set the rank to -1 so that this
* process does not pariticipate in recursive
* doubling */
newrank = -1;
} else { /* odd */
mpi_errno = MPIR_Sched_recv(tmp_buf, count, datatype, rank - 1, comm_ptr, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
/* do the reduction on received data. since the
* ordering is right, it doesn't matter whether
* the operation is commutative or not. */
mpi_errno = MPIR_Sched_reduce(tmp_buf, recvbuf, count, datatype, op, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
/* change the rank */
newrank = rank / 2;
}
} else /* rank >= 2*rem */
newrank = rank - rem;
if (newrank != -1) {
/* for the reduce-scatter, calculate the count that
* each process receives and the displacement within
* the buffer */
/* TODO I (goodell@) believe that these counts and displacements could be
* calculated directly during the loop, rather than requiring a less-scalable
* "2*pof2"-sized memory allocation */
MPIR_CHKLMEM_MALLOC(cnts, int *, pof2 * sizeof(int), mpi_errno, "counts", MPL_MEM_BUFFER);
MPIR_CHKLMEM_MALLOC(disps, int *, pof2 * sizeof(int), mpi_errno, "displacements",
MPL_MEM_BUFFER);
MPIR_Assert(count >= pof2); /* the cnts calculations assume this */
for (i = 0; i < (pof2 - 1); i++)
cnts[i] = count / pof2;
cnts[pof2 - 1] = count - (count / pof2) * (pof2 - 1);
if (pof2)
disps[0] = 0;
for (i = 1; i < pof2; i++)
disps[i] = disps[i - 1] + cnts[i - 1];
mask = 0x1;
send_idx = recv_idx = 0;
last_idx = pof2;
while (mask < pof2) {
newdst = newrank ^ mask;
/* find real rank of dest */
dst = (newdst < rem) ? newdst * 2 + 1 : newdst + rem;
send_cnt = recv_cnt = 0;
if (newrank < newdst) {
send_idx = recv_idx + pof2 / (mask * 2);
for (i = send_idx; i < last_idx; i++)
send_cnt += cnts[i];
for (i = recv_idx; i < send_idx; i++)
recv_cnt += cnts[i];
} else {
recv_idx = send_idx + pof2 / (mask * 2);
for (i = send_idx; i < recv_idx; i++)
send_cnt += cnts[i];
for (i = recv_idx; i < last_idx; i++)
recv_cnt += cnts[i];
}
/* Send data from recvbuf. Recv into tmp_buf */
mpi_errno = MPIR_Sched_recv(((char *) tmp_buf + disps[recv_idx] * extent),
recv_cnt, datatype, dst, comm_ptr, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* sendrecv, no barrier here */
mpi_errno = MPIR_Sched_send(((char *) recvbuf + disps[send_idx] * extent),
send_cnt, datatype, dst, comm_ptr, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
/* tmp_buf contains data received in this step.
* recvbuf contains data accumulated so far */
/* This algorithm is used only for predefined ops
* and predefined ops are always commutative. */
mpi_errno = MPIR_Sched_reduce(((char *) tmp_buf + disps[recv_idx] * extent),
((char *) recvbuf + disps[recv_idx] * extent),
recv_cnt, datatype, op, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
/* update send_idx for next iteration */
send_idx = recv_idx;
mask <<= 1;
/* update last_idx, but not in last iteration
* because the value is needed in the allgather
* step below. */
if (mask < pof2)
last_idx = recv_idx + pof2 / mask;
}
/* now do the allgather */
mask >>= 1;
while (mask > 0) {
newdst = newrank ^ mask;
/* find real rank of dest */
dst = (newdst < rem) ? newdst * 2 + 1 : newdst + rem;
send_cnt = recv_cnt = 0;
if (newrank < newdst) {
/* update last_idx except on first iteration */
if (mask != pof2 / 2)
last_idx = last_idx + pof2 / (mask * 2);
recv_idx = send_idx + pof2 / (mask * 2);
for (i = send_idx; i < recv_idx; i++)
send_cnt += cnts[i];
for (i = recv_idx; i < last_idx; i++)
recv_cnt += cnts[i];
} else {
recv_idx = send_idx - pof2 / (mask * 2);
for (i = send_idx; i < last_idx; i++)
send_cnt += cnts[i];
for (i = recv_idx; i < send_idx; i++)
recv_cnt += cnts[i];
}
mpi_errno = MPIR_Sched_recv(((char *) recvbuf + disps[recv_idx] * extent),
recv_cnt, datatype, dst, comm_ptr, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* sendrecv, no barrier here */
mpi_errno = MPIR_Sched_send(((char *) recvbuf + disps[send_idx] * extent),
send_cnt, datatype, dst, comm_ptr, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
if (newrank > newdst)
send_idx = recv_idx;
mask >>= 1;
}
}
/* This function produces topology aware trees for reduction and broadcasts, with different
* K values. This is a heavy-weight function as it allocates shared memory, generates topology
* information, builds a package-level tree (for package leaders), and a per-package tree.
* These are combined in shared memory for other ranks to read out from.
* */
int MPIDI_SHM_topology_tree_init(MPIR_Comm * comm_ptr, int root, int bcast_k,
MPIR_Treealgo_tree_t * bcast_tree, int *bcast_topotree_fail,
int reduce_k, MPIR_Treealgo_tree_t * reduce_tree,
int *reduce_topotree_fail, MPIR_Errflag_t * errflag)
{
int *shared_region;
MPL_shm_hnd_t fd;
int num_ranks, rank;
int mpi_errno = MPI_SUCCESS, mpi_errno_ret = MPI_SUCCESS;
size_t shm_size;
int **bind_map = NULL;
int *max_entries_per_level = NULL;
int **ranks_per_package = NULL;
int *package_ctr = NULL;
size_t topo_depth = 0;
int package_level = 0, i, max_ranks_per_package = 0;
bool mapfail_flag = false;
MPIR_FUNC_VERBOSE_STATE_DECL(MPID_STATE_SHM_TOPOLOGY_TREE_INIT);
MPIR_FUNC_VERBOSE_ENTER(MPID_STATE_SHM_TOPOLOGY_TREE_INIT);
num_ranks = MPIR_Comm_size(comm_ptr);
rank = MPIR_Comm_rank(comm_ptr);
/* Calculate the size of shared memory that would be needed */
shm_size = sizeof(int) * 5 * num_ranks + num_ranks * sizeof(cpu_set_t);
/* STEP 1. Create shared memory region for exchanging topology information (root only) */
mpi_errno = MPIDIU_allocate_shm_segment(comm_ptr, shm_size, &fd, (void **) &shared_region,
&mapfail_flag);
if (mpi_errno || mapfail_flag) {
/* for communication errors, just record the error but continue */
*errflag =
MPIX_ERR_PROC_FAILED ==
MPIR_ERR_GET_CLASS(mpi_errno) ? MPIR_ERR_PROC_FAILED : MPIR_ERR_OTHER;
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
/* STEP 2. Collect cpu_sets for each rank at the root */
cpu_set_t my_cpu_set;
CPU_ZERO(&my_cpu_set);
sched_getaffinity(0, sizeof(my_cpu_set), &my_cpu_set);
((cpu_set_t *) (shared_region))[rank] = my_cpu_set;
mpi_errno = MPIR_Barrier_impl(comm_ptr, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag =
MPIX_ERR_PROC_FAILED ==
MPIR_ERR_GET_CLASS(mpi_errno) ? MPIR_ERR_PROC_FAILED : MPIR_ERR_OTHER;
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
/* STEP 3. Root has all the cpu_set information, now build tree */
if (rank == root) {
topo_depth = hwloc_topology_get_depth(MPIR_Process.hwloc_topology);
bind_map = (int **) MPL_malloc(num_ranks * sizeof(int *), MPL_MEM_OTHER);
MPIR_ERR_CHKANDJUMP(!bind_map, mpi_errno, MPI_ERR_OTHER, "**nomem");
for (i = 0; i < num_ranks; ++i) {
bind_map[i] = (int *) MPL_calloc(topo_depth, sizeof(int), MPL_MEM_OTHER);
MPIR_ERR_CHKANDJUMP(!bind_map[i], mpi_errno, MPI_ERR_OTHER, "**nomem");
}
MPIDI_SHM_hwloc_init_bindmap(num_ranks, topo_depth, shared_region, bind_map);
/* Done building the topology information */
/* STEP 3.1. Count the maximum entries at each level - used for breaking the tree into
* intra/inter socket */
max_entries_per_level = (int *) MPL_calloc(topo_depth, sizeof(size_t), MPL_MEM_OTHER);
MPIR_ERR_CHKANDJUMP(!max_entries_per_level, mpi_errno, MPI_ERR_OTHER, "**nomem");
package_level =
MPIDI_SHM_topotree_get_package_level(topo_depth, max_entries_per_level, num_ranks,
bind_map);
if (MPIDI_SHM_TOPOTREE_DEBUG)
fprintf(stderr, "Breaking topology at :: %d (default= %d)\n", package_level,
MPIDI_SHM_TOPOTREE_CUTOFF);
/* STEP 3.2. allocate space for the entries that go in each package based on hwloc info */
ranks_per_package =
(int
**) MPL_malloc(max_entries_per_level[package_level] * sizeof(int *), MPL_MEM_OTHER);
MPIR_ERR_CHKANDJUMP(!ranks_per_package, mpi_errno, MPI_ERR_OTHER, "**nomem");
package_ctr =
(int *) MPL_calloc(max_entries_per_level[package_level], sizeof(int), MPL_MEM_OTHER);
MPIR_ERR_CHKANDJUMP(!package_ctr, mpi_errno, MPI_ERR_OTHER, "**nomem");
for (i = 0; i < max_entries_per_level[package_level]; ++i) {
package_ctr[i] = 0;
ranks_per_package[i] = (int *) MPL_calloc(num_ranks, sizeof(int), MPL_MEM_OTHER);
MPIR_ERR_CHKANDJUMP(!ranks_per_package[i], mpi_errno, MPI_ERR_OTHER, "**nomem");
}
/* sort the ranks into packages based on the binding information */
for (i = 0; i < num_ranks; ++i) {
int package = bind_map[i][package_level];
ranks_per_package[package][package_ctr[package]++] = i;
}
max_ranks_per_package = 0;
for (i = 0; i < max_entries_per_level[package_level]; ++i) {
max_ranks_per_package = MPL_MAX(max_ranks_per_package, package_ctr[i]);
}
/* At this point we have done the common work in extracting topology information
* and restructuring it to our needs. Now we generate the tree. */
/* For Bcast, package leaders are added before the package local ranks, and the per_package
* tree is left_skewed */
mpi_errno = MPIDI_SHM_gen_tree(bcast_k, shared_region, max_entries_per_level,
ranks_per_package, max_ranks_per_package, package_ctr,
package_level, num_ranks, 1 /*package_leaders_first */ ,
0 /*left_skewed */ , errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag =
MPIX_ERR_PROC_FAILED ==
MPIR_ERR_GET_CLASS(mpi_errno) ? MPIR_ERR_PROC_FAILED : MPIR_ERR_OTHER;
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
}
mpi_errno = MPIR_Barrier_impl(comm_ptr, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag =
MPIX_ERR_PROC_FAILED ==
MPIR_ERR_GET_CLASS(mpi_errno) ? MPIR_ERR_PROC_FAILED : MPIR_ERR_OTHER;
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
/* Every rank copies their tree out from shared memory */
MPIDI_SHM_copy_tree(shared_region, num_ranks, rank, bcast_tree, bcast_topotree_fail);
if (MPIDI_SHM_TOPOTREE_DEBUG)
MPIDI_SHM_print_topotree_file("BCAST", comm_ptr->context_id, rank, bcast_tree);
/* Wait until shared memory is available */
mpi_errno = MPIR_Barrier_impl(comm_ptr, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag =
MPIX_ERR_PROC_FAILED ==
MPIR_ERR_GET_CLASS(mpi_errno) ? MPIR_ERR_PROC_FAILED : MPIR_ERR_OTHER;
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
/* Generate the reduce tree */
/* For Reduce, package leaders are added after the package local ranks, and the per_package
* tree is right_skewed (children are added in the reverse order */
if (rank == root) {
memset(shared_region, 0, shm_size);
mpi_errno = MPIDI_SHM_gen_tree(reduce_k, shared_region, max_entries_per_level,
ranks_per_package, max_ranks_per_package, package_ctr,
package_level, num_ranks, 0 /*package_leaders_last */ ,
1 /*right_skewed */ , errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag =
MPIX_ERR_PROC_FAILED ==
MPIR_ERR_GET_CLASS(mpi_errno) ? MPIR_ERR_PROC_FAILED : MPIR_ERR_OTHER;
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
}
mpi_errno = MPIR_Barrier_impl(comm_ptr, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag =
MPIX_ERR_PROC_FAILED ==
MPIR_ERR_GET_CLASS(mpi_errno) ? MPIR_ERR_PROC_FAILED : MPIR_ERR_OTHER;
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
/* each rank copy the reduce tree out */
MPIDI_SHM_copy_tree(shared_region, num_ranks, rank, reduce_tree, reduce_topotree_fail);
if (MPIDI_SHM_TOPOTREE_DEBUG)
MPIDI_SHM_print_topotree_file("REDUCE", comm_ptr->context_id, rank, reduce_tree);
/* Wait for all ranks to copy out the tree */
mpi_errno = MPIR_Barrier_impl(comm_ptr, errflag);
if (mpi_errno) {
/* for communication errors, just record the error but continue */
*errflag =
MPIX_ERR_PROC_FAILED ==
MPIR_ERR_GET_CLASS(mpi_errno) ? MPIR_ERR_PROC_FAILED : MPIR_ERR_OTHER;
MPIR_ERR_SET(mpi_errno, *errflag, "**fail");
MPIR_ERR_ADD(mpi_errno_ret, mpi_errno);
}
/* Cleanup */
if (rank == root) {
for (i = 0; i < max_entries_per_level[package_level]; ++i) {
MPL_free(ranks_per_package[i]);
}
MPL_free(ranks_per_package);
MPL_free(package_ctr);
if (MPIDI_SHM_TOPOTREE_DEBUG)
for (i = 0; i < topo_depth; ++i) {
fprintf(stderr, "Level :: %d, Max :: %d\n", i, max_entries_per_level[i]);
}
for (i = 0; i < num_ranks; ++i) {
MPL_free(bind_map[i]);
}
MPL_free(max_entries_per_level);
MPL_free(bind_map);
}
MPIDIU_destroy_shm_segment(shm_size, &fd, (void **) &shared_region);
fn_exit:
if (rank == root && MPIDI_SHM_TOPOTREE_DEBUG)
fprintf(stderr, "Done creating tree for %d\n", num_ranks);
MPIR_FUNC_VERBOSE_EXIT(MPID_STATE_SHM_TOPOLOGY_TREE_INIT);
return mpi_errno;
fn_fail:
goto fn_exit;
}
int MPIR_Iallgatherv_sched_intra_recursive_doubling(const void *sendbuf, int sendcount,
MPI_Datatype sendtype, void *recvbuf,
const int recvcounts[], const int displs[],
MPI_Datatype recvtype, MPIR_Comm * comm_ptr,
MPIR_Sched_t s)
{
int mpi_errno = MPI_SUCCESS;
int comm_size, rank, i, j, k;
int curr_count, send_offset, incoming_count, recv_offset;
int mask, dst, total_count, position, offset, my_tree_root, dst_tree_root;
MPI_Aint recvtype_extent, recvtype_true_extent, recvtype_true_lb;
void *tmp_buf = NULL;
MPIR_SCHED_CHKPMEM_DECL(1);
comm_size = comm_ptr->local_size;
rank = comm_ptr->rank;
#ifdef HAVE_ERROR_CHECKING
/* Currently this algorithm can only handle power-of-2 comm_size.
* Non power-of-2 comm_size is still experimental */
MPIR_Assert(!(comm_size & (comm_size - 1)));
#endif /* HAVE_ERROR_CHECKING */
/* need to receive contiguously into tmp_buf because
* displs could make the recvbuf noncontiguous */
MPIR_Datatype_get_extent_macro(recvtype, recvtype_extent);
MPIR_Type_get_true_extent_impl(recvtype, &recvtype_true_lb, &recvtype_true_extent);
total_count = 0;
for (i = 0; i < comm_size; i++)
total_count += recvcounts[i];
if (total_count == 0)
goto fn_exit;
MPIR_Ensure_Aint_fits_in_pointer(total_count *
(MPL_MAX(recvtype_true_extent, recvtype_extent)));
MPIR_SCHED_CHKPMEM_MALLOC(tmp_buf, void *,
total_count * (MPL_MAX(recvtype_true_extent, recvtype_extent)),
mpi_errno, "tmp_buf", MPL_MEM_BUFFER);
/* adjust for potential negative lower bound in datatype */
tmp_buf = (void *) ((char *) tmp_buf - recvtype_true_lb);
/* copy local data into right location in tmp_buf */
position = 0;
for (i = 0; i < rank; i++)
position += recvcounts[i];
if (sendbuf != MPI_IN_PLACE) {
mpi_errno = MPIR_Sched_copy(sendbuf, sendcount, sendtype,
((char *) tmp_buf + position * recvtype_extent),
recvcounts[rank], recvtype, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
} else {
/* if in_place specified, local data is found in recvbuf */
mpi_errno = MPIR_Sched_copy(((char *) recvbuf + displs[rank] * recvtype_extent),
recvcounts[rank], recvtype,
((char *) tmp_buf + position * recvtype_extent),
recvcounts[rank], recvtype, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
}
curr_count = recvcounts[rank];
/* never used uninitialized w/o this, but compiler can't tell that */
incoming_count = -1;
/* [goodell@] random notes that help slightly when deciphering this code:
* - mask is also equal to the number of blocks that we are going to recv
* (less if comm_size is non-pof2)
* - FOO_tree_root is the leftmost (lowest ranked) process with whom FOO has
* communicated, directly or indirectly, at the beginning of round the
* round. FOO is either "dst" or "my", where "my" means use my rank.
* - in each round we are going to recv the blocks
* B[dst_tree_root],B[dst_tree_root+1],...,B[min(dst_tree_root+mask,comm_size)]
*/
mask = 0x1;
i = 0;
while (mask < comm_size) {
dst = rank ^ mask;
/* find offset into send and recv buffers. zero out
* the least significant "i" bits of rank and dst to
* find root of src and dst subtrees. Use ranks of
* roots as index to send from and recv into buffer */
dst_tree_root = dst >> i;
dst_tree_root <<= i;
my_tree_root = rank >> i;
my_tree_root <<= i;
if (dst < comm_size) {
send_offset = 0;
for (j = 0; j < my_tree_root; j++)
send_offset += recvcounts[j];
recv_offset = 0;
for (j = 0; j < dst_tree_root; j++)
recv_offset += recvcounts[j];
incoming_count = 0;
for (j = dst_tree_root; j < (dst_tree_root + mask) && j < comm_size; ++j)
incoming_count += recvcounts[j];
mpi_errno = MPIR_Sched_send(((char *) tmp_buf + send_offset * recvtype_extent),
curr_count, recvtype, dst, comm_ptr, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* sendrecv, no barrier here */
mpi_errno = MPIR_Sched_recv(((char *) tmp_buf + recv_offset * recvtype_extent),
incoming_count, recvtype, dst, comm_ptr, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
curr_count += incoming_count;
}
/* if some processes in this process's subtree in this step
* did not have any destination process to communicate with
* because of non-power-of-two, we need to send them the
* data that they would normally have received from those
* processes. That is, the haves in this subtree must send to
* the havenots. We use a logarithmic
* recursive-halfing algorithm for this. */
/* This part of the code will not currently be
* executed because we are not using recursive
* doubling for non power of two. Mark it as experimental
* so that it doesn't show up as red in the coverage
* tests. */
/* --BEGIN EXPERIMENTAL-- */
if (dst_tree_root + mask > comm_size) {
int tmp_mask, tree_root;
int nprocs_completed = comm_size - my_tree_root - mask;
/* nprocs_completed is the number of processes in this
* subtree that have all the data. Send data to others
* in a tree fashion. First find root of current tree
* that is being divided into two. k is the number of
* least-significant bits in this process's rank that
* must be zeroed out to find the rank of the root */
/* [goodell@] it looks like (k==i) is always true, could possibly
* skip the loop below */
j = mask;
k = 0;
while (j) {
j >>= 1;
k++;
}
k--;
tmp_mask = mask >> 1;
while (tmp_mask) {
dst = rank ^ tmp_mask;
tree_root = rank >> k;
tree_root <<= k;
/* send only if this proc has data and destination
* doesn't have data. at any step, multiple processes
* can send if they have the data */
if ((dst > rank) &&
(rank < tree_root + nprocs_completed) &&
(dst >= tree_root + nprocs_completed)) {
offset = 0;
for (j = 0; j < (my_tree_root + mask); j++)
offset += recvcounts[j];
offset *= recvtype_extent;
/* incoming_count was set in the previous
* receive. that's the amount of data to be
* sent now. */
mpi_errno = MPIR_Sched_send(((char *) tmp_buf + offset),
incoming_count, recvtype, dst, comm_ptr, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
}
/* recv only if this proc. doesn't have data and sender
* has data */
else if ((dst < rank) &&
(dst < tree_root + nprocs_completed) &&
(rank >= tree_root + nprocs_completed)) {
offset = 0;
for (j = 0; j < (my_tree_root + mask); j++)
offset += recvcounts[j];
/* recalculate incoming_count, since not all processes will have
* this value */
incoming_count = 0;
for (j = dst_tree_root; j < (dst_tree_root + mask) && j < comm_size; ++j)
incoming_count += recvcounts[j];
mpi_errno = MPIR_Sched_recv(((char *) tmp_buf + offset * recvtype_extent),
incoming_count, recvtype, dst, comm_ptr, s);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_SCHED_BARRIER(s);
curr_count += incoming_count;
}
tmp_mask >>= 1;
k--;
}
}
/* --END EXPERIMENTAL-- */
mask <<= 1;
i++;
}
