/*@
MPI_Unpack - Unpack a buffer according to a datatype into contiguous memory
Input Parameters:
+ inbuf - input buffer start (choice)
. insize - size of input buffer, in bytes (integer)
. outcount - number of items to be unpacked (integer)
. datatype - datatype of each output data item (handle)
- comm - communicator for packed message (handle)
Output Parameters:
. outbuf - output buffer start (choice)
Inout/Output Parameters:
. position - current position in bytes (integer)
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
.N MPI_ERR_COUNT
.N MPI_ERR_TYPE
.N MPI_ERR_ARG
.seealso: MPI_Pack, MPI_Pack_size
@*/
int MPI_Unpack(const void *inbuf, int insize, int *position,
void *outbuf, int outcount, MPI_Datatype datatype, MPI_Comm comm)
{
int mpi_errno = MPI_SUCCESS;
MPI_Aint position_x;
MPIR_Comm *comm_ptr = NULL;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_UNPACK);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_UNPACK);
/* 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
/* Convert MPI object handles to object pointers */
MPIR_Comm_get_ptr(comm, comm_ptr);
/* Validate parameters and objects (post conversion) */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
if (insize > 0) {
MPIR_ERRTEST_ARGNULL(inbuf, "input buffer", mpi_errno);
}
/* Note: outbuf could be MPI_BOTTOM; don't test for NULL */
MPIR_ERRTEST_COUNT(insize, mpi_errno);
MPIR_ERRTEST_COUNT(outcount, mpi_errno);
/* Validate comm_ptr */
MPIR_Comm_valid_ptr(comm_ptr, mpi_errno, FALSE);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
/* If comm_ptr is not valid, it will be reset to null */
MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);
if (datatype != MPI_DATATYPE_NULL && HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN) {
MPIR_Datatype *datatype_ptr = NULL;
MPIR_Datatype_get_ptr(datatype, datatype_ptr);
MPIR_Datatype_valid_ptr(datatype_ptr, mpi_errno);
MPIR_Datatype_committed_ptr(datatype_ptr, mpi_errno);
}
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
position_x = *position;
mpi_errno = MPIR_Unpack_impl(inbuf, insize, &position_x, outbuf, outcount, datatype);
if (mpi_errno)
goto fn_fail;
MPIR_Assign_trunc(*position, position_x, int);
/* ... end of body of routine ... */
fn_exit:
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_UNPACK);
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_unpack", "**mpi_unpack %p %d %p %p %d %D %C", inbuf, insize,
position, outbuf, outcount, datatype, comm);
}
#endif
mpi_errno = MPIR_Err_return_comm(comm_ptr, FCNAME, mpi_errno);
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Rsend - Blocking ready send
Input Parameters:
+ buf - initial address of send buffer (choice)
. count - number of elements in send buffer (nonnegative integer)
. datatype - datatype of each send buffer element (handle)
. dest - rank of destination (integer)
. tag - message tag (integer)
- comm - communicator (handle)
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
.N MPI_ERR_COUNT
.N MPI_ERR_TYPE
.N MPI_ERR_TAG
.N MPI_ERR_RANK
@*/
int MPI_Rsend(const void *buf, int count, MPI_Datatype datatype, int dest, int tag,
MPI_Comm comm)
{
static const char FCNAME[] = "MPI_Rsend";
int mpi_errno = MPI_SUCCESS;
MPID_Comm *comm_ptr = NULL;
MPID_Request * request_ptr = NULL;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_RSEND);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPID_MPI_PT2PT_FUNC_ENTER_FRONT(MPID_STATE_MPI_RSEND);
/* Validate handle parameters 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 if error checking is enabled */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPID_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE );
if (mpi_errno) goto fn_fail;
MPIR_ERRTEST_COUNT(count, mpi_errno);
MPIR_ERRTEST_SEND_RANK(comm_ptr, dest, mpi_errno);
MPIR_ERRTEST_SEND_TAG(tag, mpi_errno);
/* Validate datatype handle */
MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);
/* Validate datatype object */
if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN)
{
MPID_Datatype *datatype_ptr = NULL;
MPID_Datatype_get_ptr(datatype, datatype_ptr);
MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno);
if (mpi_errno) goto fn_fail;
MPID_Datatype_committed_ptr(datatype_ptr, mpi_errno);
if (mpi_errno) goto fn_fail;
}
/* Validate buffer */
MPIR_ERRTEST_USERBUFFER(buf,count,datatype,mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPID_Rsend(buf, count, datatype, dest, tag, comm_ptr,
MPID_CONTEXT_INTRA_PT2PT, &request_ptr);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
if (request_ptr == NULL)
{
goto fn_exit;
}
/* If a request was returned, then we need to block until the request
is complete */
if (!MPID_Request_is_complete(request_ptr))
{
MPID_Progress_state progress_state;
MPID_Progress_start(&progress_state);
while (!MPID_Request_is_complete(request_ptr))
{
mpi_errno = MPID_Progress_wait(&progress_state);
if (mpi_errno != MPI_SUCCESS)
{
/* --BEGIN ERROR HANDLING-- */
MPID_Progress_end(&progress_state);
goto fn_fail;
/* --END ERROR HANDLING-- */
}
}
MPID_Progress_end(&progress_state);
}
mpi_errno = request_ptr->status.MPI_ERROR;
MPID_Request_release(request_ptr);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_PT2PT_FUNC_EXIT(MPID_STATE_MPI_RSEND);
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_rsend",
"**mpi_rsend %p %d %D %i %t %C", buf, count, datatype, dest, tag, comm);
}
# endif
mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Neighbor_alltoall - In this function, each process i receives data items
from each process j if an edge (j,i) exists in the topology graph or Cartesian
topology. Similarly, each process i sends data items to all processes j where an
edge (i,j) exists. This call is more general than MPI_NEIGHBOR_ALLGATHER in that
different data items can be sent to each neighbor. The k-th block in send buffer
is sent to the k-th neighboring process and the l-th block in the receive buffer
is received from the l-th neighbor.
Input Parameters:
+ sendbuf - starting address of the send buffer (choice)
. sendcount - number of elements sent to each neighbor (non-negative integer)
. sendtype - data type of send buffer elements (handle)
. recvcount - number of elements received from each neighbor (non-negative integer)
. recvtype - data type of receive buffer elements (handle)
- comm - communicator (handle)
Output Parameters:
. recvbuf - starting address of the receive buffer (choice)
.N ThreadSafe
.N Fortran
.N Errors
@*/
int MPI_Neighbor_alltoall(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm)
{
int mpi_errno = MPI_SUCCESS;
MPID_Comm *comm_ptr = NULL;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_NEIGHBOR_ALLTOALL);
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_NEIGHBOR_ALLTOALL);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS
{
MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno);
MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno);
MPIR_ERRTEST_COMM(comm, mpi_errno);
/* TODO more checks may be appropriate */
}
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
{
if (HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) {
MPID_Datatype *sendtype_ptr = NULL;
MPID_Datatype_get_ptr(sendtype, sendtype_ptr);
MPID_Datatype_valid_ptr(sendtype_ptr, mpi_errno);
MPID_Datatype_committed_ptr(sendtype_ptr, mpi_errno);
}
if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) {
MPID_Datatype *recvtype_ptr = NULL;
MPID_Datatype_get_ptr(recvtype, recvtype_ptr);
MPID_Datatype_valid_ptr(recvtype_ptr, mpi_errno);
MPID_Datatype_committed_ptr(recvtype_ptr, mpi_errno);
}
MPID_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE );
/* TODO more checks may be appropriate (counts, in_place, buffer aliasing, etc) */
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
MPID_END_ERROR_CHECKS
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Neighbor_alltoall_impl(sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, comm_ptr);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_NEIGHBOR_ALLTOALL);
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_neighbor_alltoall", "**mpi_neighbor_alltoall %p %d %D %p %d %D %C", sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, comm);
}
# endif
mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno);
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Intercomm_create - Creates an intercommuncator from two intracommunicators
Input Parameters:
+ local_comm - Local (intra)communicator
. local_leader - Rank in local_comm of leader (often 0)
. peer_comm - Communicator used to communicate between a
designated process in the other communicator.
Significant only at the process in 'local_comm' with
rank 'local_leader'.
. remote_leader - Rank in peer_comm of remote leader (often 0)
- tag - Message tag to use in constructing intercommunicator; if multiple
'MPI_Intercomm_creates' are being made, they should use different tags (more
precisely, ensure that the local and remote leaders are using different
tags for each 'MPI_intercomm_create').
Output Parameters:
. newintercomm - Created intercommunicator
Notes:
'peer_comm' is significant only for the process designated the
'local_leader' in the 'local_comm'.
The MPI 1.1 Standard contains two mutually exclusive comments on the
input intercommunicators. One says that their repective groups must be
disjoint; the other that the leaders can be the same process. After
some discussion by the MPI Forum, it has been decided that the groups must
be disjoint. Note that the `reason` given for this in the standard is
`not` the reason for this choice; rather, the `other` operations on
intercommunicators (like 'MPI_Intercomm_merge') do not make sense if the
groups are not disjoint.
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
.N MPI_ERR_TAG
.N MPI_ERR_EXHAUSTED
.N MPI_ERR_RANK
.seealso: MPI_Intercomm_merge, MPI_Comm_free, MPI_Comm_remote_group,
MPI_Comm_remote_size
@*/
int MPI_Intercomm_create(MPI_Comm local_comm, int local_leader,
MPI_Comm peer_comm, int remote_leader, int tag,
MPI_Comm *newintercomm)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Comm *local_comm_ptr = NULL;
MPIR_Comm *peer_comm_ptr = NULL;
MPIR_Comm *new_intercomm_ptr;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_INTERCOMM_CREATE);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_INTERCOMM_CREATE);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_COMM_TAG(tag, mpi_errno);
MPIR_ERRTEST_COMM(local_comm, mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* Convert MPI object handles to object pointers */
MPIR_Comm_get_ptr( local_comm, local_comm_ptr );
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate local_comm_ptr */
MPIR_Comm_valid_ptr( local_comm_ptr, mpi_errno, FALSE );
if (local_comm_ptr) {
/* Only check if local_comm_ptr valid */
MPIR_ERRTEST_COMM_INTRA(local_comm_ptr, mpi_errno );
if ((local_leader < 0 ||
local_leader >= local_comm_ptr->local_size)) {
MPIR_ERR_SET2(mpi_errno,MPI_ERR_RANK,
"**ranklocal", "**ranklocal %d %d",
local_leader, local_comm_ptr->local_size - 1 );
/* If local_comm_ptr is not valid, it will be reset to null */
if (mpi_errno) goto fn_fail;
}
if (local_comm_ptr->rank == local_leader) {
MPIR_ERRTEST_COMM(peer_comm, mpi_errno);
}
}
MPIR_ERRTEST_ARGNULL(newintercomm, "newintercomm", mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
if (local_comm_ptr->rank == local_leader) {
MPIR_Comm_get_ptr( peer_comm, peer_comm_ptr );
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_Comm_valid_ptr( peer_comm_ptr, mpi_errno, FALSE );
/* Note: In MPI 1.0, peer_comm was restricted to
intracommunicators. In 1.1, it may be any communicator */
/* In checking the rank of the remote leader,
allow the peer_comm to be in intercommunicator
by checking against the remote size */
if (!mpi_errno && peer_comm_ptr &&
(remote_leader < 0 ||
remote_leader >= peer_comm_ptr->remote_size)) {
MPIR_ERR_SET2(mpi_errno,MPI_ERR_RANK,
"**rankremote", "**rankremote %d %d",
remote_leader, peer_comm_ptr->remote_size - 1 );
}
/* Check that the local leader and the remote leader are
different processes. This test requires looking at
the lpid for the two ranks in their respective
communicators. However, an easy test is for
the same ranks in an intracommunicator; we only
need the lpid comparison for intercommunicators */
/* Here is the test. We restrict this test to the
process that is the local leader (local_comm_ptr->rank ==
local_leader because we can then use peer_comm_ptr->rank
to get the rank in peer_comm of the local leader. */
if (peer_comm_ptr->comm_kind == MPIR_COMM_KIND__INTRACOMM &&
local_comm_ptr->rank == local_leader &&
peer_comm_ptr->rank == remote_leader) {
MPIR_ERR_SET(mpi_errno,MPI_ERR_RANK,"**ranksdistinct");
}
if (mpi_errno) goto fn_fail;
MPIR_ERRTEST_ARGNULL(newintercomm, "newintercomm", mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
}
/* ... body of routine ... */
mpi_errno = MPIR_Intercomm_create_impl(local_comm_ptr, local_leader, peer_comm_ptr,
remote_leader, tag, &new_intercomm_ptr);
if (mpi_errno) goto fn_fail;
MPIR_OBJ_PUBLISH_HANDLE(*newintercomm, new_intercomm_ptr->handle);
/* ... end of body of routine ... */
fn_exit:
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_INTERCOMM_CREATE);
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_intercomm_create",
"**mpi_intercomm_create %C %d %C %d %d %p", local_comm,
local_leader, peer_comm, remote_leader, tag, newintercomm);
}
# endif /* HAVE_ERROR_CHECKING */
mpi_errno = MPIR_Err_return_comm( local_comm_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Graph_neighbors - Returns the neighbors of a node associated
with a graph topology
Input Parameters:
+ comm - communicator with graph topology (handle)
. rank - rank of process in group of comm (integer)
- maxneighbors - size of array neighbors (integer)
Output Parameters:
. neighbors - ranks of processes that are neighbors to specified process
(array of integer)
.N SignalSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_TOPOLOGY
.N MPI_ERR_COMM
.N MPI_ERR_ARG
.N MPI_ERR_RANK
@*/
int MPI_Graph_neighbors(MPI_Comm comm, int rank, int maxneighbors,
int neighbors[])
{
int mpi_errno = MPI_SUCCESS;
MPID_Comm *comm_ptr = NULL;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_GRAPH_NEIGHBORS);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_GRAPH_NEIGHBORS);
/* 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
/* 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 comm_ptr */
MPID_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE );
if (mpi_errno) goto fn_fail;
/* If comm_ptr is not valid, it will be reset to null */
MPIR_ERRTEST_ARGNULL(neighbors,"neighbors",mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Graph_neighbors_impl(comm_ptr, rank, maxneighbors, neighbors);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_GRAPH_NEIGHBORS);
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_graph_neighbors",
"**mpi_graph_neighbors %C %d %d %p", comm, rank, maxneighbors, neighbors);
}
# endif
mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Cart_rank - Determines process rank in communicator given Cartesian
location
Input Parameters:
+ comm - communicator with cartesian structure (handle)
- coords - integer array (of size 'ndims', the number of dimensions of
the Cartesian topology associated with 'comm') specifying the cartesian
coordinates of a process
Output Parameters:
. rank - rank of specified process (integer)
Notes:
Out-of-range coordinates are erroneous for non-periodic dimensions.
Versions of MPICH before 1.2.2 returned 'MPI_PROC_NULL' for the rank in this
case.
.N SignalSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_TOPOLOGY
.N MPI_ERR_RANK
.N MPI_ERR_ARG
@*/
int MPI_Cart_rank(MPI_Comm comm, const int coords[], int *rank)
{
int mpi_errno = MPI_SUCCESS;
MPID_Comm *comm_ptr = NULL;
MPIR_Topology *cart_ptr;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_CART_RANK);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_CART_RANK);
/* 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
/* Convert MPI object handles to object pointers */
MPID_Comm_get_ptr( comm, comm_ptr );
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate comm_ptr */
MPID_Comm_valid_ptr( comm_ptr, mpi_errno, TRUE );
if (mpi_errno) goto fn_fail;
/* If comm_ptr is not valid, it will be reset to null */
MPIR_ERRTEST_ARGNULL(rank,"rank",mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
cart_ptr = MPIR_Topology_get( comm_ptr );
MPIR_ERR_CHKANDJUMP((!cart_ptr || cart_ptr->kind != MPI_CART), mpi_errno, MPI_ERR_TOPOLOGY, "**notcarttopo");
/* Validate coordinates */
# ifdef HAVE_ERROR_CHECKING
{
int i, ndims, coord;
MPID_BEGIN_ERROR_CHECKS;
{
ndims = cart_ptr->topo.cart.ndims;
if (ndims != 0) {
MPIR_ERRTEST_ARGNULL(coords,"coords",mpi_errno);
}
for (i=0; i<ndims; i++) {
if (!cart_ptr->topo.cart.periodic[i]) {
coord = coords[i];
MPIR_ERR_CHKANDJUMP3(
(coord < 0 || coord >= cart_ptr->topo.cart.dims[i] ), mpi_errno, MPI_ERR_ARG, "**cartcoordinvalid",
"**cartcoordinvalid %d %d %d",i, coords[i], cart_ptr->topo.cart.dims[i]-1 );
}
}
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
MPIR_Cart_rank_impl(cart_ptr, coords, rank);
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_CART_RANK);
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_cart_rank",
"**mpi_cart_rank %C %p %p", comm, coords, rank);
}
# endif
mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Comm_join - Create a communicator by joining two processes connected by
a socket.
Input Parameters:
. fd - socket file descriptor
Output Parameters:
. intercomm - new intercommunicator (handle)
Notes:
The socket must be quiescent before 'MPI_COMM_JOIN' is called and after
'MPI_COMM_JOIN' returns. More specifically, on entry to 'MPI_COMM_JOIN', a
read on the socket will not read any data that was written to the socket
before the remote process called 'MPI_COMM_JOIN'.
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_ARG
@*/
int MPI_Comm_join(int fd, MPI_Comm *intercomm)
{
static const char FCNAME[] = "MPI_Comm_join";
int mpi_errno = MPI_SUCCESS, err;
MPID_Comm *intercomm_ptr;
char *local_port, *remote_port;
MPIU_CHKLMEM_DECL(2);
MPID_MPI_STATE_DECL(MPID_STATE_MPI_COMM_JOIN);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_COMM_JOIN);
/* ... body of routine ... */
MPIU_CHKLMEM_MALLOC(local_port, char *, MPI_MAX_PORT_NAME, mpi_errno, "local port name");
MPIU_CHKLMEM_MALLOC(remote_port, char *, MPI_MAX_PORT_NAME, mpi_errno, "remote port name");
mpi_errno = MPIR_Open_port_impl(NULL, local_port);
MPIR_ERR_CHKANDJUMP((mpi_errno != MPI_SUCCESS), mpi_errno, MPI_ERR_OTHER, "**openportfailed");
err = MPIR_fd_send(fd, local_port, MPI_MAX_PORT_NAME);
MPIR_ERR_CHKANDJUMP1((err != 0), mpi_errno, MPI_ERR_INTERN, "**join_send", "**join_send %d", err);
err = MPIR_fd_recv(fd, remote_port, MPI_MAX_PORT_NAME);
MPIR_ERR_CHKANDJUMP1((err != 0), mpi_errno, MPI_ERR_INTERN, "**join_recv", "**join_recv %d", err);
MPIR_ERR_CHKANDJUMP2((strcmp(local_port, remote_port) == 0), mpi_errno, MPI_ERR_INTERN, "**join_portname",
"**join_portname %s %s", local_port, remote_port);
if (strcmp(local_port, remote_port) < 0) {
MPID_Comm *comm_self_ptr;
MPID_Comm_get_ptr( MPI_COMM_SELF, comm_self_ptr );
mpi_errno = MPIR_Comm_accept_impl(local_port, NULL, 0, comm_self_ptr, &intercomm_ptr);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
} else {
MPID_Comm *comm_self_ptr;
MPID_Comm_get_ptr( MPI_COMM_SELF, comm_self_ptr );
mpi_errno = MPIR_Comm_connect_impl(remote_port, NULL, 0, comm_self_ptr, &intercomm_ptr);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
}
mpi_errno = MPIR_Close_port_impl(local_port);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_OBJ_PUBLISH_HANDLE(*intercomm, intercomm_ptr->handle);
/* ... end of body of routine ... */
fn_exit:
MPIU_CHKLMEM_FREEALL();
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_COMM_JOIN);
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_comm_join",
"**mpi_comm_join %d %p", fd, intercomm);
}
# endif
mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Group_excl - Produces a group by reordering an existing group and taking
only unlisted members
Input Parameters:
+ group - group (handle)
. n - number of elements in array 'ranks' (integer)
- ranks - array of integer ranks in 'group' not to appear in 'newgroup'
Output Parameters:
. newgroup - new group derived from above, preserving the order defined by
'group' (handle)
Note:
The MPI standard requires that each of the ranks to excluded must be
a valid rank in the group and all elements must be distinct or the
function is erroneous.
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_GROUP
.N MPI_ERR_EXHAUSTED
.N MPI_ERR_ARG
.N MPI_ERR_RANK
.seealso: MPI_Group_free
@*/
int MPI_Group_excl(MPI_Group group, int n, const int ranks[], MPI_Group *newgroup)
{
int mpi_errno = MPI_SUCCESS;
MPID_Group *group_ptr = NULL, *new_group_ptr;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_GROUP_EXCL);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_GROUP_EXCL);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_GROUP(group, mpi_errno);
MPIR_ERRTEST_ARGNEG(n,"n",mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif
/* Convert MPI object handles to object pointers */
MPID_Group_get_ptr( group, group_ptr );
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate group_ptr */
MPID_Group_valid_ptr( group_ptr, mpi_errno );
/* If group_ptr is not valid, it will be reset to null */
if (group_ptr) {
mpi_errno = MPIR_Group_check_valid_ranks( group_ptr,
ranks, n );
}
if (mpi_errno) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
if (group_ptr->size == n) {
*newgroup = MPI_GROUP_EMPTY;
goto fn_exit;
}
mpi_errno = MPIR_Group_excl_impl(group_ptr, n, ranks, &new_group_ptr);
if (mpi_errno) goto fn_fail;
MPID_OBJ_PUBLISH_HANDLE(*newgroup, new_group_ptr->handle);
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_GROUP_EXCL);
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_group_excl",
"**mpi_group_excl %G %d %p %p", group, n, ranks, newgroup);
}
# endif
mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Comm_set_name - Sets the print name for a communicator
Input Parameters:
+ comm - communicator to name (handle)
- comm_name - Name for communicator
.N ThreadSafeNoUpdate
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
@*/
int MPI_Comm_set_name(MPI_Comm comm, const char *comm_name)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Comm *comm_ptr = NULL;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_COMM_SET_NAME);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_COMM_SET_NAME);
/* 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 */
MPIR_Comm_get_ptr(comm, comm_ptr);
/* Validate parameters and objects (post conversion) */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate comm_ptr */
MPIR_Comm_valid_ptr(comm_ptr, mpi_errno, TRUE);
if (mpi_errno)
goto fn_fail;
MPIR_ERRTEST_ARGNULL(comm_name, "comm_name", mpi_errno);
/* If comm_ptr is not valid, it will be reset to null */
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr));
MPL_strncpy(comm_ptr->name, comm_name, MPI_MAX_OBJECT_NAME);
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr));
/* ... end of body of routine ... */
#ifdef HAVE_ERROR_CHECKING
fn_exit:
#endif
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_COMM_SET_NAME);
return mpi_errno;
/* --BEGIN ERROR HANDLING-- */
#ifdef HAVE_ERROR_CHECKING
fn_fail:
{
mpi_errno =
MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER,
"**mpi_comm_set_name", "**mpi_comm_set_name %C %s", comm,
comm_name);
}
mpi_errno = MPIR_Err_return_comm(comm_ptr, FCNAME, mpi_errno);
goto fn_exit;
#endif
/* --END ERROR HANDLING-- */
}
/*@
MPI_Comm_dup_with_info - Duplicates an existing communicator with all its cached
information
Input Parameters:
+ comm - Communicator to be duplicated (handle)
- info - info object (handle)
Output Parameters:
. newcomm - A new communicator over the same group as 'comm' but with a new
context. See notes. (handle)
Notes:
MPI_COMM_DUP_WITH_INFO behaves exactly as MPI_COMM_DUP except that
the info hints associated with the communicator comm are not
duplicated in newcomm. The hints provided by the argument info are
associated with the output communicator newcomm instead.
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
.seealso: MPI_Comm_dup, MPI_Comm_free, MPI_Keyval_create,
MPI_Attr_put, MPI_Attr_delete, MPI_Comm_create_keyval,
MPI_Comm_set_attr, MPI_Comm_delete_attr
@*/
int MPI_Comm_dup_with_info(MPI_Comm comm, MPI_Info info, MPI_Comm * newcomm)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Comm *comm_ptr = NULL, *newcomm_ptr;
MPIR_Info *info_ptr = NULL;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_COMM_DUP_WITH_INFO);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_COMM_DUP_WITH_INFO);
/* 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 */
MPIR_Comm_get_ptr(comm, comm_ptr);
MPIR_Info_get_ptr(info, info_ptr);
/* Validate parameters and objects (post conversion) */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate comm_ptr */
MPIR_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE );
if (mpi_errno) goto fn_fail;
/* If comm_ptr is not valid, it will be reset to null */
MPIR_ERRTEST_ARGNULL(newcomm, "newcomm", mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Comm_dup_with_info_impl(comm_ptr, info_ptr, &newcomm_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_OBJ_PUBLISH_HANDLE(*newcomm, newcomm_ptr->handle);
/* ... end of body of routine ... */
fn_exit:
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_COMM_DUP_WITH_INFO);
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_comm_dup_with_info",
"**mpi_comm_dup_with_info %C %I %p", comm, info, newcomm);
}
#endif
*newcomm = MPI_COMM_NULL;
mpi_errno = MPIR_Err_return_comm(comm_ptr, FCNAME, mpi_errno);
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Type_lb - Returns the lower-bound of a datatype
Input Parameters:
. datatype - datatype (handle)
Output Parameters:
. displacement - displacement of lower bound from origin,
in bytes (address integer)
.N Deprecated
The replacement for this routine is 'MPI_Type_Get_extent'.
.N SignalSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_TYPE
.N MPI_ERR_ARG
@*/
int MPI_Type_lb(MPI_Datatype datatype, MPI_Aint * displacement)
{
int mpi_errno = MPI_SUCCESS;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_TYPE_LB);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_TYPE_LB);
/* Validate parameters, especially handles needing to be converted */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
#endif
/* Validate parameters and objects (post conversion) */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_Datatype *datatype_ptr = NULL;
/* Convert MPI object handles to object pointers */
MPIR_Datatype_get_ptr(datatype, datatype_ptr);
/* Validate datatype_ptr */
MPIR_Datatype_valid_ptr(datatype_ptr, mpi_errno);
if (mpi_errno)
goto fn_fail;
MPIR_ERRTEST_ARGNULL(displacement, "displacement", mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
MPIR_Type_lb_impl(datatype, displacement);
/* ... end of body of routine ... */
#ifdef HAVE_ERROR_CHECKING
fn_exit:
#endif
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_TYPE_LB);
return mpi_errno;
/* --BEGIN ERROR HANDLING-- */
#ifdef HAVE_ERROR_CHECKING
fn_fail:
{
mpi_errno =
MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, __func__, __LINE__, MPI_ERR_OTHER,
"**mpi_type_lb", "**mpi_type_lb %D %p", datatype, displacement);
}
mpi_errno = MPIR_Err_return_comm(NULL, __func__, mpi_errno);
goto fn_exit;
#endif
/* --END ERROR HANDLING-- */
}
/*@
MPI_Info_free - Frees an info object
Input Parameters:
. info - info object to be freed (handle)
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_INFO
.N MPI_ERR_OTHER
@*/
int MPI_Info_free( MPI_Info *info )
{
#ifdef HAVE_ERROR_CHECKING
static const char FCNAME[] = "MPI_Info_free";
#endif
int mpi_errno = MPI_SUCCESS;
MPID_Info *info_ptr=0;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_INFO_FREE);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_INFO_FREE);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_INFO(*info, mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* Convert MPI object handles to object pointers */
MPID_Info_get_ptr( *info, info_ptr );
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate info_ptr */
MPID_Info_valid_ptr( info_ptr, mpi_errno );
if (mpi_errno) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
MPIU_Info_free( info_ptr );
*info = MPI_INFO_NULL;
/* ... end of body of routine ... */
#ifdef HAVE_ERROR_CHECKING
fn_exit:
#endif
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_INFO_FREE);
MPIU_THREAD_CS_EXIT(ALLFUNC,);
return mpi_errno;
/* --BEGIN ERROR HANDLING-- */
# ifdef HAVE_ERROR_CHECKING
fn_fail:
{
mpi_errno = MPIR_Err_create_code(
mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER,
"**mpi_info_free",
"**mpi_info_free %p", info);
}
mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
goto fn_exit;
# endif
/* --END ERROR HANDLING-- */
}
/*@
MPI_Win_free_keyval - Frees an attribute key for MPI RMA windows
Input Parameters:
. win_keyval - key value (integer)
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_WIN
.N MPI_ERR_OTHER
.N MPI_ERR_KEYVAL
@*/
int MPI_Win_free_keyval(int *win_keyval)
{
#ifdef HAVE_ERROR_CHECKING
static const char FCNAME[] = "MPI_Win_free_keyval";
#endif
int mpi_errno = MPI_SUCCESS;
MPII_Keyval *keyval_ptr = NULL;
int in_use;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_WIN_FREE_KEYVAL);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_WIN_FREE_KEYVAL);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_ARGNULL(*win_keyval, "win_keyval", mpi_errno);
MPIR_ERRTEST_KEYVAL(*win_keyval, MPIR_WIN, "window", mpi_errno);
MPIR_ERRTEST_KEYVAL_PERM(*win_keyval, mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif
/* Convert MPI object handles to object pointers */
MPII_Keyval_get_ptr( *win_keyval, keyval_ptr );
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPII_Keyval_valid_ptr( keyval_ptr, mpi_errno );
if (mpi_errno) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
if (!keyval_ptr->was_freed) {
keyval_ptr->was_freed = 1;
MPII_Keyval_release_ref( keyval_ptr, &in_use);
if (!in_use) {
MPIR_Handle_obj_free( &MPII_Keyval_mem, keyval_ptr );
}
}
*win_keyval = MPI_KEYVAL_INVALID;
/* ... end of body of routine ... */
#ifdef HAVE_ERROR_CHECKING
fn_exit:
#endif
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_WIN_FREE_KEYVAL);
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
return mpi_errno;
/* --BEGIN ERROR HANDLING-- */
# ifdef HAVE_ERROR_CHECKING
fn_fail:
{
mpi_errno = MPIR_Err_create_code(
mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER,
"**mpi_win_free_keyval",
"**mpi_win_free_keyval %p", win_keyval);
}
mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
goto fn_exit;
# endif
/* --END ERROR HANDLING-- */
}
/*@
MPI_Rsend_init - Creates a persistent request for a ready send
Input Parameters:
+ buf - initial address of send buffer (choice)
. count - number of elements sent (integer)
. datatype - type of each element (handle)
. dest - rank of destination (integer)
. tag - message tag (integer)
- comm - communicator (handle)
Output Parameters:
. request - communication request (handle)
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COUNT
.N MPI_ERR_TYPE
.N MPI_ERR_RANK
.N MPI_ERR_TAG
.N MPI_ERR_COMM
.N MPI_ERR_EXHAUSTED
.seealso: MPI_Start, MPI_Request_free, MPI_Send_init
@*/
int MPI_Rsend_init(const void *buf, int count, MPI_Datatype datatype, int dest,
int tag, MPI_Comm comm, MPI_Request *request)
{
static const char FCNAME[] = "MPI_Rsend_init";
int mpi_errno = MPI_SUCCESS;
MPID_Comm *comm_ptr = NULL;
MPID_Request *request_ptr = NULL;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_RSEND_INIT);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_PT2PT_FUNC_ENTER(MPID_STATE_MPI_RSEND_INIT);
/* Validate handle parameters 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 if error checking is enabled */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPID_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE );
if (mpi_errno) goto fn_fail;
MPIR_ERRTEST_COUNT(count, mpi_errno);
MPIR_ERRTEST_SEND_RANK(comm_ptr, dest, mpi_errno);
MPIR_ERRTEST_SEND_TAG(tag, mpi_errno);
MPIR_ERRTEST_ARGNULL(request,"request",mpi_errno);
/* Validate datatype handle */
MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);
/* Validate datatype object */
if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN)
{
MPID_Datatype *datatype_ptr = NULL;
MPID_Datatype_get_ptr(datatype, datatype_ptr);
MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno);
if (mpi_errno) goto fn_fail;
MPID_Datatype_committed_ptr(datatype_ptr, mpi_errno);
if (mpi_errno) goto fn_fail;
}
/* Validate buffer */
MPIR_ERRTEST_USERBUFFER(buf,count,datatype,mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPID_Rsend_init(buf, count, datatype, dest, tag, comm_ptr,
MPID_CONTEXT_INTRA_PT2PT, &request_ptr);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
/* return the handle of the request to the user */
MPIU_OBJ_PUBLISH_HANDLE(*request, request_ptr->handle);
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_PT2PT_FUNC_EXIT(MPID_STATE_MPI_RSEND_INIT);
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_rsend_init",
"**mpi_rsend_init %p %d %D %i %t %C %p", buf, count, datatype, dest, tag, comm, request);
}
# endif
mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Start - Initiates a communication with a persistent request handle
Input Parameters:
. request - communication request (handle)
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_REQUEST
@*/
int MPI_Start(MPI_Request * request)
{
MPIR_Request *request_ptr = NULL;
int mpi_errno = MPI_SUCCESS;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_START);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_REQUEST_ENTER(MPID_STATE_MPI_START);
/* Validate handle parameters needing to be converted */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_ARGNULL(request, "request", mpi_errno);
MPIR_ERRTEST_REQUEST(*request, mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* Convert MPI request handle to a request object pointer */
MPIR_Request_get_ptr(*request, request_ptr);
/* Validate object pointers if error checking is enabled */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_Request_valid_ptr(request_ptr, mpi_errno);
if (mpi_errno)
goto fn_fail;
MPIR_ERRTEST_PERSISTENT(request_ptr, mpi_errno);
MPIR_ERRTEST_PERSISTENT_ACTIVE(request_ptr, mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPID_Startall(1, &request_ptr);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
/* ... end of body of routine ... */
fn_exit:
MPIR_FUNC_TERSE_REQUEST_EXIT(MPID_STATE_MPI_START);
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_start", "**mpi_start %p", request);
}
#endif
mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno);
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Intercomm_merge - Creates an intracommuncator from an intercommunicator
Input Parameters:
+ intercomm - Intercommunicator (handle)
- high - Used to order the groups within comm (logical)
when creating the new communicator. This is a boolean value; the group
that sets high true has its processes ordered `after` the group that sets
this value to false. If all processes in the intercommunicator provide
the same value, the choice of which group is ordered first is arbitrary.
Output Parameters:
. newintracomm - Created intracommunicator (handle)
Notes:
While all processes may provide the same value for the 'high' parameter,
this requires the MPI implementation to determine which group of
processes should be ranked first.
.N ThreadSafe
.N Fortran
Algorithm:
.Eb
.i Allocate contexts
.i Local and remote group leaders swap high values
.i Determine the high value.
.i Merge the two groups and make the intra-communicator
.Ee
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
.N MPI_ERR_EXHAUSTED
.seealso: MPI_Intercomm_create, MPI_Comm_free
@*/
int MPI_Intercomm_merge(MPI_Comm intercomm, int high, MPI_Comm * newintracomm)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Comm *comm_ptr = NULL;
MPIR_Comm *new_intracomm_ptr;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_INTERCOMM_MERGE);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_INTERCOMM_MERGE);
/* Validate parameters, especially handles needing to be converted */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_COMM(intercomm, mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* Convert MPI object handles to object pointers */
MPIR_Comm_get_ptr(intercomm, comm_ptr);
/* Validate parameters and objects (post conversion) */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate comm_ptr */
MPIR_Comm_valid_ptr(comm_ptr, mpi_errno, FALSE);
/* If comm_ptr is not valid, it will be reset to null */
if (comm_ptr && comm_ptr->comm_kind != MPIR_COMM_KIND__INTERCOMM) {
mpi_errno = MPIR_Err_create_code(MPI_SUCCESS,
MPIR_ERR_RECOVERABLE, FCNAME, __LINE__,
MPI_ERR_COMM, "**commnotinter", 0);
}
if (mpi_errno)
goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* Make sure that we have a local intercommunicator */
if (!comm_ptr->local_comm) {
/* Manufacture the local communicator */
MPII_Setup_intercomm_localcomm(comm_ptr);
}
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
int acthigh;
MPIR_Errflag_t errflag = MPIR_ERR_NONE;
/* Check for consistent valus of high in each local group.
* The Intel test suite checks for this; it is also an easy
* error to make */
acthigh = high ? 1 : 0; /* Clamp high into 1 or 0 */
mpi_errno = MPIR_Allreduce(MPI_IN_PLACE, &acthigh, 1, MPI_INT,
MPI_SUM, comm_ptr->local_comm, &errflag);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_ERR_CHKANDJUMP(errflag, mpi_errno, MPI_ERR_OTHER, "**coll_fail");
/* acthigh must either == 0 or the size of the local comm */
if (acthigh != 0 && acthigh != comm_ptr->local_size) {
mpi_errno = MPIR_Err_create_code(MPI_SUCCESS,
MPIR_ERR_RECOVERABLE, FCNAME, __LINE__,
MPI_ERR_ARG, "**notsame", "**notsame %s %s",
"high", "MPI_Intercomm_merge");
goto fn_fail;
}
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Intercomm_merge_impl(comm_ptr, high, &new_intracomm_ptr);
if (mpi_errno)
goto fn_fail;
MPIR_OBJ_PUBLISH_HANDLE(*newintracomm, new_intracomm_ptr->handle);
/* ... end of body of routine ... */
fn_exit:
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_INTERCOMM_MERGE);
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_intercomm_merge", "**mpi_intercomm_merge %C %d %p",
intercomm, high, newintracomm);
}
#endif
mpi_errno = MPIR_Err_return_comm(comm_ptr, FCNAME, mpi_errno);
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Comm_remote_group - Accesses the remote group associated with
the given inter-communicator
Input Parameters:
. comm - Communicator (must be an intercommunicator) (handle)
Output Parameters:
. group - remote group of communicator (handle)
Notes:
The user is responsible for freeing the group when it is no longer needed.
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
.seealso MPI_Group_free
@*/
int MPI_Comm_remote_group(MPI_Comm comm, MPI_Group *group)
{
int mpi_errno = MPI_SUCCESS;
MPID_Comm *comm_ptr = NULL;
MPID_Group *group_ptr;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_COMM_REMOTE_GROUP);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_COMM_REMOTE_GROUP);
/* 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 comm_ptr */
MPID_Comm_valid_ptr( comm_ptr, mpi_errno );
/* If comm_ptr is not valid, it will be reset to null */
if (comm_ptr && comm_ptr->comm_kind != MPID_INTERCOMM) {
mpi_errno = MPIR_Err_create_code( MPI_SUCCESS,
MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_COMM,
"**commnotinter", 0 );
}
if (mpi_errno) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Comm_remote_group_impl(comm_ptr, &group_ptr);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
*group = group_ptr->handle;
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_COMM_REMOTE_GROUP);
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_comm_remote_group",
"**mpi_comm_remote_group %C %p", comm, group);
}
# endif
mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Comm_free - Marks the communicator object for deallocation
Input Parameters:
. comm - Communicator to be destroyed (handle)
Notes:
This routine `frees` a communicator. Because the communicator may still
be in use by other MPI routines, the actual communicator storage will not
be freed until all references to this communicator are removed. For most
users, the effect of this routine is the same as if it was in fact freed
at this time of this call.
Null Handles:
The MPI 1.1 specification, in the section on opaque objects, explicitly
disallows freeing a null communicator. The text from the standard is:
.vb
A null handle argument is an erroneous IN argument in MPI calls, unless an
exception is explicitly stated in the text that defines the function. Such
exception is allowed for handles to request objects in Wait and Test calls
(sections Communication Completion and Multiple Completions ). Otherwise, a
null handle can only be passed to a function that allocates a new object and
returns a reference to it in the handle.
.ve
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
.N MPI_ERR_ARG
@*/
int MPI_Comm_free(MPI_Comm *comm)
{
int mpi_errno = MPI_SUCCESS;
MPID_Comm *comm_ptr = NULL;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_COMM_FREE);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_COMM_FREE);
/* 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 */
/* Get handles to MPI objects. */
MPID_Comm_get_ptr( *comm, comm_ptr );
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate comm_ptr */
MPID_Comm_valid_ptr( comm_ptr, mpi_errno );
/* If comm_ptr is not valid, it will be reset to null */
/* Cannot free the predefined communicators */
if (HANDLE_GET_KIND(*comm) == HANDLE_KIND_BUILTIN) {
mpi_errno = MPIR_Err_create_code( MPI_SUCCESS,
MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_COMM,
"**commperm", "**commperm %s",
comm_ptr->name );
}
if (mpi_errno) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Comm_free_impl(comm_ptr);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
*comm = MPI_COMM_NULL;
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_COMM_FREE);
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_comm_free", "**mpi_comm_free %p", comm);
}
# endif
mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
int MPII_Comm_set_attr(MPI_Comm comm, int comm_keyval, void *attribute_val, MPIR_Attr_type attrType)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Comm *comm_ptr = NULL;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPIR_COMM_SET_ATTR);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPIR_COMM_SET_ATTR);
/* Validate parameters, especially handles needing to be converted */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_COMM(comm, mpi_errno);
MPIR_ERRTEST_KEYVAL(comm_keyval, MPIR_COMM, "communicator", mpi_errno);
MPIR_ERRTEST_KEYVAL_PERM(comm_keyval, mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
#endif
/* Convert MPI object handles to object pointers */
MPIR_Comm_get_ptr(comm, comm_ptr);
/* Validate parameters and objects (post conversion) */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPII_Keyval *keyval_ptr = NULL;
/* Validate comm_ptr */
MPIR_Comm_valid_ptr(comm_ptr, mpi_errno, TRUE);
/* If comm_ptr is not valid, it will be reset to null */
/* Validate keyval_ptr */
MPII_Keyval_get_ptr(comm_keyval, keyval_ptr);
MPII_Keyval_valid_ptr(keyval_ptr, mpi_errno);
if (mpi_errno)
goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Comm_set_attr_impl(comm_ptr, comm_keyval, attribute_val, attrType);
if (mpi_errno)
goto fn_fail;
/* ... end of body of routine ... */
fn_exit:
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPIR_COMM_SET_ATTR);
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_comm_set_attr", "**mpi_comm_set_attr %C %d %p", comm,
comm_keyval, attribute_val);
}
#endif
mpi_errno = MPIR_Err_return_comm(comm_ptr, FCNAME, mpi_errno);
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Recv - Blocking receive for a message
Output Parameters:
+ buf - initial address of receive buffer (choice)
- status - status object (Status)
Input Parameters:
+ count - maximum number of elements in receive buffer (integer)
. datatype - datatype of each receive buffer element (handle)
. source - rank of source (integer)
. tag - message tag (integer)
- comm - communicator (handle)
Notes:
The 'count' argument indicates the maximum length of a message; the actual
length of the message can be determined with 'MPI_Get_count'.
.N ThreadSafe
.N Fortran
.N FortranStatus
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
.N MPI_ERR_TYPE
.N MPI_ERR_COUNT
.N MPI_ERR_TAG
.N MPI_ERR_RANK
@*/
int MPI_Recv(void *buf, int count, MPI_Datatype datatype, int source, int tag,
MPI_Comm comm, MPI_Status *status)
{
static const char FCNAME[] = "MPI_Recv";
int mpi_errno = MPI_SUCCESS;
MPID_Comm *comm_ptr = NULL;
MPID_Request * request_ptr = NULL;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_RECV);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_PT2PT_FUNC_ENTER_BACK(MPID_STATE_MPI_RECV);
/* Validate handle parameters needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_COMM(comm, mpi_errno);
/* NOTE: MPI_STATUS_IGNORE != NULL */
MPIR_ERRTEST_ARGNULL(status, "status", mpi_errno);
if (mpi_errno) 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 if error checking is enabled */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPID_Comm_valid_ptr( comm_ptr, mpi_errno );
if (mpi_errno) goto fn_fail;
MPIR_ERRTEST_COUNT(count, mpi_errno);
MPIR_ERRTEST_RECV_RANK(comm_ptr, source, mpi_errno);
MPIR_ERRTEST_RECV_TAG(tag, mpi_errno);
if (mpi_errno) goto fn_fail;
/* Validate datatype handle */
MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);
/* Validate datatype object */
if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN)
{
MPID_Datatype *datatype_ptr = NULL;
MPID_Datatype_get_ptr(datatype, datatype_ptr);
MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno);
MPID_Datatype_committed_ptr(datatype_ptr, mpi_errno);
if (mpi_errno) goto fn_fail;
}
/* Validate buffer */
MPIR_ERRTEST_USERBUFFER(buf,count,datatype,mpi_errno);
if (mpi_errno) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
/* MT: Note that MPID_Recv may release the SINGLE_CS if it
decides to block internally. MPID_Recv in that case will
re-aquire the SINGLE_CS before returnning */
mpi_errno = MPID_Recv(buf, count, datatype, source, tag, comm_ptr,
MPID_CONTEXT_INTRA_PT2PT, status, &request_ptr);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
if (request_ptr == NULL)
{
goto fn_exit;
}
/* If a request was returned, then we need to block until the request is
complete */
if (!MPID_Request_is_complete(request_ptr))
{
MPID_Progress_state progress_state;
MPID_Progress_start(&progress_state);
while (!MPID_Request_is_complete(request_ptr))
{
/* MT: Progress_wait may release the SINGLE_CS while it
waits */
mpi_errno = MPID_Progress_wait(&progress_state);
if (mpi_errno != MPI_SUCCESS)
{
/* --BEGIN ERROR HANDLING-- */
MPID_Progress_end(&progress_state);
goto fn_fail;
/* --END ERROR HANDLING-- */
}
}
MPID_Progress_end(&progress_state);
}
mpi_errno = request_ptr->status.MPI_ERROR;
MPIR_Request_extract_status(request_ptr, status);
MPID_Request_release(request_ptr);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_PT2PT_FUNC_EXIT_BACK(MPID_STATE_MPI_RECV);
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_recv",
"**mpi_recv %p %d %D %i %t %C %p", buf, count, datatype, source, tag, comm, status);
}
# endif
mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Isend - Begins a nonblocking send
Input Parameters:
+ buf - initial address of send buffer (choice)
. count - number of elements in send buffer (integer)
. datatype - datatype of each send buffer element (handle)
. dest - rank of destination (integer)
. tag - message tag (integer)
- comm - communicator (handle)
Output Parameters:
. request - communication request (handle)
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
.N MPI_ERR_COUNT
.N MPI_ERR_TYPE
.N MPI_ERR_TAG
.N MPI_ERR_RANK
.N MPI_ERR_EXHAUSTED
@*/
int MPI_Isend(const void *buf, int count, MPI_Datatype datatype, int dest, int tag,
MPI_Comm comm, MPI_Request *request)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Comm *comm_ptr = NULL;
MPIR_Request *request_ptr = NULL;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_ISEND);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_PT2PT_ENTER_FRONT(MPID_STATE_MPI_ISEND);
/* Validate handle parameters 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 */
MPIR_Comm_get_ptr( comm, comm_ptr );
/* Validate parameters if error checking is enabled */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE );
if (mpi_errno) goto fn_fail;
MPIR_ERRTEST_COUNT(count, mpi_errno);
MPIR_ERRTEST_SEND_RANK(comm_ptr, dest, mpi_errno);
MPIR_ERRTEST_SEND_TAG(tag, mpi_errno);
MPIR_ERRTEST_ARGNULL(request,"request",mpi_errno);
/* Validate datatype handle */
MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);
/* Validate datatype object */
if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN)
{
MPIR_Datatype *datatype_ptr = NULL;
MPID_Datatype_get_ptr(datatype, datatype_ptr);
MPIR_Datatype_valid_ptr(datatype_ptr, mpi_errno);
if (mpi_errno) goto fn_fail;
MPID_Datatype_committed_ptr(datatype_ptr, mpi_errno);
if (mpi_errno) goto fn_fail;
}
/* Validate buffer */
MPIR_ERRTEST_USERBUFFER(buf,count,datatype,mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPID_Isend(buf, count, datatype, dest, tag, comm_ptr,
MPIR_CONTEXT_INTRA_PT2PT, &request_ptr);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
MPII_SENDQ_REMEMBER(request_ptr,dest,tag,comm_ptr->context_id);
/* return the handle of the request to the user */
/* MPIU_OBJ_HANDLE_PUBLISH is unnecessary for isend, lower-level access is
* responsible for its own consistency, while upper-level field access is
* controlled by the completion counter */
*request = request_ptr->handle;
/* ... end of body of routine ... */
fn_exit:
MPIR_FUNC_TERSE_PT2PT_EXIT(MPID_STATE_MPI_ISEND);
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_isend",
"**mpi_isend %p %d %D %i %t %C %p", buf, count, datatype, dest, tag, comm, request);
}
# endif
mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Attr_get - Retrieves attribute value by key
Input Parameters:
+ comm - communicator to which attribute is attached (handle)
- keyval - key value (integer)
Output Parameters:
+ attribute_val - attribute value, unless 'flag' = false
- flag - true if an attribute value was extracted; false if no attribute is
associated with the key
Notes:
Attributes must be extracted from the same language as they were inserted
in with 'MPI_ATTR_PUT'. The notes for C and Fortran below explain why.
Notes for C:
Even though the 'attribute_val' argument is declared as 'void *', it is
really the address of a void pointer (i.e., a 'void **'). Using
a 'void *', however, is more in keeping with C idiom and allows the
pointer to be passed without additional casts.
.N ThreadSafe
.N Deprecated
The replacement for this routine is 'MPI_Comm_get_attr'.
.N Fortran
The 'attribute_val' in Fortran is a pointer to a Fortran integer, not
a pointer to a 'void *'.
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
.N MPI_ERR_KEYVAL
.seealso MPI_Attr_put, MPI_Keyval_create, MPI_Attr_delete, MPI_Comm_get_attr
@*/
int MPI_Attr_get(MPI_Comm comm, int keyval, void *attribute_val, int *flag)
{
static const char FCNAME[] = "MPI_Attr_get";
int mpi_errno = MPI_SUCCESS;
MPID_Comm *comm_ptr = NULL;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_ATTR_GET);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_ATTR_GET);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_COMM(comm, mpi_errno);
# ifdef NEEDS_POINTER_ALIGNMENT_ADJUST
/* A common user error is to pass the address of a 4-byte
int when the address of a pointer (or an address-sized int)
should have been used. We can test for this specific
case. Note that this code assumes sizeof(MPIR_Pint) is
a power of 2. */
MPIU_ERR_CHKANDJUMP((MPIR_Pint)attribute_val & (sizeof(MPIR_Pint)-1),
mpi_errno,MPI_ERR_ARG,"**attrnotptr");
# endif
}
MPID_END_ERROR_CHECKS;
}
# endif
/* 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 comm_ptr */
MPID_Comm_valid_ptr( comm_ptr, mpi_errno );
/* If comm_ptr is not valid, it will be reset to null */
MPIR_ERRTEST_ARGNULL(attribute_val, "attribute_val", mpi_errno);
MPIR_ERRTEST_ARGNULL(flag, "flag", mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_CommGetAttr( comm, keyval, attribute_val, flag, MPIR_ATTR_PTR);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_ATTR_GET);
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_attr_get",
"**mpi_attr_get %C %d %p %p", comm, keyval, attribute_val, flag);
}
# endif
mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Iscatterv - Scatters a buffer in parts to all processes in a communicator
in a nonblocking way
Input Parameters:
+ sendbuf - address of send buffer (significant only at root) (choice)
. sendcounts - non-negative integer array (of length group size) specifying the number of elements to send to each processor (significant only at root)
. displs - integer array (of length group size). Entry i specifies the displacement (relative to sendbuf) from which to take the outgoing data to process i (significant only at root)
. sendtype - data type of send buffer elements (significant only at root) (handle)
. recvcount - number of elements in receive buffer (non-negative integer)
. recvtype - data type of receive buffer elements (handle)
. root - rank of sending process (integer)
- comm - communicator (handle)
Output Parameters:
+ recvbuf - starting address of the receive buffer (choice)
- request - communication request (handle)
.N ThreadSafe
.N Fortran
.N Errors
@*/
int MPI_Iscatterv(const void *sendbuf, const int sendcounts[], const int displs[],
MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype,
int root, MPI_Comm comm, MPI_Request * request)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Comm *comm_ptr = NULL;
MPIR_Request *request_ptr = NULL;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_ISCATTERV);
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_ISCATTERV);
/* Validate parameters, especially handles needing to be converted */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno);
if (recvbuf != MPI_IN_PLACE)
MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno);
MPIR_ERRTEST_COMM(comm, mpi_errno);
/* TODO more checks may be appropriate */
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* Convert MPI object handles to object pointers */
MPIR_Comm_get_ptr(comm, comm_ptr);
/* Validate parameters and objects (post conversion) */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_Datatype *sendtype_ptr = NULL, *recvtype_ptr = NULL;
int i, comm_size, rank;
MPIR_Comm_valid_ptr(comm_ptr, mpi_errno, FALSE);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
if (comm_ptr->comm_kind == MPIR_COMM_KIND__INTRACOMM) {
MPIR_ERRTEST_INTRA_ROOT(comm_ptr, root, mpi_errno);
rank = comm_ptr->rank;
comm_size = comm_ptr->local_size;
if (rank == root) {
for (i = 0; i < comm_size; i++) {
MPIR_ERRTEST_COUNT(sendcounts[i], mpi_errno);
MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno);
}
if (HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) {
MPIR_Datatype_get_ptr(sendtype, sendtype_ptr);
MPIR_Datatype_valid_ptr(sendtype_ptr, mpi_errno);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
MPIR_Datatype_committed_ptr(sendtype_ptr, mpi_errno);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
}
for (i = 0; i < comm_size; i++) {
if (sendcounts[i] > 0) {
MPIR_ERRTEST_USERBUFFER(sendbuf, sendcounts[i], sendtype, mpi_errno);
break;
}
}
for (i = 0; i < comm_size; i++) {
if (sendcounts[i] > 0) {
MPIR_ERRTEST_SENDBUF_INPLACE(sendbuf, sendcounts[i], mpi_errno);
break;
}
}
/* catch common aliasing cases */
if (recvbuf != MPI_IN_PLACE && sendtype == recvtype &&
sendcounts[comm_ptr->rank] != 0 && recvcount != 0) {
int sendtype_size;
MPIR_Datatype_get_size_macro(sendtype, sendtype_size);
MPIR_ERRTEST_ALIAS_COLL(recvbuf,
(char *) sendbuf +
displs[comm_ptr->rank] * sendtype_size, mpi_errno);
}
} else
MPIR_ERRTEST_RECVBUF_INPLACE(recvbuf, recvcount, mpi_errno);
if (recvbuf != MPI_IN_PLACE) {
MPIR_ERRTEST_COUNT(recvcount, mpi_errno);
MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno);
if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) {
MPIR_Datatype_get_ptr(recvtype, recvtype_ptr);
MPIR_Datatype_valid_ptr(recvtype_ptr, mpi_errno);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
MPIR_Datatype_committed_ptr(recvtype_ptr, mpi_errno);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
}
MPIR_ERRTEST_USERBUFFER(recvbuf, recvcount, recvtype, mpi_errno);
}
}
if (comm_ptr->comm_kind == MPIR_COMM_KIND__INTERCOMM) {
MPIR_ERRTEST_INTER_ROOT(comm_ptr, root, mpi_errno);
if (root == MPI_ROOT) {
comm_size = comm_ptr->remote_size;
for (i = 0; i < comm_size; i++) {
MPIR_ERRTEST_COUNT(sendcounts[i], mpi_errno);
MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno);
}
if (HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) {
MPIR_Datatype_get_ptr(sendtype, sendtype_ptr);
MPIR_Datatype_valid_ptr(sendtype_ptr, mpi_errno);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
MPIR_Datatype_committed_ptr(sendtype_ptr, mpi_errno);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
}
for (i = 0; i < comm_size; i++) {
if (sendcounts[i] > 0) {
MPIR_ERRTEST_SENDBUF_INPLACE(sendbuf, sendcounts[i], mpi_errno);
MPIR_ERRTEST_USERBUFFER(sendbuf, sendcounts[i], sendtype, mpi_errno);
break;
}
}
} else if (root != MPI_PROC_NULL) {
MPIR_ERRTEST_COUNT(recvcount, mpi_errno);
MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno);
if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) {
MPIR_Datatype_get_ptr(recvtype, recvtype_ptr);
MPIR_Datatype_valid_ptr(recvtype_ptr, mpi_errno);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
MPIR_Datatype_committed_ptr(recvtype_ptr, mpi_errno);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
}
MPIR_ERRTEST_RECVBUF_INPLACE(recvbuf, recvcount, mpi_errno);
MPIR_ERRTEST_USERBUFFER(recvbuf, recvcount, recvtype, mpi_errno);
}
}
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Iscatterv(sendbuf, sendcounts, displs, sendtype, recvbuf, recvcount, recvtype,
root, comm_ptr, &request_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* create a complete request, if needed */
if (!request_ptr)
request_ptr = MPIR_Request_create_complete(MPIR_REQUEST_KIND__COLL);
/* return the handle of the request to the user */
*request = request_ptr->handle;
/* ... end of body of routine ... */
fn_exit:
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_ISCATTERV);
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_iscatterv", "**mpi_iscatterv %p %p %p %D %p %d %D %d %C %p",
sendbuf, sendcounts, displs, sendtype, recvbuf, recvcount,
recvtype, root, comm, request);
}
#endif
mpi_errno = MPIR_Err_return_comm(comm_ptr, FCNAME, mpi_errno);
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Comm_split_type - Creates new communicators based on split types and keys
Input Parameters:
+ comm - communicator (handle)
. split_type - type of processes to be grouped together (nonnegative integer).
. key - control of rank assignment (integer)
- info - hints to improve communicator creation (handle)
Output Parameters:
. newcomm - new communicator (handle)
Notes:
The 'split_type' must be non-negative or 'MPI_UNDEFINED'.
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
.N MPI_ERR_EXHAUSTED
.seealso: MPI_Comm_free
@*/
int MPI_Comm_split_type(MPI_Comm comm, int split_type, int key, MPI_Info info,
MPI_Comm * newcomm)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Comm *comm_ptr = NULL, *newcomm_ptr;
MPIR_Info *info_ptr = NULL;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_COMM_SPLIT_TYPE);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_COMM_SPLIT_TYPE);
/* 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 */
/* Get handles to MPI objects. */
MPIR_Comm_get_ptr(comm, comm_ptr);
MPIR_Info_get_ptr(info, info_ptr);
/* Validate parameters and objects (post conversion) */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate comm_ptr */
MPIR_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE );
/* If comm_ptr is not valid, it will be reset to null */
if (mpi_errno)
goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Comm_split_type_impl(comm_ptr, split_type, key, info_ptr, &newcomm_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
if (newcomm_ptr)
MPIR_OBJ_PUBLISH_HANDLE(*newcomm, newcomm_ptr->handle);
else
*newcomm = MPI_COMM_NULL;
/* ... end of body of routine ... */
fn_exit:
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_COMM_SPLIT_TYPE);
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
return mpi_errno;
fn_fail:
/* --BEGIN ERROR HANDLING-- */
#ifdef HAVE_ERROR_CHECKING
{
/* FIXME this error code is wrong, it's the error code for
* regular MPI_Comm_split */
mpi_errno =
MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__,
MPI_ERR_OTHER, "**mpi_comm_split",
"**mpi_comm_split %C %d %d %p", comm, split_type, key,
newcomm);
}
#endif
mpi_errno = MPIR_Err_return_comm(comm_ptr, FCNAME, mpi_errno);
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Improbe - Nonblocking matched probe.
Input Parameters:
+ source - rank of source or MPI_ANY_SOURCE (integer)
. tag - message tag or MPI_ANY_TAG (integer)
- comm - communicator (handle)
Output Parameters:
+ flag - flag (logical)
. message - returned message (handle)
- status - status object (status)
.N ThreadSafe
.N Fortran
.N Errors
@*/
int MPI_Improbe(int source, int tag, MPI_Comm comm, int *flag, MPI_Message *message, MPI_Status *status)
{
int mpi_errno = MPI_SUCCESS;
MPID_Request *msgp = NULL;
MPID_Comm *comm_ptr = NULL;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_IMPROBE);
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_IMPROBE);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS
{
MPIR_ERRTEST_COMM(comm, mpi_errno);
/* TODO more checks may be appropriate */
}
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_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE );
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
MPIR_ERRTEST_ARGNULL(flag, "flag", mpi_errno);
/* TODO more checks may be appropriate (counts, in_place, buffer aliasing, etc) */
}
MPID_END_ERROR_CHECKS
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
*message = MPI_MESSAGE_NULL;
mpi_errno = MPID_Improbe(source, tag, comm_ptr, MPID_CONTEXT_INTRA_PT2PT, flag, &msgp, status);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
if (*flag) {
if (msgp == NULL) {
MPIU_Assert(source == MPI_PROC_NULL);
*message = MPI_MESSAGE_NO_PROC;
}
else {
*message = msgp->handle;
}
}
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_IMPROBE);
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_improbe", "**mpi_improbe %d %d %C %p %p %p", source, tag, comm, flag, message, status);
}
# endif
mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno);
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Iscan - Computes the scan (partial reductions) of data on a collection of
processes in a nonblocking way
Input Parameters:
+ sendbuf - starting address of the send buffer (choice)
. count - number of elements in input buffer (non-negative integer)
. datatype - data type of elements of input buffer (handle)
. op - operation (handle)
- comm - communicator (handle)
Output Parameters:
+ recvbuf - starting address of the receive buffer (choice)
- request - communication request (handle)
.N ThreadSafe
.N Fortran
.N Errors
@*/
int MPI_Iscan(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype,
MPI_Op op, MPI_Comm comm, MPI_Request * request)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Comm *comm_ptr = NULL;
MPIR_Request *request_ptr = NULL;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_ISCAN);
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_ISCAN);
/* Validate parameters, especially handles needing to be converted */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);
MPIR_ERRTEST_COUNT(count, mpi_errno);
MPIR_ERRTEST_OP(op, mpi_errno);
MPIR_ERRTEST_COMM(comm, mpi_errno);
/* TODO more checks may be appropriate */
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* Convert MPI object handles to object pointers */
MPIR_Comm_get_ptr(comm, comm_ptr);
/* Validate parameters and objects (post conversion) */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_Comm_valid_ptr(comm_ptr, mpi_errno, FALSE);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
MPIR_ERRTEST_COMM_INTRA(comm_ptr, mpi_errno);
if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN) {
MPIR_Datatype *datatype_ptr = NULL;
MPIR_Datatype_get_ptr(datatype, datatype_ptr);
MPIR_Datatype_valid_ptr(datatype_ptr, mpi_errno);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
MPIR_Datatype_committed_ptr(datatype_ptr, mpi_errno);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
}
if (HANDLE_GET_KIND(op) != HANDLE_KIND_BUILTIN) {
MPIR_Op *op_ptr = NULL;
MPIR_Op_get_ptr(op, op_ptr);
MPIR_Op_valid_ptr(op_ptr, mpi_errno);
} else if (HANDLE_GET_KIND(op) == HANDLE_KIND_BUILTIN) {
mpi_errno = (*MPIR_OP_HDL_TO_DTYPE_FN(op)) (datatype);
}
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
MPIR_ERRTEST_ARGNULL(request, "request", mpi_errno);
if (sendbuf != MPI_IN_PLACE && count != 0)
MPIR_ERRTEST_ALIAS_COLL(sendbuf, recvbuf, mpi_errno);
/* TODO more checks may be appropriate (counts, in_place, etc) */
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Iscan(sendbuf, recvbuf, count, datatype, op, comm_ptr, &request_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* create a complete request, if needed */
if (!request_ptr)
request_ptr = MPIR_Request_create_complete(MPIR_REQUEST_KIND__COLL);
/* return the handle of the request to the user */
*request = request_ptr->handle;
/* ... end of body of routine ... */
fn_exit:
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_ISCAN);
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, __func__, __LINE__, MPI_ERR_OTHER,
"**mpi_iscan", "**mpi_iscan %p %p %d %D %O %C %p", sendbuf,
recvbuf, count, datatype, op, comm, request);
}
#endif
mpi_errno = MPIR_Err_return_comm(comm_ptr, __func__, mpi_errno);
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Type_ub - Returns the upper bound of a datatype
Input Parameters:
. datatype - datatype (handle)
Output Parameter:
. displacement - displacement of upper bound from origin,
in bytes (address integer)
.N Deprecated
The replacement for this routine is 'MPI_Type_get_extent'
.N SignalSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_TYPE
.N MPI_ERR_ARG
@*/
int MPI_Type_ub(MPI_Datatype datatype, MPI_Aint *displacement)
{
int mpi_errno = MPI_SUCCESS;
MPID_Datatype *datatype_ptr = NULL;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_TYPE_UB);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_TYPE_UB);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif
/* Convert MPI object handles to object pointers */
MPID_Datatype_get_ptr(datatype, datatype_ptr);
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate datatype_ptr */
MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno);
if (mpi_errno) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
if (HANDLE_GET_KIND(datatype) == HANDLE_KIND_BUILTIN)
*displacement = MPID_Datatype_get_basic_size(datatype);
else
*displacement = datatype_ptr->ub;
/* ... end of body of routine ... */
#ifdef HAVE_ERROR_CHECKING
fn_exit:
#endif
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_TYPE_UB);
return mpi_errno;
/* --BEGIN ERROR HANDLING-- */
# ifdef HAVE_ERROR_CHECKING
fn_fail:
{
mpi_errno = MPIR_Err_create_code(
mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER,
"**mpi_type_ub",
"**mpi_type_ub %D %p", datatype, displacement);
}
mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno);
goto fn_exit;
# endif
/* --END ERROR HANDLING-- */
}
/*@
MPI_Comm_free_keyval - Frees an attribute key for communicators
Input Parameter:
. comm_keyval - Frees the integer key value (integer)
Notes:
Key values are global (they can be used with any and all communicators)
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_ARG
.N MPI_ERR_PERM_KEY
@*/
int MPI_Comm_free_keyval(int *comm_keyval)
{
MPID_Keyval *keyval_ptr = NULL;
int mpi_errno = MPI_SUCCESS;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_COMM_FREE_KEYVAL);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_COMM_FREE_KEYVAL);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_ARGNULL(comm_keyval, "comm_keyval", mpi_errno);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
MPIR_ERRTEST_KEYVAL(*comm_keyval, MPID_COMM, "communicator",
mpi_errno);
MPIR_ERRTEST_KEYVAL_PERM(*comm_keyval, mpi_errno);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif
/* Convert MPI object handles to object pointers */
MPID_Keyval_get_ptr( *comm_keyval, keyval_ptr );
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPID_Keyval_valid_ptr( keyval_ptr, mpi_errno );
if (mpi_errno) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
MPIR_Comm_free_keyval_impl(*comm_keyval);
*comm_keyval = MPI_KEYVAL_INVALID;
/* ... end of body of routine ... */
#ifdef HAVE_ERROR_CHECKING
fn_exit:
#endif
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_COMM_FREE_KEYVAL);
MPIU_THREAD_CS_EXIT(ALLFUNC,);
return mpi_errno;
/* --BEGIN ERROR HANDLING-- */
# ifdef HAVE_ERROR_CHECKING
fn_fail:
{
mpi_errno = MPIR_Err_create_code(
mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER,
"**mpi_comm_free_keyval",
"**mpi_comm_free_keyval %p", comm_keyval);
}
mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
goto fn_exit;
# endif
/* --END ERROR HANDLING-- */
}
/*@
MPI_Neighbor_alltoallw - Like MPI_Neighbor_alltoallv but it allows one to send
and receive with different types to and from each neighbor.
Input Parameters:
+ sendbuf - starting address of the send buffer (choice)
. sendcounts - non-negative integer array (of length outdegree) specifying the number of elements to send to each neighbor
. sdispls - integer array (of length outdegree). Entry j specifies the displacement in bytes (relative to sendbuf) from which to take the outgoing data destined for neighbor j (array of integers)
. sendtypes - array of datatypes (of length outdegree). Entry j specifies the type of data to send to neighbor j (array of handles)
. recvcounts - non-negative integer array (of length indegree) specifying the number of elements that are received from each neighbor
. rdispls - integer array (of length indegree). Entry i specifies the displacement in bytes (relative to recvbuf) at which to place the incoming data from neighbor i (array of integers).
. recvtypes - array of datatypes (of length indegree). Entry i specifies the type of data received from neighbor i (array of handles).
- comm - communicator with topology structure (handle)
Output Parameters:
. recvbuf - starting address of the receive buffer (choice)
.N ThreadSafe
.N Fortran
.N Errors
@*/
int MPI_Neighbor_alltoallw(const void *sendbuf, const int sendcounts[], const MPI_Aint sdispls[],
const MPI_Datatype sendtypes[], void *recvbuf, const int recvcounts[],
const MPI_Aint rdispls[], const MPI_Datatype recvtypes[], MPI_Comm comm)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Comm *comm_ptr = NULL;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_NEIGHBOR_ALLTOALLW);
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_NEIGHBOR_ALLTOALLW);
/* Validate parameters, especially handles needing to be converted */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_COMM(comm, mpi_errno);
/* TODO more checks may be appropriate */
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* Convert MPI object handles to object pointers */
MPIR_Comm_get_ptr(comm, comm_ptr);
/* Validate parameters and objects (post conversion) */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_Comm_valid_ptr(comm_ptr, mpi_errno, FALSE);
/* TODO more checks may be appropriate (counts, in_place, buffer aliasing, etc) */
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Neighbor_alltoallw_impl(sendbuf, sendcounts, sdispls,
sendtypes, recvbuf, recvcounts,
rdispls, recvtypes, comm_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* ... end of body of routine ... */
fn_exit:
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_NEIGHBOR_ALLTOALLW);
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, __func__, __LINE__, MPI_ERR_OTHER,
"**mpi_neighbor_alltoallw",
"**mpi_neighbor_alltoallw %p %p %p %p %p %p %p %p %C", sendbuf,
sendcounts, sdispls, sendtypes, recvbuf, recvcounts, rdispls,
recvtypes, comm);
}
#endif
mpi_errno = MPIR_Err_return_comm(NULL, __func__, mpi_errno);
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Get_elements - Returns the number of basic elements
in a datatype
Input Parameters:
+ status - return status of receive operation (Status)
- datatype - datatype used by receive operation (handle)
Output Parameters:
. count - number of received basic elements (integer)
Notes:
If the size of the datatype is zero and the amount of data returned as
determined by 'status' is also zero, this routine will return a count of
zero. This is consistent with a clarification made by the MPI Forum.
.N Fortran
.N Errors
.N MPI_SUCCESS
@*/
int MPI_Get_elements(const MPI_Status *status, MPI_Datatype datatype, int *count)
{
int mpi_errno = MPI_SUCCESS;
MPI_Count count_x;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_GET_ELEMENTS);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_GET_ELEMENTS);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPID_Datatype *datatype_ptr = NULL;
MPIR_ERRTEST_ARGNULL(status, "status", mpi_errno);
MPIR_ERRTEST_ARGNULL(count, "count", mpi_errno);
/* Convert MPI object handles to object pointers */
MPID_Datatype_get_ptr(datatype, datatype_ptr);
/* Validate datatype_ptr */
if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN) {
MPID_Datatype_get_ptr(datatype, datatype_ptr);
MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
MPID_Datatype_committed_ptr(datatype_ptr, mpi_errno);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
}
MPID_END_ERROR_CHECKS;
}
# endif
/* ... body of routine ... */
mpi_errno = MPIR_Get_elements_x_impl(status, datatype, &count_x);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
/* clip the value if it cannot be correctly returned to the user */
*count = (count_x > INT_MAX) ? MPI_UNDEFINED : (int)count_x;
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_GET_ELEMENTS);
return mpi_errno;
/* --BEGIN ERROR HANDLING-- */
fn_fail:
{
mpi_errno = MPIR_Err_create_code(
mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER,
"**mpi_get_elements",
"**mpi_get_elements %p %D %p", status, datatype, count);
}
mpi_errno = MPIR_Err_return_comm(0, FCNAME, mpi_errno);
goto fn_exit;
/* --END ERROR HANDLING-- */
}
