//.........这里部分代码省略.........
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-- */
}
//.........这里部分代码省略.........
/* 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_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-- */
}
开发者ID:zhanglt,项目名称:mpich,代码行数:93,代码来源:comm_join.c
示例8: group
//.........这里部分代码省略.........
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_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-- */
//.........这里部分代码省略.........
请发表评论