int MPIR_Barrier(MPID_Comm *comm_ptr, MPIR_Errflag_t *errflag) { int mpi_errno = MPI_SUCCESS; if (comm_ptr->comm_kind == MPID_INTRACOMM) { /* intracommunicator */ mpi_errno = MPIR_Barrier_intra( comm_ptr, errflag ); if (mpi_errno) MPIR_ERR_POP(mpi_errno); } else { /* intercommunicator */ mpi_errno = MPIR_Barrier_inter( comm_ptr, errflag ); if (mpi_errno) MPIR_ERR_POP(mpi_errno); } fn_exit: return mpi_errno; fn_fail: goto fn_exit; }
PMPI_LOCAL int MPIR_Barrier_or_coll_fn(MPID_Comm *comm_ptr, int *errflag ) { int mpi_errno = MPI_SUCCESS; if (comm_ptr->coll_fns != NULL && comm_ptr->coll_fns->Barrier != NULL) { /* --BEGIN USEREXTENSION-- */ mpi_errno = comm_ptr->node_roots_comm->coll_fns->Barrier(comm_ptr, errflag); if (mpi_errno) MPIU_ERR_POP(mpi_errno); /* --END USEREXTENSION-- */ } else { mpi_errno = MPIR_Barrier_intra(comm_ptr, errflag); if (mpi_errno) MPIU_ERR_POP(mpi_errno); } fn_exit: return mpi_errno; fn_fail: goto fn_exit; }
int MPIR_Barrier_inter( MPID_Comm *comm_ptr, MPIR_Errflag_t *errflag ) { int rank, mpi_errno = MPI_SUCCESS, root; int mpi_errno_ret = MPI_SUCCESS; int i = 0; MPID_Comm *newcomm_ptr = NULL; rank = comm_ptr->rank; /* Get the local intracommunicator */ if (!comm_ptr->local_comm) { mpi_errno = MPIR_Setup_intercomm_localcomm( comm_ptr ); if (mpi_errno) MPIR_ERR_POP(mpi_errno); } newcomm_ptr = comm_ptr->local_comm; /* do a barrier on the local intracommunicator */ mpi_errno = MPIR_Barrier_intra(newcomm_ptr, errflag); if (mpi_errno) { /* for communication errors, just record the error but continue */ *errflag = MPIR_ERR_GET_CLASS(mpi_errno); MPIR_ERR_SET(mpi_errno, *errflag, "**fail"); MPIR_ERR_ADD(mpi_errno_ret, mpi_errno); } /* rank 0 on each group does an intercommunicator broadcast to the remote group to indicate that all processes in the local group have reached the barrier. We do a 1-byte bcast because a 0-byte bcast will just return without doing anything. */ /* first broadcast from left to right group, then from right to left group */ if (comm_ptr->is_low_group) { /* bcast to right*/ root = (rank == 0) ? MPI_ROOT : MPI_PROC_NULL; mpi_errno = MPIR_Bcast_inter(&i, 1, MPI_BYTE, root, comm_ptr, errflag); if (mpi_errno) { /* for communication errors, just record the error but continue */ *errflag = MPIR_ERR_GET_CLASS(mpi_errno); MPIR_ERR_SET(mpi_errno, *errflag, "**fail"); MPIR_ERR_ADD(mpi_errno_ret, mpi_errno); } /* receive bcast from right */ root = 0; mpi_errno = MPIR_Bcast_inter(&i, 1, MPI_BYTE, root, comm_ptr, errflag); if (mpi_errno) { /* for communication errors, just record the error but continue */ *errflag = MPIR_ERR_GET_CLASS(mpi_errno); MPIR_ERR_SET(mpi_errno, *errflag, "**fail"); MPIR_ERR_ADD(mpi_errno_ret, mpi_errno); } } else { /* receive bcast from left */ root = 0; mpi_errno = MPIR_Bcast_inter(&i, 1, MPI_BYTE, root, comm_ptr, errflag); if (mpi_errno) { /* for communication errors, just record the error but continue */ *errflag = MPIR_ERR_GET_CLASS(mpi_errno); MPIR_ERR_SET(mpi_errno, *errflag, "**fail"); MPIR_ERR_ADD(mpi_errno_ret, mpi_errno); } /* bcast to left */ root = (rank == 0) ? MPI_ROOT : MPI_PROC_NULL; mpi_errno = MPIR_Bcast_inter(&i, 1, MPI_BYTE, root, comm_ptr, errflag); if (mpi_errno) { /* for communication errors, just record the error but continue */ *errflag = MPIR_ERR_GET_CLASS(mpi_errno); MPIR_ERR_SET(mpi_errno, *errflag, "**fail"); MPIR_ERR_ADD(mpi_errno_ret, mpi_errno); } } fn_exit: if (mpi_errno_ret) mpi_errno = mpi_errno_ret; else if (*errflag != MPIR_ERR_NONE) MPIR_ERR_SET(mpi_errno, *errflag, "**coll_fail"); return mpi_errno; fn_fail: goto fn_exit; }
int MPIR_Barrier_impl(MPID_Comm *comm_ptr, int *errflag) { int mpi_errno = MPI_SUCCESS; int mpi_errno_ret = MPI_SUCCESS; if (comm_ptr->coll_fns != NULL && comm_ptr->coll_fns->Barrier != NULL) { mpi_errno = comm_ptr->coll_fns->Barrier(comm_ptr, errflag); if (mpi_errno) MPIU_ERR_POP(mpi_errno); } else { if (comm_ptr->comm_kind == MPID_INTRACOMM) { #if defined(USE_SMP_COLLECTIVES) if (MPIR_Comm_is_node_aware(comm_ptr)) { /* do the intranode barrier on all nodes */ if (comm_ptr->node_comm != NULL) { mpi_errno = MPIR_Barrier_or_coll_fn(comm_ptr->node_comm, errflag); if (mpi_errno) { /* for communication errors, just record the error but continue */ *errflag = TRUE; MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail"); MPIU_ERR_ADD(mpi_errno_ret, mpi_errno); } } /* do the barrier across roots of all nodes */ if (comm_ptr->node_roots_comm != NULL) { mpi_errno = MPIR_Barrier_or_coll_fn(comm_ptr->node_roots_comm, errflag); if (mpi_errno) { /* for communication errors, just record the error but continue */ *errflag = TRUE; MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail"); MPIU_ERR_ADD(mpi_errno_ret, mpi_errno); } } /* release the local processes on each node with a 1-byte broadcast (0-byte broadcast just returns without doing anything) */ if (comm_ptr->node_comm != NULL) { int i=0; mpi_errno = MPIR_Bcast_impl(&i, 1, MPI_BYTE, 0, comm_ptr->node_comm, errflag); if (mpi_errno) { /* for communication errors, just record the error but continue */ *errflag = TRUE; MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**fail"); MPIU_ERR_ADD(mpi_errno_ret, mpi_errno); } } } else { mpi_errno = MPIR_Barrier_intra( comm_ptr, errflag ); if (mpi_errno) MPIU_ERR_POP(mpi_errno); } #else mpi_errno = MPIR_Barrier_intra( comm_ptr, errflag ); if (mpi_errno) MPIU_ERR_POP(mpi_errno); #endif } else { /* intercommunicator */ mpi_errno = MPIR_Barrier_inter( comm_ptr, errflag ); if (mpi_errno) MPIU_ERR_POP(mpi_errno); } } fn_exit: if (mpi_errno_ret) mpi_errno = mpi_errno_ret; else if (*errflag) MPIU_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**coll_fail"); return mpi_errno; fn_fail: goto fn_exit; }