/*@ MPI_Comm_dup - Duplicates an existing communicator with all its cached information Input Parameter: . comm - communicator (handle) Output Parameter: . newcomm - A new communicator over the same group as 'comm' but with a new context. See notes. (handle) Notes: This routine is used to create a new communicator that has a new communication context but contains the same group of processes as the input communicator. Since all MPI communication is performed within a communicator (specifies as the group of processes `plus` the context), this routine provides an effective way to create a private communicator for use by a software module or library. In particular, no library routine should use 'MPI_COMM_WORLD' as the communicator; instead, a duplicate of a user-specified communicator should always be used. For more information, see Using MPI, 2nd edition. Because this routine essentially produces a copy of a communicator, it also copies any attributes that have been defined on the input communicator, using the attribute copy function specified by the 'copy_function' argument to 'MPI_Keyval_create'. This is particularly useful for (a) attributes that describe some property of the group associated with the communicator, such as its interconnection topology and (b) communicators that are given back to the user; the attibutes in this case can track subsequent 'MPI_Comm_dup' operations on this communicator. .N fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_COMM .N MPI_ERR_EXHAUSTED .seealso: MPI_Comm_free, MPI_Keyval_create, MPI_Attr_set, MPI_Attr_delete @*/ int MPI_Comm_dup ( MPI_Comm comm, MPI_Comm *comm_out ) { struct MPIR_COMMUNICATOR *new_comm, *comm_ptr; int mpi_errno; MPIR_ERROR_DECL; static char myname[] = "MPI_COMM_DUP"; disableSignal(); TR_PUSH(myname); comm_ptr = MPIR_GET_COMM_PTR(comm); /* Check for non-null communicator */ if ( MPIR_TEST_COMM_NOTOK(comm,comm_ptr) ) { (*comm_out) = MPI_COMM_NULL; revertSignal(); return MPIR_ERROR( comm_ptr, MPI_ERR_COMM, myname); } /* Duplicate the communicator */ MPIR_ALLOC(new_comm,NEW(struct MPIR_COMMUNICATOR),comm_ptr,MPI_ERR_EXHAUSTED, "MPI_COMM_DUP" ); MPIR_Comm_init( new_comm, comm_ptr, comm_ptr->comm_type ); MPIR_Group_dup ( comm_ptr->group, &(new_comm->group) ); MPIR_Group_dup ( comm_ptr->local_group, &(new_comm->local_group) ); new_comm->local_rank = new_comm->local_group->local_rank; new_comm->lrank_to_grank = new_comm->group->lrank_to_grank; new_comm->np = new_comm->group->np; new_comm->comm_name = 0; DBG(FPRINTF(OUTFILE,"Dup:About to copy attr for comm %ld\n",(long)comm);) /* Also free at least some of the parts of the commuicator */ if ((mpi_errno = MPIR_Attr_copy ( comm_ptr, new_comm ) )) {
int MPIR_Comm_create(MPID_Comm ** newcomm_ptr) { int mpi_errno = MPI_SUCCESS; MPID_Comm *newptr; MPID_MPI_STATE_DECL(MPID_STATE_MPIR_COMM_CREATE); MPID_MPI_FUNC_ENTER(MPID_STATE_MPIR_COMM_CREATE); newptr = (MPID_Comm *) MPIU_Handle_obj_alloc(&MPID_Comm_mem); MPIR_ERR_CHKANDJUMP(!newptr, mpi_errno, MPI_ERR_OTHER, "**nomem"); *newcomm_ptr = newptr; mpi_errno = MPIR_Comm_init(newptr); if (mpi_errno) MPIR_ERR_POP(mpi_errno); /* Insert this new communicator into the list of known communicators. * Make this conditional on debugger support to match the test in * MPIR_Comm_release . */ MPIR_COMML_REMEMBER(newptr); fn_fail: MPID_MPI_FUNC_EXIT(MPID_STATE_MPIR_COMM_CREATE); return mpi_errno; }
int MPIR_Setup_intercomm_localcomm(MPID_Comm * intercomm_ptr) { MPID_Comm *localcomm_ptr; int mpi_errno = MPI_SUCCESS; MPID_MPI_STATE_DECL(MPID_STATE_MPIR_SETUP_INTERCOMM_LOCALCOMM); MPID_MPI_FUNC_ENTER(MPID_STATE_MPIR_SETUP_INTERCOMM_LOCALCOMM); localcomm_ptr = (MPID_Comm *) MPIU_Handle_obj_alloc(&MPID_Comm_mem); MPIR_ERR_CHKANDJUMP(!localcomm_ptr, mpi_errno, MPI_ERR_OTHER, "**nomem"); /* get sensible default values for most fields (usually zeros) */ mpi_errno = MPIR_Comm_init(localcomm_ptr); if (mpi_errno) MPIR_ERR_POP(mpi_errno); /* use the parent intercomm's recv ctx as the basis for our ctx */ localcomm_ptr->recvcontext_id = MPID_CONTEXT_SET_FIELD(IS_LOCALCOMM, intercomm_ptr->recvcontext_id, 1); localcomm_ptr->context_id = localcomm_ptr->recvcontext_id; MPIU_DBG_MSG_FMT(COMM, TYPICAL, (MPIU_DBG_FDEST, "setup_intercomm_localcomm ic=%p ic->context_id=%d ic->recvcontext_id=%d lc->recvcontext_id=%d", intercomm_ptr, intercomm_ptr->context_id, intercomm_ptr->recvcontext_id, localcomm_ptr->recvcontext_id)); /* Save the kind of the communicator */ localcomm_ptr->comm_kind = MPID_INTRACOMM; /* Set the sizes and ranks */ localcomm_ptr->remote_size = intercomm_ptr->local_size; localcomm_ptr->local_size = intercomm_ptr->local_size; localcomm_ptr->rank = intercomm_ptr->rank; MPIR_Comm_map_dup(localcomm_ptr, intercomm_ptr, MPIR_COMM_MAP_DIR_L2L); /* TODO More advanced version: if the group is available, dup it by * increasing the reference count instead of recreating it later */ /* FIXME : No coll_fns functions for the collectives */ /* FIXME : No local functions for the topology routines */ intercomm_ptr->local_comm = localcomm_ptr; /* sets up the SMP-aware sub-communicators and tables */ mpi_errno = MPIR_Comm_commit(localcomm_ptr); if (mpi_errno) MPIR_ERR_POP(mpi_errno); fn_fail: MPID_MPI_FUNC_EXIT(MPID_STATE_MPIR_SETUP_INTERCOMM_LOCALCOMM); return mpi_errno; }
int MPIR_Init_thread(int * argc, char ***argv, int required, int * provided) { int mpi_errno = MPI_SUCCESS; int has_args; int has_env; int thread_provided; int exit_init_cs_on_failure = 0; /* For any code in the device that wants to check for runtime decisions on the value of isThreaded, set a provisional value here. We could let the MPID_Init routine override this */ #ifdef HAVE_RUNTIME_THREADCHECK MPIR_ThreadInfo.isThreaded = required == MPI_THREAD_MULTIPLE; #endif MPIU_THREAD_CS_INIT; /* FIXME: Move to os-dependent interface? */ #ifdef HAVE_WINDOWS_H /* prevent the process from bringing up an error message window if mpich asserts */ _CrtSetReportMode( _CRT_ASSERT, _CRTDBG_MODE_FILE ); _CrtSetReportFile( _CRT_ASSERT, _CRTDBG_FILE_STDERR ); _CrtSetReportHook2(_CRT_RPTHOOK_INSTALL, assert_hook); #ifdef _WIN64 { /* FIXME: (Windows) This severly degrades performance but fixes alignment issues with the datatype code. */ /* Prevent misaligned faults on Win64 machines */ UINT mode, old_mode; old_mode = SetErrorMode(SEM_NOALIGNMENTFAULTEXCEPT); mode = old_mode | SEM_NOALIGNMENTFAULTEXCEPT; SetErrorMode(mode); } #endif #endif /* We need this inorder to implement IS_THREAD_MAIN */ # if (MPICH_THREAD_LEVEL >= MPI_THREAD_SERIALIZED) && defined(MPICH_IS_THREADED) { MPID_Thread_self(&MPIR_ThreadInfo.master_thread); } # endif #ifdef HAVE_ERROR_CHECKING /* Because the PARAM system has not been initialized, temporarily uncondtionally enable error checks. Once the PARAM system is initialized, this may be reset */ MPIR_Process.do_error_checks = 1; #else MPIR_Process.do_error_checks = 0; #endif /* Initialize necessary subsystems and setup the predefined attribute values. Subsystems may change these values. */ MPIR_Process.attrs.appnum = -1; MPIR_Process.attrs.host = 0; MPIR_Process.attrs.io = 0; MPIR_Process.attrs.lastusedcode = MPI_ERR_LASTCODE; MPIR_Process.attrs.tag_ub = 0; MPIR_Process.attrs.universe = MPIR_UNIVERSE_SIZE_NOT_SET; MPIR_Process.attrs.wtime_is_global = 0; /* Set the functions used to duplicate attributes. These are when the first corresponding keyval is created */ MPIR_Process.attr_dup = 0; MPIR_Process.attr_free = 0; #ifdef HAVE_CXX_BINDING /* Set the functions used to call functions in the C++ binding for reductions and attribute operations. These are null until a C++ operation is defined. This allows the C code that implements these operations to not invoke a C++ code directly, which may force the inclusion of symbols known only to the C++ compiler (e.g., under more non-GNU compilers, including Solaris and IRIX). */ MPIR_Process.cxx_call_op_fn = 0; #endif /* This allows the device to select an alternative function for dimsCreate */ MPIR_Process.dimsCreate = 0; /* "Allocate" from the reserved space for builtin communicators and (partially) initialize predefined communicators. comm_parent is intially NULL and will be allocated by the device if the process group was started using one of the MPI_Comm_spawn functions. */ MPIR_Process.comm_world = MPID_Comm_builtin + 0; MPIR_Comm_init(MPIR_Process.comm_world); MPIR_Process.comm_world->handle = MPI_COMM_WORLD; MPIR_Process.comm_world->context_id = 0 << MPID_CONTEXT_PREFIX_SHIFT; MPIR_Process.comm_world->recvcontext_id = 0 << MPID_CONTEXT_PREFIX_SHIFT; MPIR_Process.comm_world->comm_kind = MPID_INTRACOMM; /* This initialization of the comm name could be done only when comm_get_name is called */ MPIU_Strncpy(MPIR_Process.comm_world->name, "MPI_COMM_WORLD", MPI_MAX_OBJECT_NAME); MPIR_Process.comm_self = MPID_Comm_builtin + 1; MPIR_Comm_init(MPIR_Process.comm_self); MPIR_Process.comm_self->handle = MPI_COMM_SELF; MPIR_Process.comm_self->context_id = 1 << MPID_CONTEXT_PREFIX_SHIFT; MPIR_Process.comm_self->recvcontext_id = 1 << MPID_CONTEXT_PREFIX_SHIFT; MPIR_Process.comm_self->comm_kind = MPID_INTRACOMM; MPIU_Strncpy(MPIR_Process.comm_self->name, "MPI_COMM_SELF", MPI_MAX_OBJECT_NAME); #ifdef MPID_NEEDS_ICOMM_WORLD MPIR_Process.icomm_world = MPID_Comm_builtin + 2; MPIR_Comm_init(MPIR_Process.icomm_world); MPIR_Process.icomm_world->handle = MPIR_ICOMM_WORLD; MPIR_Process.icomm_world->context_id = 2 << MPID_CONTEXT_PREFIX_SHIFT; MPIR_Process.icomm_world->recvcontext_id= 2 << MPID_CONTEXT_PREFIX_SHIFT; MPIR_Process.icomm_world->comm_kind = MPID_INTRACOMM; MPIU_Strncpy(MPIR_Process.icomm_world->name, "MPI_ICOMM_WORLD", MPI_MAX_OBJECT_NAME); /* Note that these communicators are not ready for use - MPID_Init will setup self and world, and icomm_world if it desires it. */ #endif MPIR_Process.comm_parent = NULL; /* Setup the initial communicator list in case we have enabled the debugger message-queue interface */ MPIR_COMML_REMEMBER( MPIR_Process.comm_world ); MPIR_COMML_REMEMBER( MPIR_Process.comm_self ); /* Call any and all MPID_Init type functions */ MPIR_Err_init(); MPIR_Datatype_init(); MPIR_Group_init(); /* MPIU_Timer_pre_init(); */ mpi_errno = MPIR_Param_init_params(); if (mpi_errno) MPIU_ERR_POP(mpi_errno); /* Wait for debugger to attach if requested. */ if (MPIR_PARAM_DEBUG_HOLD) { volatile int hold = 1; while (hold) #ifdef HAVE_USLEEP usleep(100); #endif ; } #if HAVE_ERROR_CHECKING == MPID_ERROR_LEVEL_RUNTIME MPIR_Process.do_error_checks = MPIR_PARAM_ERROR_CHECKING; #endif /* define MPI as initialized so that we can use MPI functions within MPID_Init if necessary */ MPIR_Process.initialized = MPICH_WITHIN_MPI; /* We can't acquire any critical sections until this point. Any * earlier the basic data structures haven't been initialized */ MPIU_THREAD_CS_ENTER(INIT,required); exit_init_cs_on_failure = 1; mpi_errno = MPID_Init(argc, argv, required, &thread_provided, &has_args, &has_env); if (mpi_errno) MPIU_ERR_POP(mpi_errno); /* Capture the level of thread support provided */ MPIR_ThreadInfo.thread_provided = thread_provided; if (provided) *provided = thread_provided; #ifdef HAVE_RUNTIME_THREADCHECK MPIR_ThreadInfo.isThreaded = (thread_provided == MPI_THREAD_MULTIPLE); #endif /* FIXME: Define these in the interface. Does Timer init belong here? */ MPIU_dbg_init(MPIR_Process.comm_world->rank); MPIU_Timer_init(MPIR_Process.comm_world->rank, MPIR_Process.comm_world->local_size); #ifdef USE_MEMORY_TRACING MPIU_trinit( MPIR_Process.comm_world->rank ); /* Indicate that we are near the end of the init step; memory allocated already will have an id of zero; this helps separate memory leaks in the initialization code from leaks in the "active" code */ /* Uncomment this code to leave out any of the MPID_Init/etc memory allocations from the memory leak testing */ /* MPIU_trid( 1 ); */ #endif #ifdef USE_DBG_LOGGING MPIU_DBG_Init( argc, argv, has_args, has_env, MPIR_Process.comm_world->rank ); #endif /* Initialize the C versions of the Fortran link-time constants. We now initialize the Fortran symbols from within the Fortran interface in the routine that first needs the symbols. This fixes a problem with symbols added by a Fortran compiler that are not part of the C runtime environment (the Portland group compilers would do this) */ #if defined(HAVE_FORTRAN_BINDING) && defined(HAVE_MPI_F_INIT_WORKS_WITH_C) mpirinitf_(); #endif /* FIXME: Does this need to come before the call to MPID_InitComplete? For some debugger support, MPIR_WaitForDebugger may want to use MPI communication routines to collect information for the debugger */ #ifdef HAVE_DEBUGGER_SUPPORT MPIR_WaitForDebugger(); #endif /* Let the device know that the rest of the init process is completed */ if (mpi_errno == MPI_SUCCESS) mpi_errno = MPID_InitCompleted(); #if defined(_OSU_MVAPICH_) || defined(_OSU_PSM_) if (is_shmem_collectives_enabled()){ if (check_split_comm(pthread_self())){ int my_id, size; PMPI_Comm_rank(MPI_COMM_WORLD, &my_id); PMPI_Comm_size(MPI_COMM_WORLD, &size); disable_split_comm(pthread_self()); create_2level_comm(MPI_COMM_WORLD, size, my_id); enable_split_comm(pthread_self()); } } #endif /* defined(_OSU_MVAPICH_) || defined(_OSU_PSM_) */ fn_exit: MPIU_THREAD_CS_EXIT(INIT,required); return mpi_errno; fn_fail: /* --BEGIN ERROR HANDLING-- */ /* signal to error handling routines that core services are unavailable */ MPIR_Process.initialized = MPICH_PRE_INIT; if (exit_init_cs_on_failure) { MPIU_THREAD_CS_EXIT(INIT,required); } MPIU_THREAD_CS_FINALIZE; return mpi_errno; /* --END ERROR HANDLING-- */ }
/*@ MPI_Intercomm_create - Creates an intercommuncator from two intracommunicators Input Paramters: + local_comm - Local (intra)communicator . local_leader - Rank in local_comm of leader (often 0) . peer_comm - Remote communicator . 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 Parameter: . comm_out - Created intercommunicator Notes: The MPI 1.1 Standard contains two mutually exclusive comments on the input intracommunicators. 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 fortran Algorithm: + 1) Allocate a send context, an inter-coll context, and an intra-coll context . 2) Send "send_context" and lrank_to_grank list from local comm group if I''m the local_leader. . 3) If I''m the local leader, then wait on the posted sends and receives to complete. Post the receive for the remote group information and wait for it to complete. . 4) Broadcast information received from the remote leader. . 5) Create the inter_communicator from the information we now have. - An inter-communicator ends up with three levels of communicators. The inter-communicator returned to the user, a "collective" inter-communicator that can be used for safe communications between local & remote groups, and a collective intra-communicator that can be used to allocate new contexts during the merge and dup operations. For the resulting inter-communicator, 'comm_out' .vb comm_out = inter-communicator comm_out->comm_coll = "collective" inter-communicator comm_out->comm_coll->comm_coll = safe collective intra-communicator .ve .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 @*/ EXPORT_MPI_API int MPI_Intercomm_create ( MPI_Comm local_comm, int local_leader, MPI_Comm peer_comm, int remote_leader, int tag, MPI_Comm *comm_out ) { int local_size, local_rank, peer_size, peer_rank; int remote_size; int mpi_errno = MPI_SUCCESS; MPIR_CONTEXT context, send_context; struct MPIR_GROUP *remote_group_ptr; struct MPIR_COMMUNICATOR *new_comm, *local_comm_ptr, *peer_comm_ptr; MPI_Request req[6]; MPI_Status status[6]; MPIR_ERROR_DECL; static char myname[]="MPI_INTERCOMM_CREATE"; TR_PUSH(myname); local_comm_ptr = MPIR_GET_COMM_PTR(local_comm); #ifndef MPIR_NO_ERROR_CHECKING /* Check for valid arguments to function */ MPIR_TEST_MPI_COMM(local_comm,local_comm_ptr,local_comm_ptr,myname); MPIR_TEST_SEND_TAG(tag); if (mpi_errno) return MPIR_ERROR(local_comm_ptr, mpi_errno, myname ); #endif if (local_comm == MPI_COMM_NULL) { mpi_errno = MPIR_Err_setmsg( MPI_ERR_COMM, MPIR_ERR_LOCAL_COMM, myname, "Local communicator must not be MPI_COMM_NULL", (char *)0 ); return MPIR_ERROR( local_comm_ptr, mpi_errno, myname ); } (void) MPIR_Comm_size ( local_comm_ptr, &local_size ); (void) MPIR_Comm_rank ( local_comm_ptr, &local_rank ); if ( local_leader == local_rank ) { /* Peer_comm need be valid only at local_leader */ peer_comm_ptr = MPIR_GET_COMM_PTR(peer_comm); if ((MPIR_TEST_COMM_NOTOK(peer_comm,peer_comm_ptr) || (peer_comm == MPI_COMM_NULL))) { mpi_errno = MPIR_Err_setmsg( MPI_ERR_COMM, MPIR_ERR_PEER_COMM, myname, "Peer communicator is not valid", (char *)0 ); return MPIR_ERROR( local_comm_ptr, mpi_errno, myname ); } (void) MPIR_Comm_size ( peer_comm_ptr, &peer_size ); (void) MPIR_Comm_rank ( peer_comm_ptr, &peer_rank ); if (((peer_rank == MPI_UNDEFINED) && (mpi_errno = MPI_ERR_RANK))) return MPIR_ERROR( local_comm_ptr, mpi_errno, myname ); if (((remote_leader >= peer_size) && (mpi_errno = MPI_ERR_RANK)) || ((remote_leader < 0) && (mpi_errno = MPI_ERR_RANK))) { mpi_errno = MPIR_Err_setmsg( MPI_ERR_RANK, MPIR_ERR_REMOTE_RANK, myname, "Error specifying remote_leader", "Error specifying remote_leader; value %d not between 0 and %d", remote_leader, peer_size ); return MPIR_ERROR( local_comm_ptr, mpi_errno, myname ); } } if (((local_leader >= local_size) && (mpi_errno = MPI_ERR_RANK)) || ((local_leader < 0) && (mpi_errno = MPI_ERR_RANK))) { mpi_errno = MPIR_Err_setmsg( MPI_ERR_RANK, MPIR_ERR_LOCAL_RANK, myname, "Error specifying local_leader", "Error specifying local_leader; value %d not in between 0 and %d", local_leader, local_size ); return MPIR_ERROR( local_comm_ptr, mpi_errno, myname ); } /* Allocate send context, inter-coll context and intra-coll context */ MPIR_Context_alloc ( local_comm_ptr, 3, &context ); /* If I'm the local leader, then exchange information */ if (local_rank == local_leader) { MPIR_ERROR_PUSH(peer_comm_ptr); /* Post the receives for the information from the remote_leader */ /* We don't post a receive for the remote group yet, because we */ /* don't know how big it is yet. */ MPIR_CALL_POP(MPI_Irecv (&remote_size, 1, MPI_INT, remote_leader, tag, peer_comm, &(req[2])),peer_comm_ptr,myname); MPIR_CALL_POP(MPI_Irecv (&send_context, 1, MPIR_CONTEXT_TYPE, remote_leader,tag, peer_comm, &(req[3])), peer_comm_ptr,myname); /* Send the lrank_to_grank table of the local_comm and an allocated */ /* context. Currently I use multiple messages to send this info. */ /* Eventually, this will change(?) */ MPIR_CALL_POP(MPI_Isend (&local_size, 1, MPI_INT, remote_leader, tag, peer_comm, &(req[0])),peer_comm_ptr,myname); MPIR_CALL_POP(MPI_Isend (&context, 1, MPIR_CONTEXT_TYPE, remote_leader, tag, peer_comm, &(req[1])),peer_comm_ptr,myname); /* Wait on the communication requests to finish */ MPIR_CALL_POP(MPI_Waitall ( 4, req, status ),peer_comm_ptr,myname); /* We now know how big the remote group is, so create it */ remote_group_ptr = MPIR_CreateGroup ( remote_size ); remote_group_ptr->self = (MPI_Group) MPIR_FromPointer( remote_group_ptr ); /* Post the receive for the group information */ MPIR_CALL_POP(MPI_Irecv (remote_group_ptr->lrank_to_grank, remote_size, MPI_INT, remote_leader, tag, peer_comm, &(req[5])),peer_comm_ptr,myname); /* Send the local group info to the remote group */ MPIR_CALL_POP(MPI_Isend (local_comm_ptr->group->lrank_to_grank, local_size, MPI_INT, remote_leader, tag, peer_comm, &(req[4])),peer_comm_ptr,myname); /* wait on the send and the receive for the group information */ MPIR_CALL_POP(MPI_Waitall ( 2, &(req[4]), &(status[4]) ),peer_comm_ptr, myname); MPIR_ERROR_POP(peer_comm_ptr); /* Now we can broadcast the group information to the other local comm */ /* members. */ MPIR_ERROR_PUSH(local_comm_ptr); MPIR_CALL_POP(MPI_Bcast(&remote_size,1,MPI_INT,local_rank,local_comm), local_comm_ptr,myname); MPIR_CALL_POP(MPI_Bcast(remote_group_ptr->lrank_to_grank, remote_size, MPI_INT, local_rank, local_comm),local_comm_ptr, myname); MPIR_ERROR_POP(local_comm_ptr); } /* Else I'm just an ordinary comm member, so receive the bcast'd */ /* info about the remote group */ else { MPIR_ERROR_PUSH(local_comm_ptr); MPIR_CALL_POP(MPI_Bcast(&remote_size, 1, MPI_INT, local_leader, local_comm),local_comm_ptr,myname); /* We now know how big the remote group is, so create it */ remote_group_ptr = MPIR_CreateGroup ( remote_size ); remote_group_ptr->self = (MPI_Group) MPIR_FromPointer( remote_group_ptr ); /* Receive the group info */ MPIR_CALL_POP(MPI_Bcast(remote_group_ptr->lrank_to_grank, remote_size, MPI_INT, local_leader, local_comm), local_comm_ptr,myname ); MPIR_ERROR_POP(local_comm_ptr); } MPIR_ERROR_PUSH(local_comm_ptr); /* Broadcast the send context */ MPIR_CALL_POP(MPI_Bcast(&send_context, 1, MPIR_CONTEXT_TYPE, local_leader, local_comm),local_comm_ptr,myname); MPIR_ERROR_POP(local_comm_ptr); /* We all now have all the information necessary, start building the */ /* inter-communicator */ MPIR_ALLOC(new_comm,NEW(struct MPIR_COMMUNICATOR),local_comm_ptr, MPI_ERR_EXHAUSTED,myname ); MPIR_Comm_init( new_comm, local_comm_ptr, MPIR_INTER ); *comm_out = new_comm->self; new_comm->group = remote_group_ptr; MPIR_Group_dup( local_comm_ptr->group, &(new_comm->local_group) ); new_comm->local_rank = new_comm->local_group->local_rank; new_comm->lrank_to_grank = new_comm->group->lrank_to_grank; new_comm->np = new_comm->group->np; new_comm->send_context = send_context; new_comm->recv_context = context; new_comm->comm_name = 0; if ((mpi_errno = MPID_CommInit( local_comm_ptr, new_comm )) ) return mpi_errno; (void) MPIR_Attr_create_tree ( new_comm ); /* Build the collective inter-communicator */ MPIR_Comm_make_coll( new_comm, MPIR_INTER ); MPIR_Comm_make_onesided( new_comm, MPIR_INTER ); /* Build the collective intra-communicator. Note that we require an intra-communicator for the "coll_comm" so that MPI_COMM_DUP can use it for some collective operations (do we need this for MPI-2 with intercommunicator collective?) Note that this really isn't the right thing to do; we need to replace *all* of the Mississippi state collective code. */ MPIR_Comm_make_coll( new_comm->comm_coll, MPIR_INTRA ); #if 0 MPIR_Comm_make_coll( new_comm->comm_onesided, MPIR_INTRA ); #endif /* Remember it for the debugger */ MPIR_Comm_remember ( new_comm ); TR_POP; return (mpi_errno); }