/* comm create impl for intracommunicators, assumes that the standard error
* checking has already taken place in the calling function */
int MPIR_Comm_create_intra(MPID_Comm *comm_ptr, MPID_Group *group_ptr,
MPID_Comm **newcomm_ptr)
{
int mpi_errno = MPI_SUCCESS;
MPIU_Context_id_t new_context_id = 0;
int *mapping = NULL;
int n;
MPID_MPI_STATE_DECL(MPID_STATE_MPIR_COMM_CREATE_INTRA);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPIR_COMM_CREATE_INTRA);
MPIU_Assert(comm_ptr->comm_kind == MPID_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);
MPIU_Assert(new_context_id != 0);
if (group_ptr->rank != MPI_UNDEFINED) {
MPID_Comm *mapping_comm = NULL;
mpi_errno = MPIR_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;
/* 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 = MPIR_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);
MPID_MPI_FUNC_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;
}
/* 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(MPID_Comm *comm_ptr, MPID_Group *group_ptr,
MPID_Comm **newcomm_ptr)
{
int mpi_errno = MPI_SUCCESS;
MPIU_Context_id_t new_context_id;
int *mapping = NULL;
int *remote_mapping = NULL;
MPID_Comm *mapping_comm = NULL;
int remote_size = -1;
int rinfo[2];
MPIR_Errflag_t errflag = MPIR_ERR_NONE;
MPIU_CHKLMEM_DECL(1);
MPID_MPI_STATE_DECL(MPID_STATE_MPIR_COMM_CREATE_INTER);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPIR_COMM_CREATE_INTER);
MPIU_Assert(comm_ptr->comm_kind == MPID_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) {
MPIR_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);
MPIU_Assert(new_context_id != 0);
MPIU_Assert(new_context_id != comm_ptr->recvcontext_id);
mpi_errno = MPIR_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)->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];
MPIU_CHKLMEM_MALLOC(remote_mapping,int*,
remote_size*sizeof(int),
mpi_errno,"remote_mapping");
/* 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 = MPIR_Bcast_impl( rinfo, 2, MPI_INT, 0,
comm_ptr->local_comm, &errflag);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIR_Bcast_impl( 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 impl for intracommunicators, assumes that the standard error
* checking has already taken place in the calling function */
PMPI_LOCAL int MPIR_Comm_create_intra(MPID_Comm *comm_ptr, MPID_Group *group_ptr, MPI_Comm *newcomm)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Context_id_t new_context_id = 0;
MPID_Comm *newcomm_ptr = NULL;
int *mapping = NULL;
int n;
MPID_MPI_STATE_DECL(MPID_STATE_MPIR_COMM_CREATE_INTRA);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPIR_COMM_CREATE_INTRA);
MPIU_Assert(comm_ptr->comm_kind == MPID_INTRACOMM);
n = group_ptr->size;
*newcomm = MPI_COMM_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 assumes that the
calling routine already holds the single criticial section */
/* TODO should be converted to use MPIR_Get_contextid_sparse instead */
mpi_errno = MPIR_Get_contextid( comm_ptr, &new_context_id );
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
MPIU_Assert(new_context_id != 0);
if (group_ptr->rank != MPI_UNDEFINED) {
MPID_VCR *mapping_vcr = NULL;
mpi_errno = MPIR_Comm_create_calculate_mapping(group_ptr, comm_ptr,
&mapping_vcr, &mapping);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
/* Get the new communicator structure and context id */
mpi_errno = MPIR_Comm_create( &newcomm_ptr );
if (mpi_errno) MPIU_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;
/* Setup the communicator's vc table. This is for the remote group,
which is the same as the local group for intracommunicators */
mpi_errno = MPIR_Comm_create_create_and_map_vcrt(n,
mapping,
mapping_vcr,
&newcomm_ptr->vcrt,
&newcomm_ptr->vcr);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
/* Notify the device of this new communicator */
MPID_Dev_comm_create_hook( newcomm_ptr );
mpi_errno = MPIR_Comm_commit(newcomm_ptr);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
MPIU_OBJ_PUBLISH_HANDLE(*newcomm, newcomm_ptr->handle);
}
else {
/* This process is not in the group */
MPIR_Free_contextid( new_context_id );
new_context_id = 0;
}
fn_exit:
if (mapping)
MPIU_Free(mapping);
MPID_MPI_FUNC_EXIT(MPID_STATE_MPIR_COMM_CREATE_INTRA);
return mpi_errno;
fn_fail:
if (newcomm_ptr != NULL) {
MPIR_Comm_release(newcomm_ptr, 0/*isDisconnect*/);
new_context_id = 0; /* MPIR_Comm_release frees the new ctx id */
}
if (new_context_id != 0)
MPIR_Free_contextid(new_context_id);
*newcomm = MPI_COMM_NULL;
goto fn_exit;
}
