/* comm create impl for intercommunicators, assumes that the standard error
* checking has already taken place in the calling function */
PMPI_LOCAL int MPIR_Comm_create_inter(MPIR_Comm *comm_ptr, MPIR_Group *group_ptr,
MPIR_Comm **newcomm_ptr)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Context_id_t new_context_id;
int *mapping = NULL;
int *remote_mapping = NULL;
MPIR_Comm *mapping_comm = NULL;
int remote_size = -1;
int rinfo[2];
MPIR_Errflag_t errflag = MPIR_ERR_NONE;
MPIR_CHKLMEM_DECL(1);
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPIR_COMM_CREATE_INTER);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPIR_COMM_CREATE_INTER);
MPIR_Assert(comm_ptr->comm_kind == MPIR_COMM_KIND__INTERCOMM);
/* Create a new communicator from the specified group members */
/* If there is a context id cache in oldcomm, use it here. Otherwise,
use the appropriate algorithm to get a new context id.
Creating the context id is collective over the *input* communicator,
so it must be created before we decide if this process is a
member of the group */
/* In the multi-threaded case, MPIR_Get_contextid_sparse assumes that the
calling routine already holds the single criticial section */
if (!comm_ptr->local_comm) {
MPII_Setup_intercomm_localcomm( comm_ptr );
}
mpi_errno = MPIR_Get_contextid_sparse( comm_ptr->local_comm, &new_context_id, FALSE );
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_Assert(new_context_id != 0);
MPIR_Assert(new_context_id != comm_ptr->recvcontext_id);
mpi_errno = MPII_Comm_create_calculate_mapping(group_ptr, comm_ptr,
&mapping, &mapping_comm);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
*newcomm_ptr = NULL;
if (group_ptr->rank != MPI_UNDEFINED) {
/* Get the new communicator structure and context id */
mpi_errno = MPIR_Comm_create( newcomm_ptr );
if (mpi_errno) goto fn_fail;
(*newcomm_ptr)->recvcontext_id = new_context_id;
(*newcomm_ptr)->rank = group_ptr->rank;
(*newcomm_ptr)->comm_kind = comm_ptr->comm_kind;
/* Since the group has been provided, let the new communicator know
about the group */
(*newcomm_ptr)->local_comm = 0;
(*newcomm_ptr)->local_group = group_ptr;
MPIR_Group_add_ref( group_ptr );
(*newcomm_ptr)->local_size = group_ptr->size;
(*newcomm_ptr)->pof2 = MPL_pof2((*newcomm_ptr)->local_size);
(*newcomm_ptr)->remote_group = 0;
(*newcomm_ptr)->is_low_group = comm_ptr->is_low_group;
}
/* There is an additional step. We must communicate the
information on the local context id and the group members,
given by the ranks so that the remote process can construct the
appropriate network address mapping.
First we exchange group sizes and context ids. Then the ranks
in the remote group, from which the remote network address
mapping can be constructed. We need to use the "collective"
context in the original intercommunicator */
if (comm_ptr->rank == 0) {
int info[2];
info[0] = new_context_id;
info[1] = group_ptr->size;
mpi_errno = MPIC_Sendrecv(info, 2, MPI_INT, 0, 0,
rinfo, 2, MPI_INT, 0, 0,
comm_ptr, MPI_STATUS_IGNORE, &errflag );
if (mpi_errno) { MPIR_ERR_POP( mpi_errno ); }
if (*newcomm_ptr != NULL) {
(*newcomm_ptr)->context_id = rinfo[0];
}
remote_size = rinfo[1];
MPIR_CHKLMEM_MALLOC(remote_mapping,int*,
remote_size*sizeof(int),
mpi_errno,"remote_mapping",MPL_MEM_ADDRESS);
/* Populate and exchange the ranks */
mpi_errno = MPIC_Sendrecv( mapping, group_ptr->size, MPI_INT, 0, 0,
remote_mapping, remote_size, MPI_INT, 0, 0,
comm_ptr, MPI_STATUS_IGNORE, &errflag );
if (mpi_errno) { MPIR_ERR_POP( mpi_errno ); }
/* Broadcast to the other members of the local group */
mpi_errno = MPID_Bcast( rinfo, 2, MPI_INT, 0,
comm_ptr->local_comm, &errflag);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
mpi_errno = MPID_Bcast( remote_mapping, remote_size, MPI_INT, 0,
comm_ptr->local_comm, &errflag);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_ERR_CHKANDJUMP(errflag, mpi_errno, MPI_ERR_OTHER, "**coll_fail");
}
/* comm create group impl; assumes that the standard error checking
* has already taken place in the calling function */
int MPIR_Comm_create_group(MPIR_Comm * comm_ptr, MPIR_Group * group_ptr, int tag,
MPIR_Comm ** newcomm_ptr)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Context_id_t new_context_id = 0;
int *mapping = NULL;
int n;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPIR_COMM_CREATE_GROUP);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPIR_COMM_CREATE_GROUP);
MPIR_Assert(comm_ptr->comm_kind == MPIR_COMM_KIND__INTRACOMM);
n = group_ptr->size;
*newcomm_ptr = NULL;
/* Shift tag into the tagged coll space */
tag |= MPIR_TAG_COLL_BIT;
/* Create a new communicator from the specified group members */
if (group_ptr->rank != MPI_UNDEFINED) {
MPIR_Comm *mapping_comm = NULL;
/* For this routine, creation of the id is collective over the input
*group*, so processes not in the group do not participate. */
mpi_errno = MPIR_Get_contextid_sparse_group(comm_ptr, group_ptr, tag, &new_context_id, 0);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_Assert(new_context_id != 0);
mpi_errno = MPII_Comm_create_calculate_mapping(group_ptr, comm_ptr,
&mapping, &mapping_comm);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* Get the new communicator structure and context id */
mpi_errno = MPIR_Comm_create(newcomm_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
(*newcomm_ptr)->recvcontext_id = new_context_id;
(*newcomm_ptr)->rank = group_ptr->rank;
(*newcomm_ptr)->comm_kind = comm_ptr->comm_kind;
/* Since the group has been provided, let the new communicator know
* about the group */
(*newcomm_ptr)->local_comm = 0;
(*newcomm_ptr)->local_group = group_ptr;
MPIR_Group_add_ref(group_ptr);
(*newcomm_ptr)->remote_group = group_ptr;
MPIR_Group_add_ref(group_ptr);
(*newcomm_ptr)->context_id = (*newcomm_ptr)->recvcontext_id;
(*newcomm_ptr)->remote_size = (*newcomm_ptr)->local_size = n;
(*newcomm_ptr)->pof2 = MPL_pof2(n);
/* Setup the communicator's vc table. This is for the remote group,
* which is the same as the local group for intracommunicators */
mpi_errno = MPII_Comm_create_map(n, 0, mapping, NULL, mapping_comm, *newcomm_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIR_Comm_commit(*newcomm_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
} else {
/* This process is not in the group */
new_context_id = 0;
}
fn_exit:
if (mapping)
MPL_free(mapping);
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPIR_COMM_CREATE_GROUP);
return mpi_errno;
fn_fail:
/* --BEGIN ERROR HANDLING-- */
if (*newcomm_ptr != NULL) {
MPIR_Comm_release(*newcomm_ptr);
new_context_id = 0; /* MPIR_Comm_release frees the new ctx id */
}
if (new_context_id != 0)
MPIR_Free_contextid(new_context_id);
/* --END ERROR HANDLING-- */
goto fn_exit;
}
/* comm create impl for intracommunicators, assumes that the standard error
* checking has already taken place in the calling function */
int MPIR_Comm_create_intra(MPIR_Comm *comm_ptr, MPIR_Group *group_ptr,
MPIR_Comm **newcomm_ptr)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Context_id_t new_context_id = 0;
int *mapping = NULL;
int n;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPIR_COMM_CREATE_INTRA);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPIR_COMM_CREATE_INTRA);
MPIR_Assert(comm_ptr->comm_kind == MPIR_COMM_KIND__INTRACOMM);
n = group_ptr->size;
*newcomm_ptr = NULL;
/* Create a new communicator from the specified group members */
/* Creating the context id is collective over the *input* communicator,
so it must be created before we decide if this process is a
member of the group */
/* In the multi-threaded case, MPIR_Get_contextid_sparse assumes that the
calling routine already holds the single criticial section */
mpi_errno = MPIR_Get_contextid_sparse( comm_ptr, &new_context_id,
group_ptr->rank == MPI_UNDEFINED );
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_Assert(new_context_id != 0);
if (group_ptr->rank != MPI_UNDEFINED) {
MPIR_Comm *mapping_comm = NULL;
mpi_errno = MPII_Comm_create_calculate_mapping(group_ptr, comm_ptr,
&mapping, &mapping_comm);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
/* Get the new communicator structure and context id */
mpi_errno = MPIR_Comm_create( newcomm_ptr );
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
(*newcomm_ptr)->recvcontext_id = new_context_id;
(*newcomm_ptr)->rank = group_ptr->rank;
(*newcomm_ptr)->comm_kind = comm_ptr->comm_kind;
/* Since the group has been provided, let the new communicator know
about the group */
(*newcomm_ptr)->local_comm = 0;
(*newcomm_ptr)->local_group = group_ptr;
MPIR_Group_add_ref( group_ptr );
(*newcomm_ptr)->remote_group = group_ptr;
MPIR_Group_add_ref( group_ptr );
(*newcomm_ptr)->context_id = (*newcomm_ptr)->recvcontext_id;
(*newcomm_ptr)->remote_size = (*newcomm_ptr)->local_size = n;
(*newcomm_ptr)->pof2 = MPL_pof2(n);
/* Setup the communicator's network address mapping. This is for the remote group,
which is the same as the local group for intracommunicators */
mpi_errno = MPII_Comm_create_map(n, 0,
mapping,
NULL,
mapping_comm,
*newcomm_ptr);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIR_Comm_commit(*newcomm_ptr);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
}
else {
/* This process is not in the group */
new_context_id = 0;
}
fn_exit:
if (mapping)
MPL_free(mapping);
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPIR_COMM_CREATE_INTRA);
return mpi_errno;
fn_fail:
/* --BEGIN ERROR HANDLING-- */
if (*newcomm_ptr != NULL) {
MPIR_Comm_release(*newcomm_ptr);
new_context_id = 0; /* MPIR_Comm_release frees the new ctx id */
}
if (new_context_id != 0 && group_ptr->rank != MPI_UNDEFINED) {
MPIR_Free_contextid(new_context_id);
}
/* --END ERROR HANDLING-- */
goto fn_exit;
}
int MPIR_Intercomm_merge_impl(MPIR_Comm * comm_ptr, int high, MPIR_Comm ** new_intracomm_ptr)
{
int mpi_errno = MPI_SUCCESS;
int local_high, remote_high, new_size;
MPIR_Context_id_t new_context_id;
MPIR_Errflag_t errflag = MPIR_ERR_NONE;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPIR_COMM_KIND__INTERCOMM_MERGE_IMPL);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPIR_COMM_KIND__INTERCOMM_MERGE_IMPL);
/* Make sure that we have a local intercommunicator */
if (!comm_ptr->local_comm) {
/* Manufacture the local communicator */
mpi_errno = MPII_Setup_intercomm_localcomm(comm_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
}
/* Find the "high" value of the other group of processes. This
* will be used to determine which group is ordered first in
* the generated communicator. high is logical */
local_high = high;
if (comm_ptr->rank == 0) {
/* This routine allows use to use the collective communication
* context rather than the point-to-point context. */
mpi_errno = MPIC_Sendrecv(&local_high, 1, MPI_INT, 0, 0,
&remote_high, 1, MPI_INT, 0, 0, comm_ptr,
MPI_STATUS_IGNORE, &errflag);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* If local_high and remote_high are the same, then order is arbitrary.
* we use the is_low_group in the intercomm in this case. */
MPL_DBG_MSG_FMT(MPIR_DBG_COMM, VERBOSE,
(MPL_DBG_FDEST, "local_high=%d remote_high=%d is_low_group=%d",
local_high, remote_high, comm_ptr->is_low_group));
if (local_high == remote_high) {
local_high = !(comm_ptr->is_low_group);
}
}
/*
* All processes in the local group now need to get the
* value of local_high, which may have changed if both groups
* of processes had the same value for high
*/
mpi_errno = MPIR_Bcast(&local_high, 1, MPI_INT, 0, comm_ptr->local_comm, &errflag);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_ERR_CHKANDJUMP(errflag, mpi_errno, MPI_ERR_OTHER, "**coll_fail");
/*
* For the intracomm, we need a consistent context id.
* That means that one of the two groups needs to use
* the recvcontext_id and the other must use the context_id
* The recvcontext_id is unique on each process, but another
* communicator may use the context_id. Therefore, we do a small hack.
* We set both flags indicating a sub-communicator (intra-node and
* inter-node) to one. This is normally not possible (a communicator
* is either intra- or inter-node) - which makes this context_id unique.
*
*/
new_size = comm_ptr->local_size + comm_ptr->remote_size;
mpi_errno = MPIR_Comm_create(new_intracomm_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
if (local_high) {
(*new_intracomm_ptr)->context_id =
MPIR_CONTEXT_SET_FIELD(SUBCOMM, comm_ptr->recvcontext_id, 3);
} else {
(*new_intracomm_ptr)->context_id = MPIR_CONTEXT_SET_FIELD(SUBCOMM, comm_ptr->context_id, 3);
}
(*new_intracomm_ptr)->recvcontext_id = (*new_intracomm_ptr)->context_id;
(*new_intracomm_ptr)->remote_size = (*new_intracomm_ptr)->local_size = new_size;
(*new_intracomm_ptr)->pof2 = MPL_pof2(new_size);
(*new_intracomm_ptr)->rank = -1;
(*new_intracomm_ptr)->comm_kind = MPIR_COMM_KIND__INTRACOMM;
/* Now we know which group comes first. Build the new mapping
* from the existing comm */
mpi_errno = create_and_map(comm_ptr, local_high, (*new_intracomm_ptr));
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* We've setup a temporary context id, based on the context id
* used by the intercomm. This allows us to perform the allreduce
* operations within the context id algorithm, since we already
* have a valid (almost - see comm_create_hook) communicator.
*/
mpi_errno = MPIR_Comm_commit((*new_intracomm_ptr));
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* printf("About to get context id \n"); fflush(stdout); */
/* In the multi-threaded case, MPIR_Get_contextid_sparse assumes that the
* calling routine already holds the single criticial section */
new_context_id = 0;
mpi_errno = MPIR_Get_contextid_sparse((*new_intracomm_ptr), &new_context_id, FALSE);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_Assert(new_context_id != 0);
/* We release this communicator that was involved just to
* get valid context id and create true one
*/
mpi_errno = MPIR_Comm_release(*new_intracomm_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIR_Comm_create(new_intracomm_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
(*new_intracomm_ptr)->remote_size = (*new_intracomm_ptr)->local_size = new_size;
(*new_intracomm_ptr)->pof2 = MPL_pof2(new_size);
(*new_intracomm_ptr)->rank = -1;
(*new_intracomm_ptr)->comm_kind = MPIR_COMM_KIND__INTRACOMM;
(*new_intracomm_ptr)->context_id = new_context_id;
(*new_intracomm_ptr)->recvcontext_id = new_context_id;
mpi_errno = create_and_map(comm_ptr, local_high, (*new_intracomm_ptr));
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIR_Comm_commit((*new_intracomm_ptr));
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
fn_exit:
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPIR_COMM_KIND__INTERCOMM_MERGE_IMPL);
return mpi_errno;
fn_fail:
goto fn_exit;
}
