/*****************************************************************************
* Function: alltoall_ring
* Return: int
* Inputs:
send_buff: send input buffer
send_count: number of elements to send
send_type: data type of elements being sent
recv_buff: receive output buffer
recv_count: number of elements to received
recv_type: data type of elements being received
comm: communicator
* Descrp: Function works in P - 1 steps. In step i, node j - i -> j -> j + i.
* Auther: Ahmad Faraj
****************************************************************************/
int
smpi_coll_tuned_alltoall_ring(void *send_buff, int send_count,
MPI_Datatype send_type, void *recv_buff,
int recv_count, MPI_Datatype recv_type,
MPI_Comm comm)
{
MPI_Status s;
MPI_Aint send_chunk, recv_chunk;
int i, src, dst, rank, num_procs;
int tag = COLL_TAG_ALLTOALL;
char *send_ptr = (char *) send_buff;
char *recv_ptr = (char *) recv_buff;
rank = smpi_comm_rank(comm);
num_procs = smpi_comm_size(comm);
send_chunk = smpi_datatype_get_extent(send_type);
recv_chunk = smpi_datatype_get_extent(recv_type);
send_chunk *= send_count;
recv_chunk *= recv_count;
for (i = 0; i < num_procs; i++) {
src = (rank - i + num_procs) % num_procs;
dst = (rank + i) % num_procs;
smpi_mpi_sendrecv(send_ptr + dst * send_chunk, send_count, send_type, dst,
tag, recv_ptr + src * recv_chunk, recv_count, recv_type,
src, tag, comm, &s);
}
return MPI_SUCCESS;
}
/*****************************************************************************
* Function: alltoall_pair_mpi_barrier
* Return: int
* Inputs:
send_buff: send input buffer
send_count: number of elements to send
send_type: data type of elements being sent
recv_buff: receive output buffer
recv_count: number of elements to received
recv_type: data type of elements being received
comm: communicator
* Descrp: Function works when P is power of two. In each phase of P - 1
phases, nodes in pair communicate their data. MPI barriers are
inserted between each two phases.
* Auther: Ahmad Faraj
****************************************************************************/
int
smpi_coll_tuned_alltoallv_pair_mpi_barrier(void *send_buff, int *send_counts, int *send_disps,
MPI_Datatype send_type,
void *recv_buff, int *recv_counts, int *recv_disps,
MPI_Datatype recv_type, MPI_Comm comm)
{
MPI_Status s;
MPI_Aint send_chunk, recv_chunk;
int i, src, dst, rank, num_procs;
int tag = 101;
char *send_ptr = (char *) send_buff;
char *recv_ptr = (char *) recv_buff;
rank = smpi_comm_rank(comm);
num_procs = smpi_comm_size(comm);
send_chunk = smpi_datatype_get_extent(send_type);
recv_chunk = smpi_datatype_get_extent(recv_type);
for (i = 0; i < num_procs; i++) {
src = dst = rank ^ i;
smpi_mpi_barrier(comm);
smpi_mpi_sendrecv(send_ptr + send_disps[dst] * send_chunk, send_counts[dst], send_type, dst,
tag, recv_ptr + recv_disps[src] * recv_chunk, recv_counts[src], recv_type,
src, tag, comm, &s);
}
return MPI_SUCCESS;
}
// Allgather-Non-Topoloty-Scecific-Logical-Ring algorithm
int
smpi_coll_tuned_allgather_NTSLR_NB(void *sbuf, int scount, MPI_Datatype stype,
void *rbuf, int rcount, MPI_Datatype rtype,
MPI_Comm comm)
{
MPI_Aint rextent, sextent;
MPI_Status status, status2;
int i, to, from, rank, size;
int send_offset, recv_offset;
int tag = COLL_TAG_ALLGATHER;
rank = smpi_comm_rank(comm);
size = smpi_comm_size(comm);
rextent = smpi_datatype_get_extent(rtype);
sextent = smpi_datatype_get_extent(stype);
MPI_Request *rrequest_array;
MPI_Request *srequest_array;
rrequest_array = (MPI_Request *) xbt_malloc(size * sizeof(MPI_Request));
srequest_array = (MPI_Request *) xbt_malloc(size * sizeof(MPI_Request));
// irregular case use default MPI fucntions
if (scount * sextent != rcount * rextent) {
XBT_WARN("MPI_allgather_NTSLR_NB use default MPI_allgather.");
smpi_mpi_allgather(sbuf, scount, stype, rbuf, rcount, rtype, comm);
return MPI_SUCCESS;
}
// topo non-specific
to = (rank + 1) % size;
from = (rank + size - 1) % size;
//copy a single segment from sbuf to rbuf
send_offset = rank * scount * sextent;
smpi_mpi_sendrecv(sbuf, scount, stype, rank, tag,
(char *)rbuf + send_offset, rcount, rtype, rank, tag, comm, &status);
//start sending logical ring message
int increment = scount * sextent;
//post all irecv first
for (i = 0; i < size - 1; i++) {
recv_offset = ((rank - i - 1 + size) % size) * increment;
rrequest_array[i] = smpi_mpi_irecv((char *)rbuf + recv_offset, rcount, rtype, from, tag + i, comm);
}
for (i = 0; i < size - 1; i++) {
send_offset = ((rank - i + size) % size) * increment;
srequest_array[i] = smpi_mpi_isend((char *)rbuf + send_offset, scount, stype, to, tag + i, comm);
smpi_mpi_wait(&rrequest_array[i], &status);
smpi_mpi_wait(&srequest_array[i], &status2);
}
free(rrequest_array);
free(srequest_array);
return MPI_SUCCESS;
}
/*****************************************************************************
* Function: allgather_ring
* return: int
* inputs:
* send_buff: send input buffer
* send_count: number of elements to send
* send_type: data type of elements being sent
* recv_buff: receive output buffer
* recv_count: number of elements to received
* recv_type: data type of elements being received
* comm: communication
* Descrp: Function works in P - 1 steps. In step i, node j - i -> j -> j+ i.
* Auther: Ahmad Faraj
****************************************************************************/
int
smpi_coll_tuned_allgather_ring(void *send_buff, int send_count,
MPI_Datatype send_type, void *recv_buff,
int recv_count, MPI_Datatype recv_type,
MPI_Comm comm)
{
MPI_Aint extent;
int i, src, dst, rank, num_procs;
int tag = 1;
MPI_Status status;
char *sendptr = (char *) send_buff;
char *recvptr = (char *) recv_buff;
rank = smpi_comm_rank(comm);
num_procs = smpi_comm_size(comm);
extent = smpi_datatype_get_extent(send_type);
// local send/recv
smpi_mpi_sendrecv(sendptr, send_count, send_type, rank, tag,
recvptr + rank * recv_count * extent,
recv_count, recv_type, rank, tag, comm, &status);
for (i = 1; i < num_procs; i++) {
src = (rank - i + num_procs) % num_procs;
dst = (rank + i) % num_procs;
smpi_mpi_sendrecv(sendptr, send_count, send_type, dst, tag,
recvptr + src * recv_count * extent, recv_count, recv_type,
src, tag, comm, &status);
}
return MPI_SUCCESS;
}
// Allgather-Non-Topoloty-Scecific-Logical-Ring algorithm
int
smpi_coll_tuned_allgather_NTSLR(void *sbuf, int scount, MPI_Datatype stype,
void *rbuf, int rcount, MPI_Datatype rtype,
MPI_Comm comm)
{
MPI_Aint rextent, sextent;
MPI_Status status;
int i, to, from, rank, size;
int send_offset, recv_offset;
int tag = COLL_TAG_ALLGATHER;
rank = smpi_comm_rank(comm);
size = smpi_comm_size(comm);
rextent = smpi_datatype_get_extent(rtype);
sextent = smpi_datatype_get_extent(stype);
// irregular case use default MPI fucntions
if (scount * sextent != rcount * rextent) {
XBT_WARN("MPI_allgather_NTSLR use default MPI_allgather.");
smpi_mpi_allgather(sbuf, scount, stype, rbuf, rcount, rtype, comm);
return MPI_SUCCESS;
}
// topo non-specific
to = (rank + 1) % size;
from = (rank + size - 1) % size;
//copy a single segment from sbuf to rbuf
send_offset = rank * scount * sextent;
smpi_mpi_sendrecv(sbuf, scount, stype, rank, tag,
(char *)rbuf + send_offset, rcount, rtype, rank, tag,
comm, &status);
//start sending logical ring message
int increment = scount * sextent;
for (i = 0; i < size - 1; i++) {
send_offset = ((rank - i + size) % size) * increment;
recv_offset = ((rank - i - 1 + size) % size) * increment;
smpi_mpi_sendrecv((char *) rbuf + send_offset, scount, stype, to, tag + i,
(char *) rbuf + recv_offset, rcount, rtype, from, tag + i,
comm, &status);
}
return MPI_SUCCESS;
}
/*****************************************************************************
* Function: alltoall_pair_light_barrier
* Return: int
* Inputs:
send_buff: send input buffer
send_count: number of elements to send
send_type: data type of elements being sent
recv_buff: receive output buffer
recv_count: number of elements to received
recv_type: data type of elements being received
comm: communicator
* Descrp: Function works in P - 1 steps. In step i, node j exchanges data
with node i ^ j. Light barriers are inserted between
communications in different phases.
* Auther: Ahmad Faraj
****************************************************************************/
int
smpi_coll_tuned_alltoall_pair_light_barrier(void *send_buff, int send_count,
MPI_Datatype send_type,
void *recv_buff, int recv_count,
MPI_Datatype recv_type,
MPI_Comm comm)
{
MPI_Aint send_chunk, recv_chunk;
MPI_Status s;
int i, src, dst, rank, num_procs, next_partner;
int tag = COLL_TAG_ALLTOALL; /*, failure = 0; */
char send_sync = 'a', recv_sync = 'b';
char *send_ptr = (char *) send_buff;
char *recv_ptr = (char *) recv_buff;
rank = smpi_comm_rank(comm);
num_procs = smpi_comm_size(comm);
if((num_procs&(num_procs-1)))
THROWF(arg_error,0, "alltoall pair algorithm can't be used with non power of two number of processes ! ");
send_chunk = smpi_datatype_get_extent(send_type);
recv_chunk = smpi_datatype_get_extent(recv_type);
send_chunk *= send_count;
recv_chunk *= recv_count;
smpi_mpi_sendrecv(send_ptr + rank * send_chunk, send_count, send_type, rank, tag,
recv_ptr + rank * recv_chunk, recv_count, recv_type, rank, tag,
comm, &s);
for (i = 1; i < num_procs; i++) {
src = dst = rank ^ i;
smpi_mpi_sendrecv(send_ptr + dst * send_chunk, send_count, send_type,
dst, tag, recv_ptr + src * recv_chunk, recv_count,
recv_type, src, tag, comm, &s);
if ((i + 1) < num_procs) {
next_partner = rank ^ (i + 1);
smpi_mpi_sendrecv(&send_sync, 1, MPI_CHAR, next_partner, tag,
&recv_sync, 1, MPI_CHAR, next_partner, tag, comm, &s);
}
}
return MPI_SUCCESS;
}
int
smpi_coll_tuned_reduce_flat_tree(void *sbuf, void *rbuf, int count,
MPI_Datatype dtype, MPI_Op op,
int root, MPI_Comm comm)
{
int i, tag = 4321;
int size;
int rank;
MPI_Aint extent;
char *origin = 0;
char *inbuf;
MPI_Status status;
rank = smpi_comm_rank(comm);
size = smpi_comm_size(comm);
/* If not root, send data to the root. */
extent = smpi_datatype_get_extent(dtype);
if (rank != root) {
smpi_mpi_send(sbuf, count, dtype, root, tag, comm);
return 0;
}
/* Root receives and reduces messages. Allocate buffer to receive
messages. */
if (size > 1)
origin = (char *) xbt_malloc(count * extent);
/* Initialize the receive buffer. */
if (rank == (size - 1))
smpi_mpi_sendrecv(sbuf, count, dtype, rank, tag,
rbuf, count, dtype, rank, tag, comm, &status);
else
smpi_mpi_recv(rbuf, count, dtype, size - 1, tag, comm, &status);
/* Loop receiving and calling reduction function (C or Fortran). */
for (i = size - 2; i >= 0; --i) {
if (rank == i)
inbuf = sbuf;
else {
smpi_mpi_recv(origin, count, dtype, i, tag, comm, &status);
inbuf = origin;
}
/* Call reduction function. */
smpi_op_apply(op, inbuf, rbuf, &count, &dtype);
}
if (origin)
free(origin);
/* All done */
return 0;
}
/*****************************************************************************
* Function: alltoall_pair_light_barrier
* Return: int
* Inputs:
send_buff: send input buffer
send_count: number of elements to send
send_type: data type of elements being sent
recv_buff: receive output buffer
recv_count: number of elements to received
recv_type: data type of elements being received
comm: communicator
* Descrp: Function works in P - 1 steps. In step i, node j exchanges data
with node i ^ j. Light barriers are inserted between
communications in different phases.
* Auther: Ahmad Faraj
****************************************************************************/
int
smpi_coll_tuned_alltoallv_pair_light_barrier(void *send_buff, int *send_counts, int *send_disps,
MPI_Datatype send_type,
void *recv_buff, int *recv_counts, int *recv_disps,
MPI_Datatype recv_type,
MPI_Comm comm)
{
MPI_Aint send_chunk, recv_chunk;
MPI_Status s;
int i, src, dst, rank, num_procs, next_partner;
int tag = COLL_TAG_ALLTOALLV; /*, failure = 0; */
char send_sync = 'a', recv_sync = 'b';
char *send_ptr = (char *) send_buff;
char *recv_ptr = (char *) recv_buff;
rank = smpi_comm_rank(comm);
num_procs = smpi_comm_size(comm);
send_chunk = smpi_datatype_get_extent(send_type);
recv_chunk = smpi_datatype_get_extent(recv_type);
smpi_mpi_sendrecv(send_ptr + send_disps[rank] * send_chunk, send_counts[rank], send_type, rank, tag,
recv_ptr + recv_disps[rank] * recv_chunk, recv_counts[rank], recv_type, rank, tag,
comm, &s);
for (i = 1; i < num_procs; i++) {
src = dst = rank ^ i;
smpi_mpi_sendrecv(send_ptr + send_disps[dst] * send_chunk, send_counts[dst], send_type,
dst, tag, recv_ptr + recv_disps[src] *recv_chunk, recv_counts[dst],
recv_type, src, tag, comm, &s);
if ((i + 1) < num_procs) {
next_partner = rank ^ (i + 1);
smpi_mpi_sendrecv(&send_sync, 1, MPI_CHAR, next_partner, tag,
&recv_sync, 1, MPI_CHAR, next_partner, tag, comm, &s);
}
}
return MPI_SUCCESS;
}
/*****************************************************************************
* Function: allgather_spreading_simple
* return: int
* inputs:
* send_buff: send input buffer
* send_count: number of elements to send
* send_type: data type of elements being sent
* recv_buff: receive output buffer
* recv_count: number of elements to received
* recv_type: data type of elements being received
* comm: communication
* Descrp: Let i -> j denote the communication from node i to node j. The
* order of communications for node i is i -> i + 1, i -> i + 2, ...,
* i -> (i + p -1) % P.
*
* Auther: Ahmad Faraj
****************************************************************************/
int
smpi_coll_tuned_allgather_spreading_simple(void *send_buff, int send_count,
MPI_Datatype send_type,
void *recv_buff, int recv_count,
MPI_Datatype recv_type,
MPI_Comm comm)
{
MPI_Request *reqs, *req_ptr;
MPI_Aint extent;
int i, src, dst, rank, num_procs, num_reqs;
int tag = COLL_TAG_ALLGATHER;
MPI_Status status;
char *recv_ptr = (char *) recv_buff;
rank = smpi_comm_rank(comm);
num_procs = smpi_comm_size(comm);
extent = smpi_datatype_get_extent(send_type);
num_reqs = (2 * num_procs) - 2;
reqs = (MPI_Request *) xbt_malloc(num_reqs * sizeof(MPI_Request));
if (!reqs) {
printf("allgather-spreading-simple.c:40: cannot allocate memory\n");
MPI_Finalize();
exit(0);
}
req_ptr = reqs;
smpi_mpi_sendrecv(send_buff, send_count, send_type, rank, tag,
(char *) recv_buff + rank * recv_count * extent, recv_count,
recv_type, rank, tag, comm, &status);
for (i = 0; i < num_procs; i++) {
src = (rank + i) % num_procs;
if (src == rank)
continue;
*(req_ptr++) = smpi_mpi_irecv(recv_ptr + src * recv_count * extent, recv_count, recv_type,
src, tag, comm);
}
for (i = 0; i < num_procs; i++) {
dst = (rank + i) % num_procs;
if (dst == rank)
continue;
*(req_ptr++) = smpi_mpi_isend(send_buff, send_count, send_type, dst, tag, comm);
}
smpi_mpi_waitall(num_reqs, reqs, MPI_STATUSES_IGNORE);
free(reqs);
return MPI_SUCCESS;
}
/*****************************************************************************
* Function: alltoall_pair
* Return: int
* Inputs:
send_buff: send input buffer
send_count: number of elements to send
send_type: data type of elements being sent
recv_buff: receive output buffer
recv_count: number of elements to received
recv_type: data type of elements being received
comm: communicator
* Descrp: Function works when P is power of two. In each phase of P - 1
phases, nodes in pair communicate their data.
* Auther: Ahmad Faraj
****************************************************************************/
int
smpi_coll_tuned_alltoall_pair_one_barrier(void *send_buff, int send_count,
MPI_Datatype send_type,
void *recv_buff, int recv_count,
MPI_Datatype recv_type, MPI_Comm comm)
{
MPI_Aint send_chunk, recv_chunk;
MPI_Status s;
int i, src, dst, rank, num_procs;
int tag = COLL_TAG_ALLTOALL;
char *send_ptr = (char *) send_buff;
char *recv_ptr = (char *) recv_buff;
rank = smpi_comm_rank(comm);
num_procs = smpi_comm_size(comm);
if((num_procs&(num_procs-1)))
THROWF(arg_error,0, "alltoall pair algorithm can't be used with non power of two number of processes ! ");
send_chunk = smpi_datatype_get_extent(send_type);
recv_chunk = smpi_datatype_get_extent(recv_type);
send_chunk *= send_count;
recv_chunk *= recv_count;
mpi_coll_barrier_fun(comm);
for (i = 0; i < num_procs; i++) {
src = dst = rank ^ i;
smpi_mpi_sendrecv(send_ptr + dst * send_chunk, send_count, send_type, dst,
tag, recv_ptr + src * recv_chunk, recv_count, recv_type,
src, tag, comm, &s);
}
return MPI_SUCCESS;
}
/* sendbuf - (in) sender's buffer
* sendcnt - (in) sender's element count
* sendtype - (in) sender's data type
* recvbuf - (in) receiver's buffer
* recvcnt - (in) receiver's element count
* recvtype - (in) receiver's data type
* root - (in)root for the gather operation
* rank - (in) global rank(rank in the global comm)
* tmp_buf - (out/in) tmp_buf into which intra node
* data is gathered
* is_data_avail - (in) based on this, tmp_buf acts
* as in/out parameter.
* 1 - tmp_buf acts as in parameter
* 0 - tmp_buf acts as out parameter
* comm_ptr - (in) pointer to the communicator
* (shmem_comm or intra_sock_comm or
* inter-sock_leader_comm)
* intra_node_fn_ptr - (in) Function ptr to choose the
* intra node gather function
* errflag - (out) to record errors
*/
static int MPIR_pt_pt_intra_gather( void *sendbuf, int sendcnt, MPI_Datatype sendtype,
void *recvbuf, int recvcnt, MPI_Datatype recvtype,
int root, int rank,
void *tmp_buf, int nbytes,
int is_data_avail,
MPI_Comm comm,
MV2_Gather_function_ptr intra_node_fn_ptr)
{
int mpi_errno = MPI_SUCCESS;
MPI_Aint recvtype_extent = 0; /* Datatype extent */
MPI_Aint true_lb, sendtype_true_extent, recvtype_true_extent;
if (sendtype != MPI_DATATYPE_NULL) {
smpi_datatype_extent(sendtype, &true_lb,
&sendtype_true_extent);
}
if (recvtype != MPI_DATATYPE_NULL) {
recvtype_extent=smpi_datatype_get_extent(recvtype);
smpi_datatype_extent(recvtype, &true_lb,
&recvtype_true_extent);
}
/* Special case, when tmp_buf itself has data */
if (rank == root && sendbuf == MPI_IN_PLACE && is_data_avail) {
mpi_errno = intra_node_fn_ptr(MPI_IN_PLACE,
sendcnt, sendtype, tmp_buf, nbytes,
MPI_BYTE, 0, comm);
} else if (rank == root && sendbuf == MPI_IN_PLACE) {
mpi_errno = intra_node_fn_ptr((char*)recvbuf +
rank * recvcnt * recvtype_extent,
recvcnt, recvtype, tmp_buf, nbytes,
MPI_BYTE, 0, comm);
} else {
mpi_errno = intra_node_fn_ptr(sendbuf, sendcnt, sendtype,
tmp_buf, nbytes, MPI_BYTE,
0, comm);
}
return mpi_errno;
}
int smpi_coll_tuned_scatter_ompi(void *sbuf, int scount,
MPI_Datatype sdtype,
void* rbuf, int rcount,
MPI_Datatype rdtype,
int root, MPI_Comm comm
)
{
const size_t small_block_size = 300;
const int small_comm_size = 10;
int communicator_size, rank;
size_t dsize, block_size;
XBT_DEBUG("smpi_coll_tuned_scatter_ompi");
communicator_size = smpi_comm_size(comm);
rank = smpi_comm_rank(comm);
// Determine block size
if (root == rank) {
dsize=smpi_datatype_size(sdtype);
block_size = dsize * scount;
} else {
dsize=smpi_datatype_size(rdtype);
block_size = dsize * rcount;
}
if ((communicator_size > small_comm_size) &&
(block_size < small_block_size)) {
if(rank!=root){
sbuf=xbt_malloc(rcount*smpi_datatype_get_extent(rdtype));
scount=rcount;
sdtype=rdtype;
}
int ret=smpi_coll_tuned_scatter_ompi_binomial (sbuf, scount, sdtype,
rbuf, rcount, rdtype,
root, comm);
if(rank!=root){
xbt_free(sbuf);
}
return ret;
}
return smpi_coll_tuned_scatter_ompi_basic_linear (sbuf, scount, sdtype,
rbuf, rcount, rdtype,
root, comm);
}
/*****************************************************************************
* Function: allgather_pair
* return: int
* inputs:
* send_buff: send input buffer
* send_count: number of elements to send
* send_type: data type of elements being sent
* recv_buff: receive output buffer
* recv_count: number of elements to received
* recv_type: data type of elements being received
* comm: communication
* Descrp: Function works when P is power of two. In each phase of P - 1
* phases, nodes in pair communicate their data.
* Auther: Ahmad Faraj
****************************************************************************/
int
smpi_coll_tuned_allgatherv_pair(void *send_buff, int send_count,
MPI_Datatype send_type, void *recv_buff,
int *recv_counts, int *recv_disps, MPI_Datatype recv_type,
MPI_Comm comm)
{
MPI_Aint extent;
int i, src, dst, rank, num_procs;
int tag = COLL_TAG_ALLGATHERV;
MPI_Status status;
char *send_ptr = (char *) send_buff;
char *recv_ptr = (char *) recv_buff;
rank = smpi_comm_rank(comm);
num_procs = smpi_comm_size(comm);
if((num_procs&(num_procs-1)))
THROWF(arg_error,0, "allgatherv pair algorithm can't be used with non power of two number of processes ! ");
extent = smpi_datatype_get_extent(send_type);
// local send/recv
smpi_mpi_sendrecv(send_ptr, send_count, send_type, rank, tag,
recv_ptr + recv_disps[rank] * extent,
recv_counts[rank], recv_type, rank, tag, comm, &status);
for (i = 1; i < num_procs; i++) {
src = dst = rank ^ i;
smpi_mpi_sendrecv(send_ptr, send_count, send_type, dst, tag,
recv_ptr + recv_disps[src] * extent, recv_counts[src], recv_type,
src, tag, comm, &status);
}
return MPI_SUCCESS;
}
/* Non-topology-specific pipelined linear-bcast function */
int smpi_coll_tuned_bcast_arrival_pattern_aware_wait(void *buf, int count,
MPI_Datatype datatype,
int root, MPI_Comm comm)
{
MPI_Status status;
MPI_Request request;
MPI_Request *send_request_array;
MPI_Request *recv_request_array;
MPI_Status *send_status_array;
MPI_Status *recv_status_array;
MPI_Status temp_status_array[BCAST_ARRIVAL_PATTERN_AWARE_MAX_NODE];
int rank, size;
int i, j, k;
int tag = -COLL_TAG_BCAST;
int will_send[BCAST_ARRIVAL_PATTERN_AWARE_MAX_NODE];
int sent_count;
int header_index;
int flag_array[BCAST_ARRIVAL_PATTERN_AWARE_MAX_NODE];
int already_sent[BCAST_ARRIVAL_PATTERN_AWARE_MAX_NODE];
int header_buf[BCAST_ARRIVAL_PATTERN_AWARE_HEADER_SIZE];
char temp_buf[BCAST_ARRIVAL_PATTERN_AWARE_MAX_NODE];
int max_node = BCAST_ARRIVAL_PATTERN_AWARE_MAX_NODE;
int header_size = BCAST_ARRIVAL_PATTERN_AWARE_HEADER_SIZE;
MPI_Aint extent;
extent = smpi_datatype_get_extent(datatype);
/* source and destination */
int to, from;
rank = smpi_comm_rank(MPI_COMM_WORLD);
size = smpi_comm_size(MPI_COMM_WORLD);
/* segment is segment size in number of elements (not bytes) */
int segment = bcast_arrival_pattern_aware_wait_segment_size_in_byte / extent;
/* pipeline length */
int pipe_length = count / segment;
/* use for buffer offset for sending and receiving data = segment size in byte */
int increment = segment * extent;
/* if the input size is not divisible by segment size =>
the small remainder will be done with native implementation */
int remainder = count % segment;
/* if root is not zero send to rank zero first
this can be modified to make it faster by using logical src, dst.
*/
if (root != 0) {
if (rank == root) {
smpi_mpi_send(buf, count, datatype, 0, tag, comm);
} else if (rank == 0) {
smpi_mpi_recv(buf, count, datatype, root, tag, comm, &status);
}
}
/* value == 0 means root has not send data (or header) to the node yet */
for (i = 0; i < max_node; i++) {
already_sent[i] = 0;
}
/* when a message is smaller than a block size => no pipeline */
if (count <= segment) {
segment = count;
pipe_length = 1;
}
/* start pipeline bcast */
send_request_array =
(MPI_Request *) xbt_malloc((size + pipe_length) * sizeof(MPI_Request));
recv_request_array =
(MPI_Request *) xbt_malloc((size + pipe_length) * sizeof(MPI_Request));
send_status_array =
(MPI_Status *) xbt_malloc((size + pipe_length) * sizeof(MPI_Status));
recv_status_array =
(MPI_Status *) xbt_malloc((size + pipe_length) * sizeof(MPI_Status));
/* root */
if (rank == 0) {
sent_count = 0;
int iteration = 0;
for (i = 0; i < BCAST_ARRIVAL_PATTERN_AWARE_MAX_NODE; i++)
will_send[i] = 0;
while (sent_count < (size - 1)) {
iteration++;
/* loop k times to let more processes arrive before start sending data */
for (k = 0; k < 3; k++) {
for (i = 1; i < size; i++) {
if ((already_sent[i] == 0) && (will_send[i] == 0)) {
smpi_mpi_iprobe(i, MPI_ANY_TAG, MPI_COMM_WORLD, &flag_array[i],
&temp_status_array[i]);
if (flag_array[i] == 1) {
will_send[i] = 1;
smpi_mpi_recv(&temp_buf[i], 1, MPI_CHAR, i, tag, MPI_COMM_WORLD,
&status);
i = 0;
}
}
}
}
header_index = 0;
/* recv 1-byte message */
for (i = 1; i < size; i++) {
/* message arrive */
if ((will_send[i] == 1) && (already_sent[i] == 0)) {
header_buf[header_index] = i;
header_index++;
sent_count++;
/* will send in the next step */
already_sent[i] = 1;
}
}
/* send header followed by data */
if (header_index != 0) {
header_buf[header_index] = -1;
to = header_buf[0];
/* send header */
smpi_mpi_send(header_buf, header_size, MPI_INT, to, tag, comm);
/* send data - pipeline */
for (i = 0; i < pipe_length; i++) {
send_request_array[i] = smpi_mpi_isend((char *)buf + (i * increment), segment, datatype, to, tag, comm);
}
smpi_mpi_waitall((pipe_length), send_request_array, send_status_array);
}
/* end - send header followed by data */
/* randomly MPI_Send to one node */
/* this part has been commented out - performance-wise */
else if (2 == 3) {
/* search for the first node that never received data before */
for (i = 0; i < size; i++) {
if (i == root)
continue;
if (already_sent[i] == 0) {
header_buf[0] = i;
header_buf[1] = -1;
to = i;
smpi_mpi_send(header_buf, header_size, MPI_INT, to, tag, comm);
/* still need to chop data so that we can use the same non-root code */
for (j = 0; j < pipe_length; j++) {
smpi_mpi_send((char *)buf + (j * increment), segment, datatype, to, tag, comm);
}
}
}
}
} /* end - while (send_count < size-1) loop */
}
/* end - root */
/* none root */
else {
/* send 1-byte message to root */
smpi_mpi_send(temp_buf, 1, MPI_CHAR, 0, tag, comm);
/* wait for header forward when required */
request = smpi_mpi_irecv(header_buf, header_size, MPI_INT, MPI_ANY_SOURCE, tag, comm);
smpi_mpi_wait(&request, MPI_STATUS_IGNORE);
/* search for where it is */
int myordering = 0;
while (rank != header_buf[myordering]) {
myordering++;
}
to = header_buf[myordering + 1];
if (myordering == 0) {
from = 0;
} else {
from = header_buf[myordering - 1];
}
/* send header when required */
if (to != -1) {
smpi_mpi_send(header_buf, header_size, MPI_INT, to, tag, comm);
}
/* receive data */
for (i = 0; i < pipe_length; i++) {
recv_request_array[i] = smpi_mpi_irecv((char *)buf + (i * increment), segment, datatype, from, tag, comm);
}
/* forward data */
if (to != -1) {
for (i = 0; i < pipe_length; i++) {
smpi_mpi_wait(&recv_request_array[i], MPI_STATUS_IGNORE);
send_request_array[i] = smpi_mpi_isend((char *)buf + (i * increment), segment, datatype, to, tag, comm);
}
smpi_mpi_waitall((pipe_length), send_request_array, send_status_array);
}
/* recv only */
else {
smpi_mpi_waitall((pipe_length), recv_request_array, recv_status_array);
}
}
free(send_request_array);
free(recv_request_array);
free(send_status_array);
free(recv_status_array);
/* end pipeline */
/* when count is not divisible by block size, use default BCAST for the remainder */
if ((remainder != 0) && (count > segment)) {
XBT_WARN("MPI_bcast_arrival_pattern_aware_wait use default MPI_bcast.");
smpi_mpi_bcast((char *)buf + (pipe_length * increment), remainder, datatype, root, comm);
}
return MPI_SUCCESS;
}
int
smpi_coll_tuned_bcast_scatter_rdb_allgather(void *buff, int count, MPI_Datatype
data_type, int root, MPI_Comm comm)
{
MPI_Aint extent;
MPI_Status status;
int i, j, k, src, dst, rank, num_procs, send_offset, recv_offset;
int mask, relative_rank, curr_size, recv_size = 0, send_size, nbytes;
int scatter_size, tree_root, relative_dst, dst_tree_root;
int my_tree_root, offset, tmp_mask, num_procs_completed;
int tag = COLL_TAG_BCAST;
rank = smpi_comm_rank(comm);
num_procs = smpi_comm_size(comm);
extent = smpi_datatype_get_extent(data_type);
nbytes = extent * count;
scatter_size = (nbytes + num_procs - 1) / num_procs; // ceiling division
curr_size = (rank == root) ? nbytes : 0; // root starts with all the data
relative_rank = (rank >= root) ? rank - root : rank - root + num_procs;
mask = 0x1;
while (mask < num_procs) {
if (relative_rank & mask) {
src = rank - mask;
if (src < 0)
src += num_procs;
recv_size = nbytes - relative_rank * scatter_size;
// recv_size is larger than what might actually be sent by the
// sender. We don't need compute the exact value because MPI
// allows you to post a larger recv.
if (recv_size <= 0)
curr_size = 0; // this process doesn't receive any data
// because of uneven division
else {
smpi_mpi_recv((char *)buff + relative_rank * scatter_size, recv_size,
MPI_BYTE, src, tag, comm, &status);
curr_size = smpi_mpi_get_count(&status, MPI_BYTE);
}
break;
}
mask <<= 1;
}
// This process is responsible for all processes that have bits
// set from the LSB upto (but not including) mask. Because of
// the "not including", we start by shifting mask back down
// one.
mask >>= 1;
while (mask > 0) {
if (relative_rank + mask < num_procs) {
send_size = curr_size - scatter_size * mask;
// mask is also the size of this process's subtree
if (send_size > 0) {
dst = rank + mask;
if (dst >= num_procs)
dst -= num_procs;
smpi_mpi_send((char *)buff + scatter_size * (relative_rank + mask),
send_size, MPI_BYTE, dst, tag, comm);
curr_size -= send_size;
}
}
mask >>= 1;
}
// done scatter now do allgather
mask = 0x1;
i = 0;
while (mask < num_procs) {
relative_dst = relative_rank ^ mask;
dst = (relative_dst + root) % num_procs;
/* find offset into send and recv buffers.
zero out the least significant "i" bits of relative_rank and
relative_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 = relative_dst >> i;
dst_tree_root <<= i;
my_tree_root = relative_rank >> i;
my_tree_root <<= i;
send_offset = my_tree_root * scatter_size;
recv_offset = dst_tree_root * scatter_size;
if (relative_dst < num_procs) {
smpi_mpi_sendrecv((char *)buff + send_offset, curr_size, MPI_BYTE, dst, tag,
(char *)buff + recv_offset, scatter_size * mask, MPI_BYTE, dst,
tag, comm, &status);
recv_size = smpi_mpi_get_count(&status, MPI_BYTE);
curr_size += recv_size;
}
/* 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. */
if (dst_tree_root + mask > num_procs) {
num_procs_completed = num_procs - my_tree_root - mask;
/* num_procs_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--;
offset = scatter_size * (my_tree_root + mask);
tmp_mask = mask >> 1;
while (tmp_mask) {
relative_dst = relative_rank ^ tmp_mask;
dst = (relative_dst + root) % num_procs;
tree_root = relative_rank >> k;
tree_root <<= k;
/* send only if this proc has data and destination
doesn't have data. */
if ((relative_dst > relative_rank)
&& (relative_rank < tree_root + num_procs_completed)
&& (relative_dst >= tree_root + num_procs_completed)) {
smpi_mpi_send((char *)buff + offset, recv_size, MPI_BYTE, dst, tag, comm);
/* recv_size was set in the previous
receive. that's the amount of data to be
sent now. */
}
/* recv only if this proc. doesn't have data and sender
has data */
else if ((relative_dst < relative_rank)
&& (relative_dst < tree_root + num_procs_completed)
&& (relative_rank >= tree_root + num_procs_completed)) {
smpi_mpi_recv((char *)buff + offset, scatter_size * num_procs_completed,
MPI_BYTE, dst, tag, comm, &status);
/* num_procs_completed is also equal to the no. of processes
whose data we don't have */
recv_size = smpi_mpi_get_count(&status, MPI_BYTE);
curr_size += recv_size;
}
tmp_mask >>= 1;
k--;
}
}
mask <<= 1;
i++;
}
int smpi_coll_tuned_bcast_ompi_pipeline( void* buffer,
int original_count,
MPI_Datatype datatype,
int root,
MPI_Comm comm)
{
int count_by_segment = original_count;
size_t type_size;
int segsize =1024 << 7;
//mca_coll_tuned_module_t *tuned_module = (mca_coll_tuned_module_t*) module;
//mca_coll_tuned_comm_t *data = tuned_module->tuned_data;
// return ompi_coll_tuned_bcast_intra_generic( buffer, count, datatype, root, comm, module,
// count_by_segment, data->cached_pipeline );
ompi_coll_tree_t * tree = ompi_coll_tuned_topo_build_chain( 1, comm, root );
int i;
int rank, size;
int segindex;
int num_segments; /* Number of segments */
int sendcount; /* number of elements sent in this segment */
size_t realsegsize;
char *tmpbuf;
ptrdiff_t extent;
MPI_Request recv_reqs[2] = {MPI_REQUEST_NULL, MPI_REQUEST_NULL};
MPI_Request *send_reqs = NULL;
int req_index;
/**
* Determine number of elements sent per operation.
*/
type_size = smpi_datatype_size(datatype);
size = smpi_comm_size(comm);
rank = smpi_comm_rank(comm);
xbt_assert( size > 1 );
const double a_p16 = 3.2118e-6; /* [1 / byte] */
const double b_p16 = 8.7936;
const double a_p64 = 2.3679e-6; /* [1 / byte] */
const double b_p64 = 1.1787;
const double a_p128 = 1.6134e-6; /* [1 / byte] */
const double b_p128 = 2.1102;
size_t message_size;
/* else we need data size for decision function */
message_size = type_size * (unsigned long)original_count; /* needed for decision */
if (size < (a_p128 * message_size + b_p128)) {
//Pipeline with 128KB segments
segsize = 1024 << 7;
}else if (size < (a_p64 * message_size + b_p64)) {
// Pipeline with 64KB segments
segsize = 1024 << 6;
}else if (size < (a_p16 * message_size + b_p16)) {
//Pipeline with 16KB segments
segsize = 1024 << 4;
}
COLL_TUNED_COMPUTED_SEGCOUNT( segsize, type_size, count_by_segment );
XBT_DEBUG("coll:tuned:bcast_intra_pipeline rank %d ss %5d type_size %lu count_by_segment %d",
smpi_comm_rank(comm), segsize, (unsigned long)type_size, count_by_segment);
extent = smpi_datatype_get_extent (datatype);
num_segments = (original_count + count_by_segment - 1) / count_by_segment;
realsegsize = count_by_segment * extent;
/* Set the buffer pointers */
tmpbuf = (char *) buffer;
if( tree->tree_nextsize != 0 ) {
send_reqs = xbt_new(MPI_Request, tree->tree_nextsize );
}
/* Root code */
if( rank == root ) {
/*
For each segment:
- send segment to all children.
The last segment may have less elements than other segments.
*/
sendcount = count_by_segment;
for( segindex = 0; segindex < num_segments; segindex++ ) {
if( segindex == (num_segments - 1) ) {
sendcount = original_count - segindex * count_by_segment;
}
for( i = 0; i < tree->tree_nextsize; i++ ) {
send_reqs[i] = smpi_mpi_isend(tmpbuf, sendcount, datatype,
tree->tree_next[i],
COLL_TAG_BCAST, comm);
}
/* complete the sends before starting the next sends */
smpi_mpi_waitall( tree->tree_nextsize, send_reqs,
MPI_STATUSES_IGNORE );
/* update tmp buffer */
tmpbuf += realsegsize;
}
}
/* Intermediate nodes code */
else if( tree->tree_nextsize > 0 ) {
/*
Create the pipeline.
1) Post the first receive
2) For segments 1 .. num_segments
- post new receive
- wait on the previous receive to complete
- send this data to children
3) Wait on the last segment
4) Compute number of elements in last segment.
5) Send the last segment to children
*/
req_index = 0;
recv_reqs[req_index]=smpi_mpi_irecv(tmpbuf, count_by_segment, datatype,
tree->tree_prev, COLL_TAG_BCAST,
comm);
for( segindex = 1; segindex < num_segments; segindex++ ) {
req_index = req_index ^ 0x1;
/* post new irecv */
recv_reqs[req_index]= smpi_mpi_irecv( tmpbuf + realsegsize, count_by_segment,
datatype, tree->tree_prev,
COLL_TAG_BCAST,
comm);
/* wait for and forward the previous segment to children */
smpi_mpi_wait( &recv_reqs[req_index ^ 0x1],
MPI_STATUSES_IGNORE );
for( i = 0; i < tree->tree_nextsize; i++ ) {
send_reqs[i]=smpi_mpi_isend(tmpbuf, count_by_segment, datatype,
tree->tree_next[i],
COLL_TAG_BCAST, comm );
}
/* complete the sends before starting the next iteration */
smpi_mpi_waitall( tree->tree_nextsize, send_reqs,
MPI_STATUSES_IGNORE );
/* Update the receive buffer */
tmpbuf += realsegsize;
}
/* Process the last segment */
smpi_mpi_wait( &recv_reqs[req_index], MPI_STATUSES_IGNORE );
sendcount = original_count - (num_segments - 1) * count_by_segment;
for( i = 0; i < tree->tree_nextsize; i++ ) {
send_reqs[i] = smpi_mpi_isend(tmpbuf, sendcount, datatype,
tree->tree_next[i],
COLL_TAG_BCAST, comm);
}
smpi_mpi_waitall( tree->tree_nextsize, send_reqs,
MPI_STATUSES_IGNORE );
}
/* Leaf nodes */
else {
/*
Receive all segments from parent in a loop:
1) post irecv for the first segment
2) for segments 1 .. num_segments
- post irecv for the next segment
- wait on the previous segment to arrive
3) wait for the last segment
*/
req_index = 0;
recv_reqs[req_index] = smpi_mpi_irecv(tmpbuf, count_by_segment, datatype,
tree->tree_prev, COLL_TAG_BCAST,
comm);
for( segindex = 1; segindex < num_segments; segindex++ ) {
req_index = req_index ^ 0x1;
tmpbuf += realsegsize;
/* post receive for the next segment */
recv_reqs[req_index] = smpi_mpi_irecv(tmpbuf, count_by_segment, datatype,
tree->tree_prev, COLL_TAG_BCAST,
comm);
/* wait on the previous segment */
smpi_mpi_wait( &recv_reqs[req_index ^ 0x1],
MPI_STATUS_IGNORE );
}
smpi_mpi_wait( &recv_reqs[req_index], MPI_STATUS_IGNORE );
}
if( NULL != send_reqs ) free(send_reqs);
return (MPI_SUCCESS);
}
/**
* This is a generic implementation of the reduce protocol. It used the tree
* provided as an argument and execute all operations using a segment of
* count times a datatype.
* For the last communication it will update the count in order to limit
* the number of datatype to the original count (original_count)
*
* Note that for non-commutative operations we cannot save memory copy
* for the first block: thus we must copy sendbuf to accumbuf on intermediate
* to keep the optimized loop happy.
*/
int smpi_coll_tuned_ompi_reduce_generic( void* sendbuf, void* recvbuf, int original_count,
MPI_Datatype datatype, MPI_Op op,
int root, MPI_Comm comm,
ompi_coll_tree_t* tree, int count_by_segment,
int max_outstanding_reqs )
{
char *inbuf[2] = {NULL, NULL}, *inbuf_free[2] = {NULL, NULL};
char *accumbuf = NULL, *accumbuf_free = NULL;
char *local_op_buffer = NULL, *sendtmpbuf = NULL;
ptrdiff_t extent, lower_bound, segment_increment;
MPI_Request reqs[2] = {MPI_REQUEST_NULL, MPI_REQUEST_NULL};
int num_segments, line, ret, segindex, i, rank;
int recvcount, prevcount, inbi;
/**
* Determine number of segments and number of elements
* sent per operation
*/
smpi_datatype_extent( datatype, &lower_bound, &extent);
num_segments = (original_count + count_by_segment - 1) / count_by_segment;
segment_increment = count_by_segment * extent;
sendtmpbuf = (char*) sendbuf;
if( sendbuf == MPI_IN_PLACE ) {
sendtmpbuf = (char *)recvbuf;
}
XBT_DEBUG( "coll:tuned:reduce_generic count %d, msg size %ld, segsize %ld, max_requests %d", original_count, (unsigned long)(num_segments * segment_increment), (unsigned long)segment_increment, max_outstanding_reqs);
rank = smpi_comm_rank(comm);
/* non-leaf nodes - wait for children to send me data & forward up
(if needed) */
if( tree->tree_nextsize > 0 ) {
ptrdiff_t true_extent, real_segment_size;
true_extent=smpi_datatype_get_extent( datatype);
/* handle non existant recv buffer (i.e. its NULL) and
protect the recv buffer on non-root nodes */
accumbuf = (char*)recvbuf;
if( (NULL == accumbuf) || (root != rank) ) {
/* Allocate temporary accumulator buffer. */
accumbuf_free = (char*)malloc(true_extent +
(original_count - 1) * extent);
if (accumbuf_free == NULL) {
line = __LINE__; ret = -1; goto error_hndl;
}
accumbuf = accumbuf_free - lower_bound;
}
/* If this is a non-commutative operation we must copy
sendbuf to the accumbuf, in order to simplfy the loops */
if (!smpi_op_is_commute(op)) {
smpi_datatype_copy(
(char*)sendtmpbuf, original_count, datatype,
(char*)accumbuf, original_count, datatype);
}
/* Allocate two buffers for incoming segments */
real_segment_size = true_extent + (count_by_segment - 1) * extent;
inbuf_free[0] = (char*) malloc(real_segment_size);
if( inbuf_free[0] == NULL ) {
line = __LINE__; ret = -1; goto error_hndl;
}
inbuf[0] = inbuf_free[0] - lower_bound;
/* if there is chance to overlap communication -
allocate second buffer */
if( (num_segments > 1) || (tree->tree_nextsize > 1) ) {
inbuf_free[1] = (char*) malloc(real_segment_size);
if( inbuf_free[1] == NULL ) {
line = __LINE__; ret = -1; goto error_hndl;
}
inbuf[1] = inbuf_free[1] - lower_bound;
}
/* reset input buffer index and receive count */
inbi = 0;
recvcount = 0;
/* for each segment */
for( segindex = 0; segindex <= num_segments; segindex++ ) {
prevcount = recvcount;
/* recvcount - number of elements in current segment */
recvcount = count_by_segment;
if( segindex == (num_segments-1) )
recvcount = original_count - count_by_segment * segindex;
/* for each child */
for( i = 0; i < tree->tree_nextsize; i++ ) {
/**
* We try to overlap communication:
* either with next segment or with the next child
*/
/* post irecv for current segindex on current child */
if( segindex < num_segments ) {
void* local_recvbuf = inbuf[inbi];
if( 0 == i ) {
/* for the first step (1st child per segment) and
* commutative operations we might be able to irecv
* directly into the accumulate buffer so that we can
* reduce(op) this with our sendbuf in one step as
* ompi_op_reduce only has two buffer pointers,
* this avoids an extra memory copy.
*
* BUT if the operation is non-commutative or
* we are root and are USING MPI_IN_PLACE this is wrong!
*/
if( (smpi_op_is_commute(op)) &&
!((MPI_IN_PLACE == sendbuf) && (rank == tree->tree_root)) ) {
local_recvbuf = accumbuf + segindex * segment_increment;
}
}
reqs[inbi]=smpi_mpi_irecv(local_recvbuf, recvcount, datatype,
tree->tree_next[i],
COLL_TAG_REDUCE, comm
);
}
/* wait for previous req to complete, if any.
if there are no requests reqs[inbi ^1] will be
MPI_REQUEST_NULL. */
/* wait on data from last child for previous segment */
smpi_mpi_waitall( 1, &reqs[inbi ^ 1],
MPI_STATUSES_IGNORE );
local_op_buffer = inbuf[inbi ^ 1];
if( i > 0 ) {
/* our first operation is to combine our own [sendbuf] data
* with the data we recvd from down stream (but only
* the operation is commutative and if we are not root and
* not using MPI_IN_PLACE)
*/
if( 1 == i ) {
if( (smpi_op_is_commute(op)) &&
!((MPI_IN_PLACE == sendbuf) && (rank == tree->tree_root)) ) {
local_op_buffer = sendtmpbuf + segindex * segment_increment;
}
}
/* apply operation */
smpi_op_apply(op, local_op_buffer,
accumbuf + segindex * segment_increment,
&recvcount, &datatype );
} else if ( segindex > 0 ) {
void* accumulator = accumbuf + (segindex-1) * segment_increment;
if( tree->tree_nextsize <= 1 ) {
if( (smpi_op_is_commute(op)) &&
!((MPI_IN_PLACE == sendbuf) && (rank == tree->tree_root)) ) {
local_op_buffer = sendtmpbuf + (segindex-1) * segment_increment;
}
}
smpi_op_apply(op, local_op_buffer, accumulator, &prevcount,
&datatype );
/* all reduced on available data this step (i) complete,
* pass to the next process unless you are the root.
*/
if (rank != tree->tree_root) {
/* send combined/accumulated data to parent */
smpi_mpi_send( accumulator, prevcount,
datatype, tree->tree_prev,
COLL_TAG_REDUCE,
comm);
}
/* we stop when segindex = number of segments
(i.e. we do num_segment+1 steps for pipelining */
if (segindex == num_segments) break;
}
/* update input buffer index */
inbi = inbi ^ 1;
} /* end of for each child */
} /* end of for each segment */
/* clean up */
if( inbuf_free[0] != NULL) free(inbuf_free[0]);
if( inbuf_free[1] != NULL) free(inbuf_free[1]);
if( accumbuf_free != NULL ) free(accumbuf_free);
}
/* leaf nodes
Depending on the value of max_outstanding_reqs and
the number of segments we have two options:
- send all segments using blocking send to the parent, or
- avoid overflooding the parent nodes by limiting the number of
outstanding requests to max_oustanding_reqs.
TODO/POSSIBLE IMPROVEMENT: If there is a way to determine the eager size
for the current communication, synchronization should be used only
when the message/segment size is smaller than the eager size.
*/
else {
/* If the number of segments is less than a maximum number of oustanding
requests or there is no limit on the maximum number of outstanding
requests, we send data to the parent using blocking send */
if ((0 == max_outstanding_reqs) ||
(num_segments <= max_outstanding_reqs)) {
segindex = 0;
while ( original_count > 0) {
if (original_count < count_by_segment) {
count_by_segment = original_count;
}
smpi_mpi_send((char*)sendbuf +
segindex * segment_increment,
count_by_segment, datatype,
tree->tree_prev,
COLL_TAG_REDUCE,
comm) ;
segindex++;
original_count -= count_by_segment;
}
}
/* Otherwise, introduce flow control:
- post max_outstanding_reqs non-blocking synchronous send,
- for remaining segments
- wait for a ssend to complete, and post the next one.
- wait for all outstanding sends to complete.
*/
else {
int creq = 0;
MPI_Request* sreq = NULL;
sreq = (MPI_Request*) calloc( max_outstanding_reqs,
sizeof(MPI_Request ) );
if (NULL == sreq) { line = __LINE__; ret = -1; goto error_hndl; }
/* post first group of requests */
for (segindex = 0; segindex < max_outstanding_reqs; segindex++) {
sreq[segindex]=smpi_mpi_isend((char*)sendbuf +
segindex * segment_increment,
count_by_segment, datatype,
tree->tree_prev,
COLL_TAG_REDUCE,
comm);
original_count -= count_by_segment;
}
creq = 0;
while ( original_count > 0 ) {
/* wait on a posted request to complete */
smpi_mpi_wait(&sreq[creq], MPI_STATUS_IGNORE);
sreq[creq] = MPI_REQUEST_NULL;
if( original_count < count_by_segment ) {
count_by_segment = original_count;
}
sreq[creq]=smpi_mpi_isend((char*)sendbuf +
segindex * segment_increment,
count_by_segment, datatype,
tree->tree_prev,
COLL_TAG_REDUCE,
comm );
creq = (creq + 1) % max_outstanding_reqs;
segindex++;
original_count -= count_by_segment;
}
/* Wait on the remaining request to complete */
smpi_mpi_waitall( max_outstanding_reqs, sreq,
MPI_STATUSES_IGNORE );
/* free requests */
free(sreq);
}
}
return MPI_SUCCESS;
error_hndl: /* error handler */
XBT_DEBUG("ERROR_HNDL: node %d file %s line %d error %d\n",
rank, __FILE__, line, ret );
if( inbuf_free[0] != NULL ) free(inbuf_free[0]);
if( inbuf_free[1] != NULL ) free(inbuf_free[1]);
if( accumbuf_free != NULL ) free(accumbuf);
return ret;
}
int smpi_coll_tuned_allgather_SMP_NTS(void *sbuf, int scount,
MPI_Datatype stype, void *rbuf,
int rcount, MPI_Datatype rtype,
MPI_Comm comm)
{
int src, dst, comm_size, rank;
comm_size = smpi_comm_size(comm);
rank = smpi_comm_rank(comm);
MPI_Aint rextent, sextent;
rextent = smpi_datatype_get_extent(rtype);
sextent = smpi_datatype_get_extent(stype);
int tag = COLL_TAG_ALLGATHER;
MPI_Request request;
MPI_Request rrequest_array[128];
MPI_Status status;
int i, send_offset, recv_offset;
int intra_rank, inter_rank;
intra_rank = rank % NUM_CORE;
inter_rank = rank / NUM_CORE;
int inter_comm_size = (comm_size + NUM_CORE - 1) / NUM_CORE;
int num_core_in_current_smp = NUM_CORE;
/* for too small number of processes, use default implementation */
if (comm_size <= NUM_CORE) {
XBT_WARN("MPI_allgather_SMP_NTS use default MPI_allgather.");
smpi_mpi_allgather(sbuf, scount, stype, rbuf, rcount, rtype, comm);
return MPI_SUCCESS;
}
// the last SMP node may have fewer number of running processes than all others
if (inter_rank == (inter_comm_size - 1)) {
num_core_in_current_smp = comm_size - (inter_rank * NUM_CORE);
}
//copy corresponding message from sbuf to rbuf
recv_offset = rank * rextent * rcount;
smpi_mpi_sendrecv(sbuf, scount, stype, rank, tag,
((char *) rbuf + recv_offset), rcount, rtype, rank, tag, comm,
&status);
//gather to root of each SMP
for (i = 1; i < num_core_in_current_smp; i++) {
dst =
(inter_rank * NUM_CORE) + (intra_rank + i) % (num_core_in_current_smp);
src =
(inter_rank * NUM_CORE) + (intra_rank - i +
num_core_in_current_smp) %
(num_core_in_current_smp);
recv_offset = src * rextent * rcount;
smpi_mpi_sendrecv(sbuf, scount, stype, dst, tag,
((char *) rbuf + recv_offset), rcount, rtype, src, tag, comm,
&status);
}
// INTER-SMP-ALLGATHER
// Every root of each SMP node post INTER-Sendrecv, then do INTRA-Bcast for each receiving message
// Use logical ring algorithm
// root of each SMP
if (intra_rank == 0) {
src = ((inter_rank - 1 + inter_comm_size) % inter_comm_size) * NUM_CORE;
dst = ((inter_rank + 1) % inter_comm_size) * NUM_CORE;
// post all inter Irecv
for (i = 0; i < inter_comm_size - 1; i++) {
recv_offset =
((inter_rank - i - 1 +
inter_comm_size) % inter_comm_size) * NUM_CORE * sextent * scount;
rrequest_array[i] = smpi_mpi_irecv((char *)rbuf+recv_offset, rcount * NUM_CORE, rtype, src, tag+i, comm);
}
// send first message
send_offset =
((inter_rank +
inter_comm_size) % inter_comm_size) * NUM_CORE * sextent * scount;
smpi_mpi_isend((char *) rbuf + send_offset, scount * NUM_CORE, stype,
dst, tag, comm);
// loop : recv-inter , send-inter, send-intra (linear-bcast)
for (i = 0; i < inter_comm_size - 2; i++) {
recv_offset =
((inter_rank - i - 1 +
inter_comm_size) % inter_comm_size) * NUM_CORE * sextent * scount;
smpi_mpi_wait(&rrequest_array[i], &status);
smpi_mpi_isend((char *) rbuf + recv_offset, scount * NUM_CORE, stype,
dst, tag + i + 1, comm);
if (num_core_in_current_smp > 1) {
request = smpi_mpi_isend((char *) rbuf + recv_offset, scount * NUM_CORE, stype,
(rank + 1), tag + i + 1, comm);
}
}
// recv last message and send_intra
recv_offset =
((inter_rank - i - 1 +
inter_comm_size) % inter_comm_size) * NUM_CORE * sextent * scount;
//recv_offset = ((inter_rank + 1) % inter_comm_size) * NUM_CORE * sextent * scount;
//i=inter_comm_size-2;
smpi_mpi_wait(&rrequest_array[i], &status);
if (num_core_in_current_smp > 1) {
request = smpi_mpi_isend((char *) rbuf + recv_offset, scount * NUM_CORE, stype,
(rank + 1), tag + i + 1, comm);
}
}
// last rank of each SMP
else if (intra_rank == (num_core_in_current_smp - 1)) {
for (i = 0; i < inter_comm_size - 1; i++) {
recv_offset =
((inter_rank - i - 1 +
inter_comm_size) % inter_comm_size) * NUM_CORE * sextent * scount;
request = smpi_mpi_irecv((char *) rbuf + recv_offset, (rcount * NUM_CORE), rtype,
rank - 1, tag + i + 1, comm);
smpi_mpi_wait(&request, &status);
}
}
// intermediate rank of each SMP
else {
for (i = 0; i < inter_comm_size - 1; i++) {
recv_offset =
((inter_rank - i - 1 +
inter_comm_size) % inter_comm_size) * NUM_CORE * sextent * scount;
request = smpi_mpi_irecv((char *) rbuf + recv_offset, (rcount * NUM_CORE), rtype,
rank - 1, tag + i + 1, comm);
smpi_mpi_wait(&request, &status);
request = smpi_mpi_isend((char *) rbuf + recv_offset, (scount * NUM_CORE), stype,
(rank + 1), tag + i + 1, comm);
}
}
return MPI_SUCCESS;
}
int smpi_coll_tuned_gather_mvapich2_two_level(void *sendbuf,
int sendcnt,
MPI_Datatype sendtype,
void *recvbuf,
int recvcnt,
MPI_Datatype recvtype,
int root,
MPI_Comm comm)
{
void *leader_gather_buf = NULL;
int comm_size, rank;
int local_rank, local_size;
int leader_comm_rank = -1, leader_comm_size = 0;
int mpi_errno = MPI_SUCCESS;
int recvtype_size = 0, sendtype_size = 0, nbytes=0;
int leader_root, leader_of_root;
MPI_Status status;
MPI_Aint sendtype_extent = 0, recvtype_extent = 0; /* Datatype extent */
MPI_Aint true_lb, sendtype_true_extent, recvtype_true_extent;
MPI_Comm shmem_comm, leader_comm;
void* tmp_buf = NULL;
//if not set (use of the algo directly, without mvapich2 selector)
if(MV2_Gather_intra_node_function==NULL)
MV2_Gather_intra_node_function=smpi_coll_tuned_gather_mpich;
if(smpi_comm_get_leaders_comm(comm)==MPI_COMM_NULL){
smpi_comm_init_smp(comm);
}
comm_size = smpi_comm_size(comm);
rank = smpi_comm_rank(comm);
if (((rank == root) && (recvcnt == 0)) ||
((rank != root) && (sendcnt == 0))) {
return MPI_SUCCESS;
}
if (sendtype != MPI_DATATYPE_NULL) {
sendtype_extent=smpi_datatype_get_extent(sendtype);
sendtype_size=smpi_datatype_size(sendtype);
smpi_datatype_extent(sendtype, &true_lb,
&sendtype_true_extent);
}
if (recvtype != MPI_DATATYPE_NULL) {
recvtype_extent=smpi_datatype_get_extent(recvtype);
recvtype_size=smpi_datatype_size(recvtype);
smpi_datatype_extent(recvtype, &true_lb,
&recvtype_true_extent);
}
/* extract the rank,size information for the intra-node
* communicator */
shmem_comm = smpi_comm_get_intra_comm(comm);
local_rank = smpi_comm_rank(shmem_comm);
local_size = smpi_comm_size(shmem_comm);
if (local_rank == 0) {
/* Node leader. Extract the rank, size information for the leader
* communicator */
leader_comm = smpi_comm_get_leaders_comm(comm);
if(leader_comm==MPI_COMM_NULL){
leader_comm = MPI_COMM_WORLD;
}
leader_comm_size = smpi_comm_size(leader_comm);
leader_comm_rank = smpi_comm_rank(leader_comm);
}
if (rank == root) {
nbytes = recvcnt * recvtype_size;
} else {
nbytes = sendcnt * sendtype_size;
}
#if defined(_SMP_LIMIC_)
if((g_use_limic2_coll) && (shmem_commptr->ch.use_intra_sock_comm == 1)
&& (use_limic_gather)
&&((num_scheme == USE_GATHER_PT_PT_BINOMIAL)
|| (num_scheme == USE_GATHER_PT_PT_DIRECT)
||(num_scheme == USE_GATHER_PT_LINEAR_BINOMIAL)
|| (num_scheme == USE_GATHER_PT_LINEAR_DIRECT)
|| (num_scheme == USE_GATHER_LINEAR_PT_BINOMIAL)
|| (num_scheme == USE_GATHER_LINEAR_PT_DIRECT)
|| (num_scheme == USE_GATHER_LINEAR_LINEAR)
|| (num_scheme == USE_GATHER_SINGLE_LEADER))) {
mpi_errno = MV2_Gather_intra_node_function(sendbuf, sendcnt, sendtype,
recvbuf, recvcnt,recvtype,
root, comm);
} else
#endif/*#if defined(_SMP_LIMIC_)*/
{
if (local_rank == 0) {
/* Node leader, allocate tmp_buffer */
if (rank == root) {
tmp_buf = smpi_get_tmp_recvbuffer(recvcnt * MAX(recvtype_extent,
recvtype_true_extent) * local_size);
} else {
tmp_buf = smpi_get_tmp_sendbuffer(sendcnt * MAX(sendtype_extent,
sendtype_true_extent) *
local_size);
}
if (tmp_buf == NULL) {
mpi_errno = MPI_ERR_OTHER;
return mpi_errno;
}
}
/*while testing mpich2 gather test, we see that
* which basically splits the comm, and we come to
* a point, where use_intra_sock_comm == 0, but if the
* intra node function is MPIR_Intra_node_LIMIC_Gather_MV2,
* it would use the intra sock comm. In such cases, we
* fallback to binomial as a default case.*/
#if defined(_SMP_LIMIC_)
if(*MV2_Gather_intra_node_function == MPIR_Intra_node_LIMIC_Gather_MV2) {
mpi_errno = MPIR_pt_pt_intra_gather(sendbuf,sendcnt, sendtype,
recvbuf, recvcnt, recvtype,
root, rank,
tmp_buf, nbytes,
TEMP_BUF_HAS_NO_DATA,
shmem_commptr,
MPIR_Gather_intra);
} else
#endif
{
/*We are gathering the data into tmp_buf and the output
* will be of MPI_BYTE datatype. Since the tmp_buf has no
* local data, we pass is_data_avail = TEMP_BUF_HAS_NO_DATA*/
mpi_errno = MPIR_pt_pt_intra_gather(sendbuf,sendcnt, sendtype,
recvbuf, recvcnt, recvtype,
root, rank,
tmp_buf, nbytes,
TEMP_BUF_HAS_NO_DATA,
shmem_comm,
MV2_Gather_intra_node_function
);
}
}
leader_comm = smpi_comm_get_leaders_comm(comm);
int* leaders_map = smpi_comm_get_leaders_map(comm);
leader_of_root = smpi_group_rank(smpi_comm_group(comm),leaders_map[root]);
leader_root = smpi_group_rank(smpi_comm_group(leader_comm),leaders_map[root]);
/* leader_root is the rank of the leader of the root in leader_comm.
* leader_root is to be used as the root of the inter-leader gather ops
*/
if (!smpi_comm_is_uniform(comm)) {
if (local_rank == 0) {
int *displs = NULL;
int *recvcnts = NULL;
int *node_sizes;
int i = 0;
/* Node leaders have all the data. But, different nodes can have
* different number of processes. Do a Gather first to get the
* buffer lengths at each leader, followed by a Gatherv to move
* the actual data */
if (leader_comm_rank == leader_root && root != leader_of_root) {
/* The root of the Gather operation is not a node-level
* leader and this process's rank in the leader_comm
* is the same as leader_root */
if(rank == root) {
leader_gather_buf = smpi_get_tmp_recvbuffer(recvcnt *
MAX(recvtype_extent,
recvtype_true_extent) *
comm_size);
} else {
leader_gather_buf = smpi_get_tmp_sendbuffer(sendcnt *
MAX(sendtype_extent,
sendtype_true_extent) *
comm_size);
}
if (leader_gather_buf == NULL) {
mpi_errno = MPI_ERR_OTHER;
return mpi_errno;
}
}
node_sizes = smpi_comm_get_non_uniform_map(comm);
if (leader_comm_rank == leader_root) {
displs = xbt_malloc(sizeof (int) * leader_comm_size);
recvcnts = xbt_malloc(sizeof (int) * leader_comm_size);
if (!displs || !recvcnts) {
mpi_errno = MPI_ERR_OTHER;
return mpi_errno;
}
}
if (root == leader_of_root) {
/* The root of the gather operation is also the node
* leader. Receive into recvbuf and we are done */
if (leader_comm_rank == leader_root) {
recvcnts[0] = node_sizes[0] * recvcnt;
displs[0] = 0;
for (i = 1; i < leader_comm_size; i++) {
displs[i] = displs[i - 1] + node_sizes[i - 1] * recvcnt;
recvcnts[i] = node_sizes[i] * recvcnt;
}
}
smpi_mpi_gatherv(tmp_buf,
local_size * nbytes,
MPI_BYTE, recvbuf, recvcnts,
displs, recvtype,
leader_root, leader_comm);
} else {
/* The root of the gather operation is not the node leader.
* Receive into leader_gather_buf and then send
* to the root */
if (leader_comm_rank == leader_root) {
recvcnts[0] = node_sizes[0] * nbytes;
displs[0] = 0;
for (i = 1; i < leader_comm_size; i++) {
displs[i] = displs[i - 1] + node_sizes[i - 1] * nbytes;
recvcnts[i] = node_sizes[i] * nbytes;
}
}
smpi_mpi_gatherv(tmp_buf, local_size * nbytes,
MPI_BYTE, leader_gather_buf,
recvcnts, displs, MPI_BYTE,
leader_root, leader_comm);
}
if (leader_comm_rank == leader_root) {
xbt_free(displs);
xbt_free(recvcnts);
}
}
} else {
/* All nodes have the same number of processes.
* Just do one Gather to get all
* the data at the leader of the root process */
if (local_rank == 0) {
if (leader_comm_rank == leader_root && root != leader_of_root) {
/* The root of the Gather operation is not a node-level leader
*/
leader_gather_buf = smpi_get_tmp_sendbuffer(nbytes * comm_size);
if (leader_gather_buf == NULL) {
mpi_errno = MPI_ERR_OTHER;
return mpi_errno;
}
}
if (root == leader_of_root) {
mpi_errno = MPIR_Gather_MV2_Direct(tmp_buf,
nbytes * local_size,
MPI_BYTE, recvbuf,
recvcnt * local_size,
recvtype, leader_root,
leader_comm);
} else {
mpi_errno = MPIR_Gather_MV2_Direct(tmp_buf, nbytes * local_size,
MPI_BYTE, leader_gather_buf,
nbytes * local_size,
MPI_BYTE, leader_root,
leader_comm);
}
}
}
if ((local_rank == 0) && (root != rank)
&& (leader_of_root == rank)) {
smpi_mpi_send(leader_gather_buf,
nbytes * comm_size, MPI_BYTE,
root, COLL_TAG_GATHER, comm);
}
if (rank == root && local_rank != 0) {
/* The root of the gather operation is not the node leader. Receive
y* data from the node leader */
smpi_mpi_recv(recvbuf, recvcnt * comm_size, recvtype,
leader_of_root, COLL_TAG_GATHER, comm,
&status);
}
/* check if multiple threads are calling this collective function */
if (local_rank == 0 ) {
if (tmp_buf != NULL) {
smpi_free_tmp_buffer(tmp_buf);
}
if (leader_gather_buf != NULL) {
smpi_free_tmp_buffer(leader_gather_buf);
}
}
return (mpi_errno);
}
int smpi_coll_tuned_bcast_NTSB(void *buf, int count, MPI_Datatype datatype,
int root, MPI_Comm comm)
{
int tag = COLL_TAG_BCAST;
MPI_Status status;
int rank, size;
int i;
MPI_Request *send_request_array;
MPI_Request *recv_request_array;
MPI_Status *send_status_array;
MPI_Status *recv_status_array;
MPI_Aint extent;
extent = smpi_datatype_get_extent(datatype);
rank = smpi_comm_rank(MPI_COMM_WORLD);
size = smpi_comm_size(MPI_COMM_WORLD);
/* source node and destination nodes (same through out the functions) */
int from = (rank - 1) / 2;
int to_left = rank * 2 + 1;
int to_right = rank * 2 + 2;
if (to_left >= size)
to_left = -1;
if (to_right >= size)
to_right = -1;
/* segment is segment size in number of elements (not bytes) */
int segment = bcast_NTSB_segment_size_in_byte / extent;
/* pipeline length */
int pipe_length = count / segment;
/* use for buffer offset for sending and receiving data = segment size in byte */
int increment = segment * extent;
/* if the input size is not divisible by segment size =>
the small remainder will be done with native implementation */
int remainder = count % segment;
/* if root is not zero send to rank zero first */
if (root != 0) {
if (rank == root) {
smpi_mpi_send(buf, count, datatype, 0, tag, comm);
} else if (rank == 0) {
smpi_mpi_recv(buf, count, datatype, root, tag, comm, &status);
}
}
/* when a message is smaller than a block size => no pipeline */
if (count <= segment) {
/* case: root */
if (rank == 0) {
/* case root has only a left child */
if (to_right == -1) {
smpi_mpi_send(buf, count, datatype, to_left, tag, comm);
}
/* case root has both left and right children */
else {
smpi_mpi_send(buf, count, datatype, to_left, tag, comm);
smpi_mpi_send(buf, count, datatype, to_right, tag, comm);
}
}
/* case: leaf ==> receive only */
else if (to_left == -1) {
smpi_mpi_recv(buf, count, datatype, from, tag, comm, &status);
}
/* case: intermidiate node with only left child ==> relay message */
else if (to_right == -1) {
smpi_mpi_recv(buf, count, datatype, from, tag, comm, &status);
smpi_mpi_send(buf, count, datatype, to_left, tag, comm);
}
/* case: intermidiate node with both left and right children ==> relay message */
else {
smpi_mpi_recv(buf, count, datatype, from, tag, comm, &status);
smpi_mpi_send(buf, count, datatype, to_left, tag, comm);
smpi_mpi_send(buf, count, datatype, to_right, tag, comm);
}
return MPI_SUCCESS;
}
// pipelining
else {
send_request_array =
(MPI_Request *) xbt_malloc(2 * (size + pipe_length) * sizeof(MPI_Request));
recv_request_array =
(MPI_Request *) xbt_malloc((size + pipe_length) * sizeof(MPI_Request));
send_status_array =
(MPI_Status *) xbt_malloc(2 * (size + pipe_length) * sizeof(MPI_Status));
recv_status_array =
(MPI_Status *) xbt_malloc((size + pipe_length) * sizeof(MPI_Status));
/* case: root */
if (rank == 0) {
/* case root has only a left child */
if (to_right == -1) {
for (i = 0; i < pipe_length; i++) {
send_request_array[i] = smpi_mpi_isend((char *) buf + (i * increment), segment, datatype, to_left,
tag + i, comm);
}
smpi_mpi_waitall((pipe_length), send_request_array, send_status_array);
}
/* case root has both left and right children */
else {
for (i = 0; i < pipe_length; i++) {
send_request_array[i] = smpi_mpi_isend((char *) buf + (i * increment), segment, datatype, to_left,
tag + i, comm);
send_request_array[i + pipe_length] = smpi_mpi_isend((char *) buf + (i * increment), segment, datatype, to_right,
tag + i, comm);
}
smpi_mpi_waitall((2 * pipe_length), send_request_array, send_status_array);
}
}
/* case: leaf ==> receive only */
else if (to_left == -1) {
for (i = 0; i < pipe_length; i++) {
recv_request_array[i] = smpi_mpi_irecv((char *) buf + (i * increment), segment, datatype, from,
tag + i, comm);
}
smpi_mpi_waitall((pipe_length), recv_request_array, recv_status_array);
}
/* case: intermidiate node with only left child ==> relay message */
else if (to_right == -1) {
for (i = 0; i < pipe_length; i++) {
recv_request_array[i] = smpi_mpi_irecv((char *) buf + (i * increment), segment, datatype, from,
tag + i, comm);
}
for (i = 0; i < pipe_length; i++) {
smpi_mpi_wait(&recv_request_array[i], &status);
send_request_array[i] = smpi_mpi_isend((char *) buf + (i * increment), segment, datatype, to_left,
tag + i, comm);
}
smpi_mpi_waitall(pipe_length, send_request_array, send_status_array);
}
/* case: intermidiate node with both left and right children ==> relay message */
else {
for (i = 0; i < pipe_length; i++) {
recv_request_array[i] = smpi_mpi_irecv((char *) buf + (i * increment), segment, datatype, from,
tag + i, comm);
}
for (i = 0; i < pipe_length; i++) {
smpi_mpi_wait(&recv_request_array[i], &status);
send_request_array[i] = smpi_mpi_isend((char *) buf + (i * increment), segment, datatype, to_left,
tag + i, comm);
send_request_array[i + pipe_length] = smpi_mpi_isend((char *) buf + (i * increment), segment, datatype, to_right,
tag + i, comm);
}
smpi_mpi_waitall((2 * pipe_length), send_request_array, send_status_array);
}
free(send_request_array);
free(recv_request_array);
free(send_status_array);
free(recv_status_array);
} /* end pipeline */
/* when count is not divisible by block size, use default BCAST for the remainder */
if ((remainder != 0) && (count > segment)) {
XBT_WARN("MPI_bcast_NTSB use default MPI_bcast.");
smpi_mpi_bcast((char *) buf + (pipe_length * increment), remainder, datatype,
root, comm);
}
return MPI_SUCCESS;
}
int smpi_coll_tuned_reduce_scatter_gather(void *sendbuf, void *recvbuf,
int count, MPI_Datatype datatype,
MPI_Op op, int root, MPI_Comm comm)
{
MPI_Status status;
int comm_size, rank, 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;
int newroot_tree_root, new_count;
int tag = COLL_TAG_REDUCE;
void *send_ptr, *recv_ptr, *tmp_buf;
cnts = NULL;
disps = NULL;
MPI_Aint extent;
if (count == 0)
return 0;
rank = smpi_comm_rank(comm);
comm_size = smpi_comm_size(comm);
extent = smpi_datatype_get_extent(datatype);
/* find nearest power-of-two less than or equal to comm_size */
pof2 = 1;
while (pof2 <= comm_size)
pof2 <<= 1;
pof2 >>= 1;
if (count < comm_size) {
new_count = comm_size;
send_ptr = (void *) xbt_malloc(new_count * extent);
recv_ptr = (void *) xbt_malloc(new_count * extent);
tmp_buf = (void *) xbt_malloc(new_count * extent);
memcpy(send_ptr, sendbuf, extent * count);
//if ((rank != root))
smpi_mpi_sendrecv(send_ptr, new_count, datatype, rank, tag,
recv_ptr, new_count, datatype, rank, tag, comm, &status);
rem = comm_size - pof2;
if (rank < 2 * rem) {
if (rank % 2 != 0) {
/* odd */
smpi_mpi_send(recv_ptr, new_count, datatype, rank - 1, tag, comm);
newrank = -1;
} else {
smpi_mpi_recv(tmp_buf, count, datatype, rank + 1, tag, comm, &status);
smpi_op_apply(op, tmp_buf, recv_ptr, &new_count, &datatype);
newrank = rank / 2;
}
} else /* rank >= 2*rem */
newrank = rank - rem;
cnts = (int *) xbt_malloc(pof2 * sizeof(int));
disps = (int *) xbt_malloc(pof2 * sizeof(int));
if (newrank != -1) {
for (i = 0; i < (pof2 - 1); i++)
cnts[i] = new_count / pof2;
cnts[pof2 - 1] = new_count - (new_count / pof2) * (pof2 - 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 : 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 */
smpi_mpi_sendrecv((char *) recv_ptr +
disps[send_idx] * extent,
send_cnt, datatype,
dst, tag,
(char *) tmp_buf +
disps[recv_idx] * extent,
recv_cnt, datatype, dst, tag, comm, &status);
/* tmp_buf contains data received in this step.
recvbuf contains data accumulated so far */
smpi_op_apply(op, (char *) tmp_buf + disps[recv_idx] * extent,
(char *) recv_ptr + disps[recv_idx] * extent,
&recv_cnt, &datatype);
/* update send_idx for next iteration */
send_idx = recv_idx;
mask <<= 1;
if (mask < pof2)
last_idx = recv_idx + pof2 / mask;
}
}
/* now do the gather to root */
if (root < 2 * rem) {
if (root % 2 != 0) {
if (rank == root) {
/* recv */
for (i = 0; i < (pof2 - 1); i++)
cnts[i] = new_count / pof2;
cnts[pof2 - 1] = new_count - (new_count / pof2) * (pof2 - 1);
disps[0] = 0;
for (i = 1; i < pof2; i++)
disps[i] = disps[i - 1] + cnts[i - 1];
smpi_mpi_recv(recv_ptr, cnts[0], datatype, 0, tag, comm, &status);
newrank = 0;
send_idx = 0;
last_idx = 2;
} else if (newrank == 0) {
smpi_mpi_send(recv_ptr, cnts[0], datatype, root, tag, comm);
newrank = -1;
}
newroot = 0;
} else
newroot = root / 2;
} else
newroot = root - rem;
if (newrank != -1) {
j = 0;
mask = 0x1;
while (mask < pof2) {
mask <<= 1;
j++;
}
mask >>= 1;
j--;
while (mask > 0) {
newdst = newrank ^ mask;
/* find real rank of dest */
dst = (newdst < rem) ? newdst * 2 : newdst + rem;
if ((newdst == 0) && (root < 2 * rem) && (root % 2 != 0))
dst = root;
newdst_tree_root = newdst >> j;
newdst_tree_root <<= j;
newroot_tree_root = newroot >> j;
newroot_tree_root <<= j;
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];
}
if (newdst_tree_root == newroot_tree_root) {
smpi_mpi_send((char *) recv_ptr +
disps[send_idx] * extent,
send_cnt, datatype, dst, tag, comm);
break;
} else {
smpi_mpi_recv((char *) recv_ptr +
disps[recv_idx] * extent,
recv_cnt, datatype, dst, tag, comm, &status);
}
if (newrank > newdst)
send_idx = recv_idx;
mask >>= 1;
j--;
}
}
int smpi_coll_tuned_allreduce_mvapich2_rs(void *sendbuf,
void *recvbuf,
int count,
MPI_Datatype datatype,
MPI_Op op, MPI_Comm comm)
{
int comm_size, rank;
int mpi_errno = MPI_SUCCESS;
int mask, dst, is_commutative, pof2, newrank = 0, rem, newdst, i,
send_idx, recv_idx, last_idx, send_cnt, recv_cnt, *cnts, *disps;
MPI_Aint true_lb, true_extent, extent;
void *tmp_buf, *tmp_buf_free;
if (count == 0) {
return MPI_SUCCESS;
}
/* homogeneous */
comm_size = smpi_comm_size(comm);
rank = smpi_comm_rank(comm);
is_commutative = smpi_op_is_commute(op);
/* need to allocate temporary buffer to store incoming data */
smpi_datatype_extent(datatype, &true_lb, &true_extent);
extent = smpi_datatype_get_extent(datatype);
tmp_buf_free= smpi_get_tmp_recvbuffer(count * (MAX(extent, true_extent)));
/* adjust for potential negative lower bound in datatype */
tmp_buf = (void *) ((char *) tmp_buf_free - true_lb);
/* copy local data into recvbuf */
if (sendbuf != MPI_IN_PLACE) {
mpi_errno =
smpi_datatype_copy(sendbuf, count, datatype, recvbuf, count,
datatype);
}
/* find nearest power-of-two less than or equal to comm_size */
for( pof2 = 1; pof2 <= comm_size; pof2 <<= 1 );
pof2 >>=1;
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 */
smpi_mpi_send(recvbuf, count, datatype, rank + 1,
COLL_TAG_ALLREDUCE, comm);
/* temporarily set the rank to -1 so that this
process does not pariticipate in recursive
doubling */
newrank = -1;
} else {
/* odd */
smpi_mpi_recv(tmp_buf, count, datatype, rank - 1,
COLL_TAG_ALLREDUCE, comm,
MPI_STATUS_IGNORE);
/* do the reduction on received data. since the
ordering is right, it doesn't matter whether
the operation is commutative or not. */
smpi_op_apply(op, tmp_buf, recvbuf, &count, &datatype);
/* 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) {
if (/*(HANDLE_GET_KIND(op) != HANDLE_KIND_BUILTIN) ||*/ (count < pof2)) { /* use recursive doubling */
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 */
smpi_mpi_sendrecv(recvbuf, count, datatype,
dst, COLL_TAG_ALLREDUCE,
tmp_buf, count, datatype, dst,
COLL_TAG_ALLREDUCE, comm,
MPI_STATUS_IGNORE);
/* 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 */
smpi_op_apply(op, tmp_buf, recvbuf, &count, &datatype);
} else {
/* op is noncommutative and the order is not right */
smpi_op_apply(op, recvbuf, tmp_buf, &count, &datatype);
/* copy result back into recvbuf */
mpi_errno = smpi_datatype_copy(tmp_buf, count, datatype,
recvbuf, count, datatype);
}
mask <<= 1;
}
} else {
/* do a reduce-scatter followed by allgather */
/* for the reduce-scatter, calculate the count that
each process receives and the displacement within
the buffer */
cnts = (int *)xbt_malloc(pof2 * sizeof (int));
disps = (int *)xbt_malloc(pof2 * sizeof (int));
for (i = 0; i < (pof2 - 1); i++) {
cnts[i] = count / pof2;
}
cnts[pof2 - 1] = count - (count / pof2) * (pof2 - 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 */
smpi_mpi_sendrecv((char *) recvbuf +
disps[send_idx] * extent,
send_cnt, datatype,
dst, COLL_TAG_ALLREDUCE,
(char *) tmp_buf +
disps[recv_idx] * extent,
recv_cnt, datatype, dst,
COLL_TAG_ALLREDUCE, comm,
MPI_STATUS_IGNORE);
/* 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. */
smpi_op_apply(op, (char *) tmp_buf + disps[recv_idx] * extent,
(char *) recvbuf + disps[recv_idx] * extent,
&recv_cnt, &datatype);
/* 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];
}
}
smpi_mpi_sendrecv((char *) recvbuf +
disps[send_idx] * extent,
send_cnt, datatype,
dst, COLL_TAG_ALLREDUCE,
(char *) recvbuf +
disps[recv_idx] * extent,
recv_cnt, datatype, dst,
COLL_TAG_ALLREDUCE, comm,
MPI_STATUS_IGNORE);
if (newrank > newdst) {
send_idx = recv_idx;
}
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 */
smpi_mpi_send(recvbuf, count,
datatype, rank - 1,
COLL_TAG_ALLREDUCE, comm);
} else { /* even */
smpi_mpi_recv(recvbuf, count,
datatype, rank + 1,
COLL_TAG_ALLREDUCE, comm,
MPI_STATUS_IGNORE);
}
}
smpi_free_tmp_buffer(tmp_buf_free);
return (mpi_errno);
}
int
smpi_coll_tuned_reduce_ompi_basic_linear(void *sbuf, void *rbuf, int count,
MPI_Datatype dtype,
MPI_Op op,
int root,
MPI_Comm comm)
{
int i, rank, size;
ptrdiff_t true_extent, lb, extent;
char *free_buffer = NULL;
char *pml_buffer = NULL;
char *inplace_temp = NULL;
char *inbuf;
/* Initialize */
rank = smpi_comm_rank(comm);
size = smpi_comm_size(comm);
XBT_DEBUG("coll:tuned:reduce_intra_basic_linear rank %d", rank);
/* If not root, send data to the root. */
if (rank != root) {
smpi_mpi_send(sbuf, count, dtype, root,
COLL_TAG_REDUCE,
comm);
return -1;
}
/* see discussion in ompi_coll_basic_reduce_lin_intra about
extent and true extent */
/* for reducing buffer allocation lengths.... */
smpi_datatype_extent(dtype, &lb, &extent);
true_extent = smpi_datatype_get_extent(dtype);
if (MPI_IN_PLACE == sbuf) {
sbuf = rbuf;
inplace_temp = (char*)malloc(true_extent + (count - 1) * extent);
if (NULL == inplace_temp) {
return -1;
}
rbuf = inplace_temp - lb;
}
if (size > 1) {
free_buffer = (char*)malloc(true_extent + (count - 1) * extent);
pml_buffer = free_buffer - lb;
}
/* Initialize the receive buffer. */
if (rank == (size - 1)) {
smpi_datatype_copy((char*)sbuf, count, dtype,(char*)rbuf, count, dtype);
} else {
smpi_mpi_recv(rbuf, count, dtype, size - 1,
COLL_TAG_REDUCE, comm,
MPI_STATUS_IGNORE);
}
/* Loop receiving and calling reduction function (C or Fortran). */
for (i = size - 2; i >= 0; --i) {
if (rank == i) {
inbuf = (char*)sbuf;
} else {
smpi_mpi_recv(pml_buffer, count, dtype, i,
COLL_TAG_REDUCE, comm,
MPI_STATUS_IGNORE);
inbuf = pml_buffer;
}
/* Perform the reduction */
smpi_op_apply(op, inbuf, rbuf, &count, &dtype);
}
if (NULL != inplace_temp) {
smpi_datatype_copy(inplace_temp, count, dtype,(char*)sbuf
,count , dtype);
free(inplace_temp);
}
if (NULL != free_buffer) {
free(free_buffer);
}
/* All done */
return MPI_SUCCESS;
}
int smpi_coll_tuned_reduce_mvapich2_knomial (
void *sendbuf,
void *recvbuf,
int count,
MPI_Datatype datatype,
MPI_Op op,
int root,
MPI_Comm comm)
{
int mpi_errno = MPI_SUCCESS;
int rank, is_commutative;
int src, k;
MPI_Request send_request;
int index=0;
MPI_Aint true_lb, true_extent, extent;
MPI_Status status;
int recv_iter=0, dst=-1, expected_send_count, expected_recv_count;
int *src_array=NULL;
void **tmp_buf=NULL;
MPI_Request *requests=NULL;
if (count == 0) return MPI_SUCCESS;
rank = smpi_comm_rank(comm);
/* Create a temporary buffer */
smpi_datatype_extent(datatype, &true_lb, &true_extent);
extent = smpi_datatype_get_extent(datatype);
is_commutative = smpi_op_is_commute(op);
if (rank != root) {
recvbuf=(void *)smpi_get_tmp_recvbuffer(count*(MAX(extent,true_extent)));
recvbuf = (void *)((char*)recvbuf - true_lb);
}
if ((rank != root) || (sendbuf != MPI_IN_PLACE)) {
mpi_errno = smpi_datatype_copy(sendbuf, count, datatype, recvbuf,
count, datatype);
}
if(mv2_reduce_intra_knomial_factor<0)
{
mv2_reduce_intra_knomial_factor = SMPI_DEFAULT_KNOMIAL_FACTOR;
}
if(mv2_reduce_inter_knomial_factor<0)
{
mv2_reduce_inter_knomial_factor = SMPI_DEFAULT_KNOMIAL_FACTOR;
}
MPIR_Reduce_knomial_trace(root, mv2_reduce_intra_knomial_factor, comm,
&dst, &expected_send_count, &expected_recv_count, &src_array);
if(expected_recv_count > 0 ) {
tmp_buf = xbt_malloc(sizeof(void *)*expected_recv_count);
requests = xbt_malloc(sizeof(MPI_Request)*expected_recv_count);
for(k=0; k < expected_recv_count; k++ ) {
tmp_buf[k] = smpi_get_tmp_sendbuffer(count*(MAX(extent,true_extent)));
tmp_buf[k] = (void *)((char*)tmp_buf[k] - true_lb);
}
while(recv_iter < expected_recv_count) {
src = src_array[expected_recv_count - (recv_iter+1)];
requests[recv_iter]=smpi_mpi_irecv (tmp_buf[recv_iter], count, datatype ,src,
COLL_TAG_REDUCE, comm);
recv_iter++;
}
recv_iter=0;
while(recv_iter < expected_recv_count) {
index=smpi_mpi_waitany(expected_recv_count, requests,
&status);
recv_iter++;
if (is_commutative) {
smpi_op_apply(op, tmp_buf[index], recvbuf, &count, &datatype);
}
}
for(k=0; k < expected_recv_count; k++ ) {
smpi_free_tmp_buffer(tmp_buf[k]);
}
xbt_free(tmp_buf);
xbt_free(requests);
}
if(src_array != NULL) {
xbt_free(src_array);
}
if(rank != root) {
send_request=smpi_mpi_isend(recvbuf,count, datatype, dst,
COLL_TAG_REDUCE,comm);
smpi_mpi_waitall(1, &send_request, &status);
smpi_free_tmp_buffer((void *)((char*)recvbuf + true_lb));
}
/* --END ERROR HANDLING-- */
return mpi_errno;
}
/*****************************************************************************
* Function: allgather_bruck
* return: int
* inputs:
* send_buff: send input buffer
* send_count: number of elements to send
* send_type: data type of elements being sent
* recv_buff: receive output buffer
* recv_count: number of elements to received
* recv_type: data type of elements being received
* comm: communication
* Descrp: Function realizes the allgather operation using the bruck
* algorithm.
* Auther: MPICH
* Comment: Original bruck algorithm from MPICH is slightly modified by
* Ahmad Faraj.
****************************************************************************/
int smpi_coll_tuned_allgather_bruck(void *send_buff, int send_count,
MPI_Datatype send_type, void *recv_buff,
int recv_count, MPI_Datatype recv_type,
MPI_Comm comm)
{
// MPI variables
MPI_Status status;
MPI_Aint recv_extent;
// local int variables
int src, dst, rank, num_procs, count, remainder;
int tag = COLL_TAG_ALLGATHER;
int pof2 = 1;
// local string variables
char *tmp_buff;
char *send_ptr = (char *) send_buff;
char *recv_ptr = (char *) recv_buff;
// get size of the communicator, followed by rank
num_procs = smpi_comm_size(comm);
rank = smpi_comm_rank(comm);
// get size of single element's type for recv buffer
recv_extent = smpi_datatype_get_extent(recv_type);
count = recv_count;
tmp_buff = (char *) xbt_malloc(num_procs * recv_count * recv_extent);
// perform a local copy
smpi_datatype_copy(send_ptr, send_count, send_type,
tmp_buff, recv_count, recv_type);
while (pof2 <= (num_procs / 2)) {
src = (rank + pof2) % num_procs;
dst = (rank - pof2 + num_procs) % num_procs;
smpi_mpi_sendrecv(tmp_buff, count, recv_type, dst, tag,
tmp_buff + count * recv_extent, count, recv_type,
src, tag, comm, &status);
count *= 2;
pof2 *= 2;
}
remainder = num_procs - pof2;
if (remainder) {
src = (rank + pof2) % num_procs;
dst = (rank - pof2 + num_procs) % num_procs;
smpi_mpi_sendrecv(tmp_buff, remainder * recv_count, recv_type, dst, tag,
tmp_buff + count * recv_extent, remainder * recv_count,
recv_type, src, tag, comm, &status);
}
smpi_mpi_sendrecv(tmp_buff, (num_procs - rank) * recv_count, recv_type, rank,
tag, recv_ptr + rank * recv_count * recv_extent,
(num_procs - rank) * recv_count, recv_type, rank, tag, comm,
&status);
if (rank)
smpi_mpi_sendrecv(tmp_buff + (num_procs - rank) * recv_count * recv_extent,
rank * recv_count, recv_type, rank, tag, recv_ptr,
rank * recv_count, recv_type, rank, tag, comm, &status);
free(tmp_buff);
return MPI_SUCCESS;
}
/*
* reduce_intra_in_order_binary
*
* Function: Logarithmic reduce operation for non-commutative operations.
* Acecpts: same as MPI_Reduce()
* Returns: MPI_SUCCESS or error code
*/
int smpi_coll_tuned_reduce_ompi_in_order_binary( void *sendbuf, void *recvbuf,
int count,
MPI_Datatype datatype,
MPI_Op op, int root,
MPI_Comm comm)
{
uint32_t segsize=0;
int ret;
int rank, size, io_root;
int segcount = count;
void *use_this_sendbuf = NULL, *use_this_recvbuf = NULL;
size_t typelng;
rank = smpi_comm_rank(comm);
size = smpi_comm_size(comm);
XBT_DEBUG("coll:tuned:reduce_intra_in_order_binary rank %d ss %5d",
rank, segsize);
/**
* Determine number of segments and number of elements
* sent per operation
*/
typelng=smpi_datatype_size( datatype);
COLL_TUNED_COMPUTED_SEGCOUNT( segsize, typelng, segcount );
/* An in-order binary tree must use root (size-1) to preserve the order of
operations. Thus, if root is not rank (size - 1), then we must handle
1. MPI_IN_PLACE option on real root, and
2. we must allocate temporary recvbuf on rank (size - 1).
Note that generic function must be careful not to switch order of
operations for non-commutative ops.
*/
io_root = size - 1;
use_this_sendbuf = sendbuf;
use_this_recvbuf = recvbuf;
if (io_root != root) {
ptrdiff_t text, ext;
char *tmpbuf = NULL;
ext=smpi_datatype_get_extent(datatype);
text=smpi_datatype_get_extent(datatype);
if ((root == rank) && (MPI_IN_PLACE == sendbuf)) {
tmpbuf = (char *) malloc(text + (count - 1) * ext);
if (NULL == tmpbuf) {
return MPI_ERR_INTERN;
}
smpi_datatype_copy (
(char*)recvbuf, count, datatype,
(char*)tmpbuf, count, datatype);
use_this_sendbuf = tmpbuf;
} else if (io_root == rank) {
tmpbuf = (char *) malloc(text + (count - 1) * ext);
if (NULL == tmpbuf) {
return MPI_ERR_INTERN;
}
use_this_recvbuf = tmpbuf;
}
}
/* Use generic reduce with in-order binary tree topology and io_root */
ret = smpi_coll_tuned_ompi_reduce_generic( use_this_sendbuf, use_this_recvbuf, count, datatype,
op, io_root, comm,
ompi_coll_tuned_topo_build_in_order_bintree(comm),
segcount, 0 );
if (MPI_SUCCESS != ret) { return ret; }
/* Clean up */
if (io_root != root) {
if (root == rank) {
/* Receive result from rank io_root to recvbuf */
smpi_mpi_recv(recvbuf, count, datatype, io_root,
COLL_TAG_REDUCE, comm,
MPI_STATUS_IGNORE);
if (MPI_IN_PLACE == sendbuf) {
free(use_this_sendbuf);
}
} else if (io_root == rank) {
/* Send result from use_this_recvbuf to root */
smpi_mpi_send(use_this_recvbuf, count, datatype, root,
COLL_TAG_REDUCE,
comm);
free(use_this_recvbuf);
}
}
return MPI_SUCCESS;
}
int
smpi_coll_tuned_allgather_rhv(void *sbuf, int send_count,
MPI_Datatype send_type, void *rbuf,
int recv_count, MPI_Datatype recv_type,
MPI_Comm comm)
{
MPI_Status status;
MPI_Aint s_extent, r_extent;
// local int variables
int i, dst, send_base_offset, recv_base_offset, send_chunk, recv_chunk,
send_offset, recv_offset;
int rank, num_procs;
int tag = 50;
int mask;
int curr_count;
// get size of the communicator, followed by rank
num_procs = smpi_comm_size(comm);
rank = smpi_comm_rank(comm);
// get size of single element's type for send buffer and recv buffer
s_extent = smpi_datatype_get_extent(send_type);
r_extent = smpi_datatype_get_extent(recv_type);
// multiply size of each element by number of elements to send or recv
send_chunk = s_extent * send_count;
recv_chunk = r_extent * recv_count;
if (send_chunk != recv_chunk) {
XBT_WARN("MPI_allgather_rhv use default MPI_allgather.");
smpi_mpi_allgather(sbuf, send_count, send_type, rbuf, recv_count,
recv_type, comm);
return MPI_SUCCESS;
}
// compute starting offset location to perform local copy
int size = num_procs / 2;
int base_offset = 0;
mask = 1;
while (mask < num_procs) {
if (rank & mask) {
base_offset += size;
}
mask <<= 1;
size /= 2;
}
// printf("node %d base_offset %d\n",rank,base_offset);
//perform a remote copy
dst = base_offset;
smpi_mpi_sendrecv(sbuf, send_count, send_type, dst, tag,
(char *)rbuf + base_offset * recv_chunk, recv_count, recv_type, dst, tag,
comm, &status);
mask >>= 1;
i = 1;
int phase = 0;
curr_count = recv_count;
while (mask >= 1) {
// destination pair for both send and recv
dst = rank ^ mask;
// compute offsets
send_base_offset = base_offset;
if (rank & mask) {
recv_base_offset = base_offset - i;
base_offset -= i;
} else {
recv_base_offset = base_offset + i;
}
send_offset = send_base_offset * recv_chunk;
recv_offset = recv_base_offset * recv_chunk;
// printf("node %d send to %d in phase %d s_offset = %d r_offset = %d count = %d\n",rank,dst,phase, send_base_offset, recv_base_offset, curr_count);
smpi_mpi_sendrecv((char *)rbuf + send_offset, curr_count, recv_type, dst, tag,
(char *)rbuf + recv_offset, curr_count, recv_type, dst, tag,
comm, &status);
curr_count *= 2;
i *= 2;
mask >>= 1;
phase++;
}
return MPI_SUCCESS;
}
/* Non-topology-specific pipelined linear-bcast function */
int smpi_coll_tuned_bcast_arrival_scatter(void *buf, int count,
MPI_Datatype datatype, int root,
MPI_Comm comm)
{
int tag = -COLL_TAG_BCAST;//in order to use ANY_TAG, make this one positive
int header_tag = 10;
MPI_Status status;
int curr_remainder;
int curr_size;
int curr_increment;
int send_offset;
int recv_offset;
int send_count;
int recv_count;
MPI_Status temp_status_array[BCAST_ARRIVAL_PATTERN_AWARE_MAX_NODE];
int rank, size;
int i, k;
int sent_count;
int header_index;
int flag_array[BCAST_ARRIVAL_PATTERN_AWARE_MAX_NODE];
int already_sent[BCAST_ARRIVAL_PATTERN_AWARE_MAX_NODE];
int header_buf[BCAST_ARRIVAL_PATTERN_AWARE_HEADER_SIZE];
char temp_buf[BCAST_ARRIVAL_PATTERN_AWARE_MAX_NODE];
int will_send[BCAST_ARRIVAL_PATTERN_AWARE_MAX_NODE];
int max_node = BCAST_ARRIVAL_PATTERN_AWARE_MAX_NODE;
int header_size = BCAST_ARRIVAL_PATTERN_AWARE_HEADER_SIZE;
MPI_Aint extent;
extent = smpi_datatype_get_extent(datatype);
/* source and destination */
int to, from;
rank = smpi_comm_rank(comm);
size = smpi_comm_size(comm);
/* message too small */
if (count < size) {
XBT_WARN("MPI_bcast_arrival_scatter use default MPI_bcast.");
smpi_mpi_bcast(buf, count, datatype, root, comm);
return MPI_SUCCESS;
}
/* if root is not zero send to rank zero first
this can be modified to make it faster by using logical src, dst.
*/
if (root != 0) {
if (rank == root) {
smpi_mpi_send(buf, count, datatype, 0, tag - 1, comm);
} else if (rank == 0) {
smpi_mpi_recv(buf, count, datatype, root, tag - 1, comm, &status);
}
}
/* value == 0 means root has not send data (or header) to the node yet */
for (i = 0; i < max_node; i++) {
already_sent[i] = 0;
}
/* start bcast */
/* root */
if (rank == 0) {
for (i = 0; i < max_node; i++)
will_send[i] = 0;
sent_count = 0;
while (sent_count < (size - 1)) {
for (k = 0; k < 3; k++) {
for (i = 1; i < size; i++) {
if ((already_sent[i] == 0) && (will_send[i] == 0)) {
smpi_mpi_iprobe(i, MPI_ANY_TAG, comm, &flag_array[i],
&temp_status_array[i]);
if (flag_array[i] == 1) {
will_send[i] = 1;
smpi_mpi_recv(&temp_buf[i], 1, MPI_CHAR, i, tag, comm,
&status);
i = 0;
}
}
}
}
header_index = 0;
/* recv 1-byte message in this round */
for (i = 1; i < size; i++) {
/* message arrive */
if ((will_send[i] == 1) && (already_sent[i] == 0)) {
header_buf[header_index] = i;
header_index++;
sent_count++;
/* will send in the next step */
already_sent[i] = 1;
}
}
/*
if (header_index != 0) {
printf("header index = %d node = ",header_index);
for (i=0;i<header_index;i++) {
printf("%d ",header_buf[i]);
}
printf("\n");
}
*/
/* send header followed by data */
if (header_index != 0) {
header_buf[header_index] = -1;
/* send header */
for (i = 0; i < header_index; i++) {
to = header_buf[i];
smpi_mpi_send(header_buf, header_size, MPI_INT, to, header_tag, comm);
}
curr_remainder = count % header_index;
curr_size = (count / header_index);
curr_increment = curr_size * extent;
/* send data */
for (i = 0; i < header_index; i++) {
to = header_buf[i];
if ((i == (header_index - 1)) || (curr_size == 0))
curr_size += curr_remainder;
//printf("Root send to %d index %d\n",to,(i*curr_increment));
smpi_mpi_send((char *) buf + (i * curr_increment), curr_size, datatype, to,
tag, comm);
}
}
} /* while (sent_count < size-1) */
}
/* rank 0 */
/* none root */
else {
/* send 1-byte message to root */
smpi_mpi_send(temp_buf, 1, MPI_CHAR, 0, tag, comm);
/* wait for header forward when required */
smpi_mpi_recv(header_buf, header_size, MPI_INT, 0, header_tag, comm, &status);
/* search for where it is */
int myordering = 0;
while (rank != header_buf[myordering]) {
myordering++;
}
int total_nodes = 0;
while (header_buf[total_nodes] != -1) {
total_nodes++;
}
curr_remainder = count % total_nodes;
curr_size = (count / total_nodes);
curr_increment = curr_size * extent;
int recv_size = curr_size;
/* receive data */
if (myordering == (total_nodes - 1))
recv_size += curr_remainder;
smpi_mpi_recv((char *) buf + (myordering * curr_increment), recv_size, datatype,
0, tag, comm, &status);
/* at this point all nodes in this set perform all-gather operation */
to = header_buf[myordering + 1];
from = header_buf[myordering - 1];
if (myordering == 0)
from = header_buf[total_nodes - 1];
if (myordering == (total_nodes - 1))
to = header_buf[0];
/* last segment may have a larger size since it also include the remainder */
int last_segment_ptr = (total_nodes - 1) * (count / total_nodes) * extent;
/* allgather */
for (i = 0; i < total_nodes - 1; i++) {
send_offset =
((myordering - i + total_nodes) % total_nodes) * curr_increment;
recv_offset =
((myordering - i - 1 + total_nodes) % total_nodes) * curr_increment;
/* adjust size */
if (send_offset != last_segment_ptr)
send_count = curr_size;
else
send_count = curr_size + curr_remainder;
if (recv_offset != last_segment_ptr)
recv_count = curr_size;
else
recv_count = curr_size + curr_remainder;
//printf("\t\tnode %d sent_to %d recv_from %d send_size %d recv_size %d\n",rank,to,from,send_count,recv_count);
//printf("\tnode %d sent_offset %d send_count %d\n",rank,send_offset,send_count);
smpi_mpi_sendrecv((char *) buf + send_offset, send_count, datatype, to,
tag + i, (char *) buf + recv_offset, recv_count, datatype,
from, tag + i, comm, &status);
}
} /* non-root */
return MPI_SUCCESS;
}
int smpi_coll_tuned_allreduce_rab_rsag(void *sbuff, void *rbuff, int count,
MPI_Datatype dtype, MPI_Op op,
MPI_Comm comm)
{
int nprocs, rank, tag = COLL_TAG_ALLREDUCE;
int mask, dst, pof2, newrank, rem, newdst, i,
send_idx, recv_idx, last_idx, send_cnt, recv_cnt, *cnts, *disps;
MPI_Aint extent;
MPI_Status status;
void *tmp_buf = NULL;
nprocs = smpi_comm_size(comm);
rank = smpi_comm_rank(comm);
extent = smpi_datatype_get_extent(dtype);
tmp_buf = (void *) xbt_malloc(count * extent);
smpi_mpi_sendrecv(sbuff, count, dtype, rank, tag, rbuff, count, dtype, rank, tag,
comm, &status);
// find nearest power-of-two less than or equal to comm_size
pof2 = 1;
while (pof2 <= nprocs)
pof2 <<= 1;
pof2 >>= 1;
rem = nprocs - 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) {
// even
if (rank % 2 == 0) {
smpi_mpi_send(rbuff, count, dtype, rank + 1, tag, comm);
// temporarily set the rank to -1 so that this
// process does not pariticipate in recursive
// doubling
newrank = -1;
} else // odd
{
smpi_mpi_recv(tmp_buf, count, dtype, rank - 1, tag, comm, &status);
// do the reduction on received data. since the
// ordering is right, it doesn't matter whether
// the operation is commutative or not.
smpi_op_apply(op, tmp_buf, rbuff, &count, &dtype);
// 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) {
// do a reduce-scatter followed by allgather. for the
// reduce-scatter, calculate the count that each process receives
// and the displacement within the buffer
cnts = (int *) xbt_malloc(pof2 * sizeof(int));
disps = (int *) xbt_malloc(pof2 * sizeof(int));
for (i = 0; i < (pof2 - 1); i++)
cnts[i] = count / pof2;
cnts[pof2 - 1] = count - (count / pof2) * (pof2 - 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
smpi_mpi_sendrecv((char *) rbuff + disps[send_idx] * extent, send_cnt,
dtype, dst, tag,
(char *) tmp_buf + disps[recv_idx] * extent, recv_cnt,
dtype, dst, tag, comm, &status);
// 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.
smpi_op_apply(op, (char *) tmp_buf + disps[recv_idx] * extent,
(char *) rbuff + disps[recv_idx] * extent,
&recv_cnt, &dtype);
// 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];
}
smpi_mpi_sendrecv((char *) rbuff + disps[send_idx] * extent, send_cnt,
dtype, dst, tag,
(char *) rbuff + disps[recv_idx] * extent, recv_cnt,
dtype, dst, tag, comm, &status);
if (newrank > newdst)
send_idx = recv_idx;
mask >>= 1;
}
free(cnts);
free(disps);
}
int smpi_coll_tuned_allgatherv_mpich_rdb (
void *sendbuf,
int sendcount,
MPI_Datatype sendtype,
void *recvbuf,
int *recvcounts,
int *displs,
MPI_Datatype recvtype,
MPI_Comm comm)
{
int comm_size, rank, j, i;
MPI_Status status;
MPI_Aint recvtype_extent, recvtype_true_extent, recvtype_true_lb;
int curr_cnt, dst, total_count;
void *tmp_buf, *tmp_buf_rl;
int mask, dst_tree_root, my_tree_root, position,
send_offset, recv_offset, last_recv_cnt=0, nprocs_completed, k,
offset, tmp_mask, tree_root;
comm_size = smpi_comm_size(comm);
rank = smpi_comm_rank(comm);
total_count = 0;
for (i=0; i<comm_size; i++)
total_count += recvcounts[i];
if (total_count == 0) return MPI_ERR_COUNT;
recvtype_extent=smpi_datatype_get_extent( recvtype);
/* need to receive contiguously into tmp_buf because
displs could make the recvbuf noncontiguous */
smpi_datatype_extent(recvtype, &recvtype_true_lb, &recvtype_true_extent);
tmp_buf_rl= (void*)smpi_get_tmp_sendbuffer(total_count*(MAX(recvtype_true_extent,recvtype_extent)));
/* adjust for potential negative lower bound in datatype */
tmp_buf = (void *)((char*)tmp_buf_rl - 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)
{
smpi_datatype_copy(sendbuf, sendcount, sendtype,
((char *)tmp_buf + position*
recvtype_extent),
recvcounts[rank], recvtype);
}
else
{
/* if in_place specified, local data is found in recvbuf */
smpi_datatype_copy(((char *)recvbuf +
displs[rank]*recvtype_extent),
recvcounts[rank], recvtype,
((char *)tmp_buf + position*
recvtype_extent),
recvcounts[rank], recvtype);
}
curr_cnt = recvcounts[rank];
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];
smpi_mpi_sendrecv(((char *)tmp_buf + send_offset * recvtype_extent),
curr_cnt, recvtype, dst,
COLL_TAG_ALLGATHERV,
((char *)tmp_buf + recv_offset * recvtype_extent),
total_count - recv_offset, recvtype, dst,
COLL_TAG_ALLGATHERV,
comm, &status);
/* for convenience, recv is posted for a bigger amount
than will be sent */
last_recv_cnt=smpi_mpi_get_count(&status, recvtype);
curr_cnt += last_recv_cnt;
}
/* 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) {
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)) {
offset = 0;
for (j=0; j<(my_tree_root+mask); j++)
offset += recvcounts[j];
offset *= recvtype_extent;
smpi_mpi_send(((char *)tmp_buf + offset),
last_recv_cnt,
recvtype, dst,
COLL_TAG_ALLGATHERV, comm);
/* last_recv_cnt was set in the previous
receive. that's the amount of data to be
sent now. */
}
/* 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];
smpi_mpi_recv(((char *)tmp_buf + offset * recvtype_extent),
total_count - offset, recvtype,
dst, COLL_TAG_ALLGATHERV,
comm, &status);
/* for convenience, recv is posted for a
bigger amount than will be sent */
last_recv_cnt=smpi_mpi_get_count(&status, recvtype);
curr_cnt += last_recv_cnt;
}
tmp_mask >>= 1;
k--;
}
}
/* --END EXPERIMENTAL-- */
mask <<= 1;
i++;
}
