/*@
MPI_Reduce_local - Applies a reduction operator to local arguments.
Input Parameters:
+ inbuf - address of the input buffer (choice)
. count - number of elements in each buffer (integer)
. datatype - data type of elements in the buffers (handle)
- op - reduction operation (handle)
Output Parameter:
. inoutbuf - address of input-output buffer (choice)
.N ThreadSafe
.N Fortran
.N collops
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COUNT
.N MPI_ERR_TYPE
.N MPI_ERR_BUFFER
.N MPI_ERR_BUFFER_ALIAS
@*/
int MPI_Reduce_local(void *inbuf, void *inoutbuf, int count, MPI_Datatype datatype, MPI_Op op)
{
int mpi_errno = MPI_SUCCESS;
MPID_Op *op_ptr;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_REDUCE_LOCAL);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_COLL_FUNC_ENTER(MPID_STATE_MPI_REDUCE_LOCAL);
/* Validate parameters */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_OP(op, mpi_errno);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
if (HANDLE_GET_KIND(op) != HANDLE_KIND_BUILTIN) {
MPID_Op_get_ptr(op, op_ptr);
MPID_Op_valid_ptr( op_ptr, mpi_errno );
}
if (HANDLE_GET_KIND(op) == HANDLE_KIND_BUILTIN) {
mpi_errno = (*MPIR_Op_check_dtype_table[op%16 - 1])(datatype);
}
if (count != 0) {
MPIR_ERRTEST_ALIAS_COLL(inbuf, inoutbuf, mpi_errno);
}
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Reduce_local_impl(inbuf, inoutbuf, count, datatype, op);
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_COLL_FUNC_EXIT(MPID_STATE_MPI_REDUCE_LOCAL);
MPIU_THREAD_CS_EXIT(ALLFUNC,);
return mpi_errno;
fn_fail:
/* --BEGIN ERROR HANDLING-- */
# ifdef HAVE_ERROR_CHECKING
{
mpi_errno = MPIR_Err_create_code(
mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_reduce_local",
"**mpi_reduce_local %p %p %d %D %O", inbuf, inoutbuf, count, datatype, op);
}
# endif
mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Alltoallv - Sends data from all to all processes; each process may
send a different amount of data and provide displacements for the input
and output data.
Input Parameters:
+ sendbuf - starting address of send buffer (choice)
. sendcounts - integer array equal to the group size
specifying the number of elements to send to each processor
. sdispls - integer array (of length group size). Entry
'j' specifies the displacement (relative to sendbuf from
which to take the outgoing data destined for process 'j'
. sendtype - data type of send buffer elements (handle)
. recvcounts - integer array equal to the group size
specifying the maximum number of elements that can be received from
each processor
. rdispls - integer array (of length group size). Entry
'i' specifies the displacement (relative to recvbuf at
which to place the incoming data from process 'i'
. recvtype - data type of receive buffer elements (handle)
- comm - communicator (handle)
Output Parameters:
. recvbuf - address of receive buffer (choice)
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_ERR_COMM
.N MPI_ERR_COUNT
.N MPI_ERR_TYPE
.N MPI_ERR_BUFFER
@*/
int MPI_Alltoallv(const void *sendbuf, const int *sendcounts,
const int *sdispls, MPI_Datatype sendtype, void *recvbuf,
const int *recvcounts, const int *rdispls, MPI_Datatype recvtype,
MPI_Comm comm)
{
int mpi_errno = MPI_SUCCESS;
MPID_Comm *comm_ptr = NULL;
MPIR_Errflag_t errflag = MPIR_ERR_NONE;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_ALLTOALLV);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPID_MPI_COLL_FUNC_ENTER(MPID_STATE_MPI_ALLTOALLV);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_COMM(comm, mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* Convert MPI object handles to object pointers */
MPID_Comm_get_ptr( comm, comm_ptr );
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPID_Datatype *sendtype_ptr=NULL, *recvtype_ptr=NULL;
int i, comm_size;
int check_send = (comm_ptr->comm_kind == MPID_INTRACOMM && sendbuf != MPI_IN_PLACE);
MPID_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE );
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
if (comm_ptr->comm_kind == MPID_INTRACOMM) {
comm_size = comm_ptr->local_size;
if (sendbuf != MPI_IN_PLACE && sendtype == recvtype && sendcounts == recvcounts)
MPIR_ERRTEST_ALIAS_COLL(sendbuf, recvbuf, mpi_errno);
} else
comm_size = comm_ptr->remote_size;
if (comm_ptr->comm_kind == MPID_INTERCOMM && sendbuf == MPI_IN_PLACE) {
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**sendbuf_inplace");
}
for (i=0; i<comm_size; i++) {
if (check_send) {
MPIR_ERRTEST_COUNT(sendcounts[i], mpi_errno);
MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno);
}
MPIR_ERRTEST_COUNT(recvcounts[i], mpi_errno);
MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno);
}
if (check_send && HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) {
MPID_Datatype_get_ptr(sendtype, sendtype_ptr);
MPID_Datatype_valid_ptr( sendtype_ptr, mpi_errno );
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
MPID_Datatype_committed_ptr( sendtype_ptr, mpi_errno );
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) {
MPID_Datatype_get_ptr(recvtype, recvtype_ptr);
MPID_Datatype_valid_ptr( recvtype_ptr, mpi_errno );
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
MPID_Datatype_committed_ptr( recvtype_ptr, mpi_errno );
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
for (i=0; i<comm_size && check_send; i++) {
if (sendcounts[i] > 0) {
MPIR_ERRTEST_USERBUFFER(sendbuf,sendcounts[i],sendtype,mpi_errno);
}
}
for (i=0; i<comm_size; i++) {
if (recvcounts[i] > 0) {
MPIR_ERRTEST_RECVBUF_INPLACE(recvbuf, recvcounts[i], mpi_errno);
MPIR_ERRTEST_USERBUFFER(recvbuf,recvcounts[i],recvtype,mpi_errno);
break;
}
}
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Alltoallv_impl(sendbuf, sendcounts, sdispls,
sendtype, recvbuf, recvcounts,
rdispls, recvtype, comm_ptr, &errflag);
if (mpi_errno) goto fn_fail;
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_COLL_FUNC_EXIT(MPID_STATE_MPI_ALLTOALLV);
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
return mpi_errno;
fn_fail:
/* --BEGIN ERROR HANDLING-- */
# ifdef HAVE_ERROR_CHECKING
{
mpi_errno = MPIR_Err_create_code(
mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_alltoallv",
"**mpi_alltoallv %p %p %p %D %p %p %p %D %C", sendbuf, sendcounts, sdispls, sendtype,
recvbuf, recvcounts, rdispls, recvtype, comm);
}
# endif
mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Allreduce - Combines values from all processes and distributes the result
back to all processes
Input Parameters:
+ sendbuf - starting address of send buffer (choice)
. count - number of elements in send buffer (integer)
. datatype - data type of elements of send buffer (handle)
. op - operation (handle)
- comm - communicator (handle)
Output Parameter:
. recvbuf - starting address of receive buffer (choice)
.N ThreadSafe
.N Fortran
.N collops
.N Errors
.N MPI_ERR_BUFFER
.N MPI_ERR_COUNT
.N MPI_ERR_TYPE
.N MPI_ERR_OP
.N MPI_ERR_COMM
@*/
int MPI_Allreduce ( void *sendbuf, void *recvbuf, int count,
MPI_Datatype datatype, MPI_Op op, MPI_Comm comm )
{
static const char FCNAME[] = "MPI_Allreduce";
int mpi_errno = MPI_SUCCESS;
MPID_Comm *comm_ptr = NULL;
int errflag = FALSE;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_ALLREDUCE);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_COLL_FUNC_ENTER(MPID_STATE_MPI_ALLREDUCE);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_COMM(comm, mpi_errno);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* Convert MPI object handles to object pointers */
MPID_Comm_get_ptr( comm, comm_ptr );
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPID_Datatype *datatype_ptr = NULL;
MPID_Op *op_ptr = NULL;
MPID_Comm_valid_ptr( comm_ptr, mpi_errno );
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
MPIR_ERRTEST_COUNT(count, mpi_errno);
MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);
MPIR_ERRTEST_OP(op, mpi_errno);
if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN) {
MPID_Datatype_get_ptr(datatype, datatype_ptr);
MPID_Datatype_valid_ptr( datatype_ptr, mpi_errno );
MPID_Datatype_committed_ptr( datatype_ptr, mpi_errno );
}
if (comm_ptr->comm_kind == MPID_INTERCOMM)
MPIR_ERRTEST_SENDBUF_INPLACE(sendbuf, count, mpi_errno);
if (sendbuf != MPI_IN_PLACE)
MPIR_ERRTEST_USERBUFFER(sendbuf,count,datatype,mpi_errno);
MPIR_ERRTEST_RECVBUF_INPLACE(recvbuf, count, mpi_errno);
MPIR_ERRTEST_USERBUFFER(recvbuf,count,datatype,mpi_errno);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
if (HANDLE_GET_KIND(op) != HANDLE_KIND_BUILTIN) {
MPID_Op_get_ptr(op, op_ptr);
MPID_Op_valid_ptr( op_ptr, mpi_errno );
}
if (HANDLE_GET_KIND(op) == HANDLE_KIND_BUILTIN) {
mpi_errno =
( * MPIR_Op_check_dtype_table[op%16 - 1] )(datatype);
}
if (count != 0) {
MPIR_ERRTEST_ALIAS_COLL(sendbuf, recvbuf, mpi_errno);
}
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Allreduce_impl(sendbuf, recvbuf, count, datatype, op, comm_ptr, &errflag);
if (mpi_errno) goto fn_fail;
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_COLL_FUNC_EXIT(MPID_STATE_MPI_ALLREDUCE);
MPIU_THREAD_CS_EXIT(ALLFUNC,);
return mpi_errno;
fn_fail:
/* --BEGIN ERROR HANDLING-- */
# ifdef HAVE_ERROR_CHECKING
{
mpi_errno = MPIR_Err_create_code(
mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_allreduce",
"**mpi_allreduce %p %p %d %D %O %C", sendbuf, recvbuf, count, datatype, op, comm);
}
# endif
mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Barrier - Blocks until all processes in the communicator have
reached this routine.
Input Parameters:
. comm - communicator (handle)
Notes:
Blocks the caller until all processes in the communicator have called it;
that is, the call returns at any process only after all members of the
communicator have entered the call.
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
@*/
int MPI_Barrier( MPI_Comm comm )
{
int mpi_errno = MPI_SUCCESS;
MPID_Comm *comm_ptr = NULL;
MPIR_Errflag_t errflag = MPIR_ERR_NONE;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_BARRIER);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPID_MPI_COLL_FUNC_ENTER(MPID_STATE_MPI_BARRIER);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_COMM(comm, mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* Convert MPI object handles to object pointers */
MPID_Comm_get_ptr( comm, comm_ptr );
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate communicator */
MPID_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE );
if (mpi_errno) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Barrier_impl(comm_ptr, &errflag);
if (mpi_errno) goto fn_fail;
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_COLL_FUNC_EXIT(MPID_STATE_MPI_BARRIER);
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
return mpi_errno;
fn_fail:
/* --BEGIN ERROR HANDLING-- */
# ifdef HAVE_ERROR_CHECKING
{
mpi_errno = MPIR_Err_create_code(
mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER,
"**mpi_barrier", "**mpi_barrier %C", comm);
}
# endif
mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
