void MPIR_CommL_forget( MPID_Comm *comm_ptr )
{
#if defined(FINEGRAIN_MPI) /* FG: TODO Temporary bypass */
return;
#endif
MPID_Comm *p, *prev;
MPIU_DBG_MSG_P(COMM,VERBOSE,
"Forgetting communicator %p from remember list",comm_ptr);
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr));
p = MPIR_All_communicators.head;
prev = 0;
while (p) {
if (p == comm_ptr) {
if (prev) prev->comm_next = p->comm_next;
else MPIR_All_communicators.head = p->comm_next;
break;
}
if (p == p->comm_next) {
MPL_internal_error_printf( "Mangled pointers to communicators - next is itself for %p\n", p );
break;
}
prev = p;
p = p->comm_next;
}
/* Record a change to the list */
MPIR_All_communicators.sequence_number++;
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr));
}
void MPIR_Comm_get_errhandler_impl(MPIR_Comm * comm_ptr, MPIR_Errhandler ** errhandler_ptr)
{
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr));
*errhandler_ptr = comm_ptr->errhandler;
if (comm_ptr->errhandler)
MPIR_Errhandler_add_ref(comm_ptr->errhandler);
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr));
return;
}
int MPIR_Comm_copy_data(MPID_Comm * comm_ptr, MPID_Comm ** outcomm_ptr)
{
int mpi_errno = MPI_SUCCESS;
MPID_Comm *newcomm_ptr = NULL;
MPID_MPI_STATE_DECL(MPID_STATE_MPIR_COMM_COPY_DATA);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPIR_COMM_COPY_DATA);
mpi_errno = MPIR_Comm_create(&newcomm_ptr);
if (mpi_errno)
goto fn_fail;
/* use a large garbage value to ensure errors are caught more easily */
newcomm_ptr->context_id = 32767;
newcomm_ptr->recvcontext_id = 32767;
/* Save the kind of the communicator */
newcomm_ptr->comm_kind = comm_ptr->comm_kind;
newcomm_ptr->local_comm = 0;
if (comm_ptr->comm_kind == MPID_INTRACOMM)
MPIR_Comm_map_dup(newcomm_ptr, comm_ptr, MPIR_COMM_MAP_DIR_L2L);
else
MPIR_Comm_map_dup(newcomm_ptr, comm_ptr, MPIR_COMM_MAP_DIR_R2R);
/* If it is an intercomm, duplicate the network address mapping */
if (comm_ptr->comm_kind == MPID_INTERCOMM) {
MPIR_Comm_map_dup(newcomm_ptr, comm_ptr, MPIR_COMM_MAP_DIR_L2L);
}
/* Set the sizes and ranks */
newcomm_ptr->rank = comm_ptr->rank;
newcomm_ptr->local_size = comm_ptr->local_size;
newcomm_ptr->remote_size = comm_ptr->remote_size;
newcomm_ptr->is_low_group = comm_ptr->is_low_group; /* only relevant for intercomms */
/* Inherit the error handler (if any) */
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr));
newcomm_ptr->errhandler = comm_ptr->errhandler;
if (comm_ptr->errhandler) {
MPIR_Errhandler_add_ref(comm_ptr->errhandler);
}
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr));
/* FIXME do we want to copy coll_fns here? */
/* Start with no attributes on this communicator */
newcomm_ptr->attributes = 0;
*outcomm_ptr = newcomm_ptr;
fn_fail:
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPIR_COMM_COPY_DATA);
return mpi_errno;
}
void MPIR_CommL_remember( MPID_Comm *comm_ptr )
{
#if defined(FINEGRAIN_MPI) /* FG: TODO Temporary bypass */
return;
#endif
MPIU_DBG_MSG_P(COMM,VERBOSE,
"Adding communicator %p to remember list",comm_ptr);
MPIU_DBG_MSG_P(COMM,VERBOSE,
"Remember list structure address is %p",&MPIR_All_communicators);
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr));
if (comm_ptr == MPIR_All_communicators.head) {
MPL_internal_error_printf( "Internal error: communicator is already on free list\n" );
return;
}
comm_ptr->comm_next = MPIR_All_communicators.head;
MPIR_All_communicators.head = comm_ptr;
MPIR_All_communicators.sequence_number++;
MPIU_DBG_MSG_P(COMM,VERBOSE,
"master head is %p", MPIR_All_communicators.head );
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr));
}
int MPIR_Comm_copy(MPID_Comm * comm_ptr, int size, MPID_Comm ** outcomm_ptr)
{
int mpi_errno = MPI_SUCCESS;
MPIU_Context_id_t new_context_id, new_recvcontext_id;
MPID_Comm *newcomm_ptr = NULL;
MPIR_Comm_map_t *map;
MPID_MPI_STATE_DECL(MPID_STATE_MPIR_COMM_COPY);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPIR_COMM_COPY);
/* Get a new context first. We need this to be collective over the
* input communicator */
/* If there is a context id cache in oldcomm, use it here. Otherwise,
* use the appropriate algorithm to get a new context id. Be careful
* of intercomms here */
if (comm_ptr->comm_kind == MPID_INTERCOMM) {
mpi_errno = MPIR_Get_intercomm_contextid(comm_ptr, &new_context_id, &new_recvcontext_id);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
}
else {
mpi_errno = MPIR_Get_contextid_sparse(comm_ptr, &new_context_id, FALSE);
new_recvcontext_id = new_context_id;
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIU_Assert(new_context_id != 0);
}
/* This is the local size, not the remote size, in the case of
* an intercomm */
if (comm_ptr->rank >= size) {
*outcomm_ptr = 0;
/* always free the recvcontext ID, never the "send" ID */
MPIR_Free_contextid(new_recvcontext_id);
goto fn_exit;
}
/* We're left with the processes that will have a non-null communicator.
* Create the object, initialize the data, and return the result */
mpi_errno = MPIR_Comm_create(&newcomm_ptr);
if (mpi_errno)
goto fn_fail;
newcomm_ptr->context_id = new_context_id;
newcomm_ptr->recvcontext_id = new_recvcontext_id;
/* Save the kind of the communicator */
newcomm_ptr->comm_kind = comm_ptr->comm_kind;
newcomm_ptr->local_comm = 0;
/* There are two cases here - size is the same as the old communicator,
* or it is smaller. If the size is the same, we can just add a reference.
* Otherwise, we need to create a new network address mapping. Note that this is the
* test that matches the test on rank above. */
if (size == comm_ptr->local_size) {
/* Duplicate the network address mapping */
if (comm_ptr->comm_kind == MPID_INTRACOMM)
MPIR_Comm_map_dup(newcomm_ptr, comm_ptr, MPIR_COMM_MAP_DIR_L2L);
else
MPIR_Comm_map_dup(newcomm_ptr, comm_ptr, MPIR_COMM_MAP_DIR_R2R);
}
else {
int i;
if (comm_ptr->comm_kind == MPID_INTRACOMM)
MPIR_Comm_map_irregular(newcomm_ptr, comm_ptr, NULL, size, MPIR_COMM_MAP_DIR_L2L, &map);
else
MPIR_Comm_map_irregular(newcomm_ptr, comm_ptr, NULL, size, MPIR_COMM_MAP_DIR_R2R, &map);
for (i = 0; i < size; i++) {
/* For rank i in the new communicator, find the corresponding
* rank in the input communicator */
map->src_mapping[i] = i;
}
}
/* If it is an intercomm, duplicate the local network address references */
if (comm_ptr->comm_kind == MPID_INTERCOMM) {
MPIR_Comm_map_dup(newcomm_ptr, comm_ptr, MPIR_COMM_MAP_DIR_L2L);
}
/* Set the sizes and ranks */
newcomm_ptr->rank = comm_ptr->rank;
if (comm_ptr->comm_kind == MPID_INTERCOMM) {
newcomm_ptr->local_size = comm_ptr->local_size;
newcomm_ptr->remote_size = comm_ptr->remote_size;
newcomm_ptr->is_low_group = comm_ptr->is_low_group;
}
else {
newcomm_ptr->local_size = size;
newcomm_ptr->remote_size = size;
}
/* Inherit the error handler (if any) */
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr));
newcomm_ptr->errhandler = comm_ptr->errhandler;
if (comm_ptr->errhandler) {
MPIR_Errhandler_add_ref(comm_ptr->errhandler);
}
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr));
/* FIXME do we want to copy coll_fns here? */
mpi_errno = MPIR_Comm_commit(newcomm_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* Start with no attributes on this communicator */
newcomm_ptr->attributes = 0;
/* Copy over the info hints from the original communicator. */
mpi_errno = MPIR_Info_dup_impl(comm_ptr->info, &(newcomm_ptr->info));
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIR_Comm_apply_hints(newcomm_ptr, newcomm_ptr->info);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
*outcomm_ptr = newcomm_ptr;
fn_fail:
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPIR_COMM_COPY);
return mpi_errno;
}
int MPIR_Intercomm_create_impl(MPIR_Comm *local_comm_ptr, int local_leader,
MPIR_Comm *peer_comm_ptr, int remote_leader, int tag,
MPIR_Comm **new_intercomm_ptr)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Context_id_t final_context_id, recvcontext_id;
int remote_size = 0, *remote_lpids = NULL;
int comm_info[3];
int is_low_group = 0;
int cts_tag;
MPIR_Errflag_t errflag = MPIR_ERR_NONE;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPIR_COMM_KIND__INTERCOMM_CREATE_IMPL);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPIR_COMM_KIND__INTERCOMM_CREATE_IMPL);
/* Shift tag into the tagged coll space (tag provided by the user
is ignored as of MPI 3.0) */
cts_tag = MPIR_COMM_KIND__INTERCOMM_CREATE_TAG | MPIR_Process.tagged_coll_mask;
mpi_errno = MPID_Intercomm_exchange_map(local_comm_ptr, local_leader,
peer_comm_ptr, remote_leader,
&remote_size, &remote_lpids,
&is_low_group);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
/*
* Create the contexts. Each group will have a context for sending
* to the other group. All processes must be involved. Because
* we know that the local and remote groups are disjoint, this
* step will complete
*/
MPL_DBG_MSG_FMT(MPIR_DBG_COMM,VERBOSE, (MPL_DBG_FDEST,"About to get contextid (local_size=%d) on rank %d",
local_comm_ptr->local_size, local_comm_ptr->rank ));
/* In the multi-threaded case, MPIR_Get_contextid_sparse assumes that the
calling routine already holds the single criticial section */
/* TODO: Make sure this is tag-safe */
mpi_errno = MPIR_Get_contextid_sparse( local_comm_ptr, &recvcontext_id, FALSE );
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_Assert(recvcontext_id != 0);
MPL_DBG_MSG_FMT(MPIR_DBG_COMM,VERBOSE, (MPL_DBG_FDEST,"Got contextid=%d", recvcontext_id));
/* Leaders can now swap context ids and then broadcast the value
to the local group of processes */
if (local_comm_ptr->rank == local_leader) {
MPIR_Context_id_t remote_context_id;
mpi_errno = MPIC_Sendrecv( &recvcontext_id, 1, MPIR_CONTEXT_ID_T_DATATYPE, remote_leader, cts_tag,
&remote_context_id, 1, MPIR_CONTEXT_ID_T_DATATYPE, remote_leader, cts_tag,
peer_comm_ptr, MPI_STATUS_IGNORE, &errflag );
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
final_context_id = remote_context_id;
/* Now, send all of our local processes the remote_lpids,
along with the final context id */
comm_info[0] = final_context_id;
MPL_DBG_MSG(MPIR_DBG_COMM,VERBOSE,"About to bcast on local_comm");
mpi_errno = MPID_Bcast( comm_info, 1, MPI_INT, local_leader, local_comm_ptr, &errflag );
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_ERR_CHKANDJUMP(errflag, mpi_errno, MPI_ERR_OTHER, "**coll_fail");
MPL_DBG_MSG_D(MPIR_DBG_COMM,VERBOSE,"end of bcast on local_comm of size %d",
local_comm_ptr->local_size );
}
else
{
/* we're the other processes */
MPL_DBG_MSG(MPIR_DBG_COMM,VERBOSE,"About to receive bcast on local_comm");
mpi_errno = MPID_Bcast( comm_info, 1, MPI_INT, local_leader, local_comm_ptr, &errflag );
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_ERR_CHKANDJUMP(errflag, mpi_errno, MPI_ERR_OTHER, "**coll_fail");
/* Extract the context and group sign informatin */
final_context_id = comm_info[0];
}
/* At last, we now have the information that we need to build the
intercommunicator */
/* All processes in the local_comm now build the communicator */
mpi_errno = MPIR_Comm_create( new_intercomm_ptr );
if (mpi_errno) goto fn_fail;
(*new_intercomm_ptr)->context_id = final_context_id;
(*new_intercomm_ptr)->recvcontext_id = recvcontext_id;
(*new_intercomm_ptr)->remote_size = remote_size;
(*new_intercomm_ptr)->local_size = local_comm_ptr->local_size;
(*new_intercomm_ptr)->pof2 = local_comm_ptr->pof2;
(*new_intercomm_ptr)->rank = local_comm_ptr->rank;
(*new_intercomm_ptr)->comm_kind = MPIR_COMM_KIND__INTERCOMM;
(*new_intercomm_ptr)->local_comm = 0;
(*new_intercomm_ptr)->is_low_group = is_low_group;
mpi_errno = MPID_Create_intercomm_from_lpids( *new_intercomm_ptr, remote_size, remote_lpids );
if (mpi_errno) goto fn_fail;
MPIR_Comm_map_dup(*new_intercomm_ptr, local_comm_ptr, MPIR_COMM_MAP_DIR__L2L);
/* Inherit the error handler (if any) */
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(local_comm_ptr));
(*new_intercomm_ptr)->errhandler = local_comm_ptr->errhandler;
if (local_comm_ptr->errhandler) {
MPIR_Errhandler_add_ref( local_comm_ptr->errhandler );
}
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(local_comm_ptr));
mpi_errno = MPIR_Comm_commit(*new_intercomm_ptr);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
fn_exit:
if (remote_lpids) {
MPL_free(remote_lpids);
remote_lpids = NULL;
}
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPIR_COMM_KIND__INTERCOMM_CREATE_IMPL);
return mpi_errno;
fn_fail:
goto fn_exit;
}
/*@
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_call_errhandler - Call the error handler installed on a
communicator
Input Parameters:
+ comm - communicator with error handler (handle)
- errorcode - error code (integer)
Note:
Assuming the input parameters are valid, when the error handler is set to
MPI_ERRORS_RETURN, this routine will always return MPI_SUCCESS.
.N ThreadSafeNoUpdate
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
@*/
int MPI_Comm_call_errhandler(MPI_Comm comm, int errorcode)
{
int mpi_errno = MPI_SUCCESS;
int in_cs = FALSE;
MPIR_Comm *comm_ptr = NULL;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_COMM_CALL_ERRHANDLER);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_COMM_CALL_ERRHANDLER);
/* 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);
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr)); /* protect access to comm_ptr->errhandler */
in_cs = TRUE;
/* Validate parameters and objects (post conversion) */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate comm_ptr; if comm_ptr is not value, it will be reset
* to null */
MPIR_Comm_valid_ptr(comm_ptr, mpi_errno, TRUE);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
if (comm_ptr->errhandler) {
MPIR_ERRTEST_ERRHANDLER(comm_ptr->errhandler->handle, mpi_errno);
}
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
/* Check for predefined error handlers */
if (!comm_ptr->errhandler || comm_ptr->errhandler->handle == MPI_ERRORS_ARE_FATAL) {
mpi_errno = MPIR_Err_return_comm(comm_ptr, "MPI_Comm_call_errhandler", errorcode);
goto fn_exit;
}
if (comm_ptr->errhandler->handle == MPI_ERRORS_RETURN) {
/* MPI_ERRORS_RETURN should always return MPI_SUCCESS */
goto fn_exit;
}
/* Check for the special case of errors-throw-exception. In this case
* return the error code; the C++ wrapper will cause an exception to
* be thrown.
*/
#ifdef HAVE_CXX_BINDING
if (comm_ptr->errhandler->handle == MPIR_ERRORS_THROW_EXCEPTIONS) {
mpi_errno = errorcode;
goto fn_exit;
}
#endif
/* Process any user-defined error handling function */
switch (comm_ptr->errhandler->language) {
case MPIR_LANG__C:
(*comm_ptr->errhandler->errfn.C_Comm_Handler_function) (&comm_ptr->handle, &errorcode);
break;
#ifdef HAVE_CXX_BINDING
case MPIR_LANG__CXX:
MPIR_Process.cxx_call_errfn(0, &comm_ptr->handle,
&errorcode,
(void (*)(void)) comm_ptr->errhandler->
errfn.C_Comm_Handler_function);
break;
#endif
#ifdef HAVE_FORTRAN_BINDING
case MPIR_LANG__FORTRAN90:
case MPIR_LANG__FORTRAN:
{
/* If int and MPI_Fint aren't the same size, we need to
* convert. As this is not performance critical, we
* do this even if MPI_Fint and int are the same size. */
MPI_Fint ferr = errorcode;
MPI_Fint commhandle = comm_ptr->handle;
(*comm_ptr->errhandler->errfn.F77_Handler_function) (&commhandle, &ferr);
}
break;
#endif
}
/* ... end of body of routine ... */
fn_exit:
if (in_cs)
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr));
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_COMM_CALL_ERRHANDLER);
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_comm_call_errhandler", "**mpi_comm_call_errhandler %C %d",
comm, errorcode);
}
mpi_errno = MPIR_Err_return_comm(comm_ptr, __func__, mpi_errno);
goto fn_exit;
#endif
/* --END ERROR HANDLING-- */
}
