bcast.c

刚才是说明 现在是安装程序在 LINUX环境下进行编程的MPICH安装文件

             zero out the least significant "i" bits of relative_rank and
             relative_dst to find root of src and dst
             subtrees. Use ranks of roots as index to send from
             and recv into  buffer */ 

          dst_tree_root = relative_dst >> i;
          dst_tree_root <<= i;
          
          my_tree_root = relative_rank >> i;
          my_tree_root <<= i;

          send_offset = my_tree_root * scatter_size;
          recv_offset = dst_tree_root * scatter_size;

          if (relative_dst < comm_size) {
              mpi_errno = MPIC_Sendrecv(((char *)tmp_buf + send_offset),
                            curr_size, MPI_BYTE, dst, MPIR_BCAST_TAG, 
                            ((char *)tmp_buf + recv_offset),
                            scatter_size*mask, MPI_BYTE, dst,
                            MPIR_BCAST_TAG, comm, &status);
              if (mpi_errno != MPI_SUCCESS) return mpi_errno;
              NMPI_Get_count(&status, MPI_BYTE, &recv_size);
              curr_size += recv_size;
          }

          /* if some processes in this process's subtree in this step
             did not have any destination process to communicate with
             because of non-power-of-two, we need to send them the
             data that they would normally have received from those
             processes. That is, the haves in this subtree must send to
             the havenots. We use a logarithmic recursive-halfing algorithm
             for this. */

          if (dst_tree_root + mask > comm_size) {
              nprocs_completed = comm_size - my_tree_root - mask;
              /* nprocs_completed is the number of processes in this
                 subtree that have all the data. Send data to others
                 in a tree fashion. First find root of current tree
                 that is being divided into two. k is the number of
                 least-significant bits in this process's rank that
                 must be zeroed out to find the rank of the root */ 
              j = mask;
              k = 0;
              while (j) {
                  j >>= 1;
                  k++;
              }
              k--;

              offset = scatter_size * (my_tree_root + mask);
              tmp_mask = mask >> 1;

              while (tmp_mask) {
                  relative_dst = relative_rank ^ tmp_mask;
                  dst = (relative_dst + root) % comm_size; 
                  
                  tree_root = relative_rank >> k;
                  tree_root <<= k;

                  /* send only if this proc has data and destination
                     doesn't have data. */

                  /* if (rank == 3) { 
                      printf("rank %d, dst %d, root %d, nprocs_completed %d\n", relative_rank, relative_dst, tree_root, nprocs_completed);
                      fflush(stdout);
                      }*/

                  if ((relative_dst > relative_rank) && 
                      (relative_rank < tree_root + nprocs_completed)
                      && (relative_dst >= tree_root + nprocs_completed)) {

                      /* printf("Rank %d, send to %d, offset %d, size %d\n", rank, dst, offset, recv_size);
                         fflush(stdout); */
                      mpi_errno = MPIC_Send(((char *)tmp_buf + offset),
                                            recv_size, MPI_BYTE, dst,
                                            MPIR_BCAST_TAG, comm); 
                      /* recv_size was set in the previous
                         receive. that's the amount of data to be
                         sent now. */
                      if (mpi_errno != MPI_SUCCESS) return mpi_errno;
                  }
                  /* recv only if this proc. doesn't have data and sender
                     has data */
                  else if ((relative_dst < relative_rank) && 
                           (relative_dst < tree_root + nprocs_completed) &&
                           (relative_rank >= tree_root + nprocs_completed)) {
                      /* printf("Rank %d waiting to recv from rank %d\n",
                         relative_rank, dst); */
                      mpi_errno = MPIC_Recv(((char *)tmp_buf + offset),
                                            scatter_size*nprocs_completed, 
                                            MPI_BYTE, dst, MPIR_BCAST_TAG,
                                            comm, &status); 
                      /* nprocs_completed is also equal to the no. of processes
                         whose data we don't have */
                      if (mpi_errno != MPI_SUCCESS) return mpi_errno;
                      NMPI_Get_count(&status, MPI_BYTE, &recv_size);
                      curr_size += recv_size;
                      /* printf("Rank %d, recv from %d, offset %d, size %d\n", rank, dst, offset, recv_size);
                         fflush(stdout);*/
                  }
                  tmp_mask >>= 1;
                  k--;
              }
          }

          mask <<= 1;
          i++;
      }
 
      if (!is_contig || !is_homogeneous) {
          if (rank != root) {
              position = 0;
              NMPI_Unpack(tmp_buf, nbytes, &position, buffer, count,
                          datatype, comm);
          }
          MPIU_Free(tmp_buf);
      }
  }

  /* Unlock for collective operation */
  MPID_Comm_thread_unlock( comm_ptr );

  return mpi_errno;
}
/* end:nested */

/* begin:nested */
PMPI_LOCAL int MPIR_Bcast_inter ( 
    void *buffer, 
    int count, 
    MPI_Datatype datatype, 
    int root, 
    MPID_Comm *comm_ptr )
{
/*  Intercommunicator broadcast.
    Root sends to rank 0 in remote group. Remote group does local
    intracommunicator broadcast.
*/
    int rank, mpi_errno;
    MPI_Status status;
    MPID_Comm *newcomm_ptr = NULL;
    MPI_Comm comm;

    comm = comm_ptr->handle;

    if (root == MPI_PROC_NULL) {
        /* local processes other than root do nothing */
        mpi_errno = MPI_SUCCESS;
    }
    else if (root == MPI_ROOT) {
        /* root sends to rank 0 on remote group and returns */
        MPID_Comm_thread_lock( comm_ptr );
        mpi_errno =  MPIC_Send(buffer, count, datatype, 0,
                               MPIR_BCAST_TAG, comm); 
        MPID_Comm_thread_unlock( comm_ptr );
        return mpi_errno;
    }
    else {
        /* remote group. rank 0 on remote group receives from root */
        
        rank = comm_ptr->rank;
        
        if (rank == 0) {
            mpi_errno = MPIC_Recv(buffer, count, datatype, root,
                                  MPIR_BCAST_TAG, comm, &status);
            if (mpi_errno) return mpi_errno;
        }
        
        /* Get the local intracommunicator */
        if (!comm_ptr->local_comm)
            MPIR_Setup_intercomm_localcomm( comm_ptr );

        newcomm_ptr = comm_ptr->local_comm;

        /* now do the usual broadcast on this intracommunicator
           with rank 0 as root. */
        mpi_errno = MPIR_Bcast(buffer, count, datatype, 0, newcomm_ptr);
    }
    
    return mpi_errno;
}
/* end:nested */
#endif

#undef FUNCNAME
#define FUNCNAME MPI_Bcast

/*@
   MPI_Bcast - broadcast

   Input Arguments:
+  void *buffer
.  int count
.  MPI_Datatype datatype
.  int root
-  MPI_Comm comm

   Notes:

.N Fortran

.N Errors
.N MPI_SUCCESS
@*/
int MPI_Bcast( void *buffer, int count, MPI_Datatype datatype, int root, MPI_Comm comm )
{
    static const char FCNAME[] = "MPI_Bcast";
    int mpi_errno = MPI_SUCCESS;
    MPID_Comm *comm_ptr = NULL;
    MPID_MPI_STATE_DECL(MPID_STATE_MPI_BCAST);

    MPID_MPI_COLL_FUNC_ENTER(MPID_STATE_MPI_BCAST);

    /* Verify that MPI has been initialized */
#   ifdef HAVE_ERROR_CHECKING
    {
        MPID_BEGIN_ERROR_CHECKS;
        {
	    MPIR_ERRTEST_INITIALIZED(mpi_errno);
	    MPIR_ERRTEST_COMM(comm, mpi_errno);
            if (mpi_errno != MPI_SUCCESS) {
                return MPIR_Err_return_comm( 0, FCNAME, mpi_errno );
            }
	}
        MPID_END_ERROR_CHECKS;
    }
#   endif /* HAVE_ERROR_CHECKING */

    /* Get handles to MPI objects. */
    MPID_Comm_get_ptr( comm, comm_ptr );

#   ifdef HAVE_ERROR_CHECKING
    {
        MPID_BEGIN_ERROR_CHECKS;
        {
            MPID_Datatype *datatype_ptr = NULL;
	    
            MPID_Comm_valid_ptr( comm_ptr, mpi_errno );
            if (mpi_errno != MPI_SUCCESS) {
                MPID_MPI_COLL_FUNC_EXIT(MPID_STATE_MPI_BCAST);
                return MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
            }
	    MPIR_ERRTEST_COUNT(count, mpi_errno);
	    MPIR_ERRTEST_DATATYPE(count, datatype, mpi_errno);
	    /* FIXME - For intercomms, the root may be MPI_PROCNULL or 
	       MPI_ROOT */
	    MPIR_ERRTEST_INTRA_ROOT(comm_ptr, root, mpi_errno);
	    
            if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN) {
                MPID_Datatype_get_ptr(datatype, datatype_ptr);
                MPID_Datatype_valid_ptr( datatype_ptr, mpi_errno );
            }
            
            if (mpi_errno != MPI_SUCCESS) {
                MPID_MPI_COLL_FUNC_EXIT(MPID_STATE_MPI_BCAST);
                return MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
            }
        }
        MPID_END_ERROR_CHECKS;
    }
#   endif /* HAVE_ERROR_CHECKING */

    /* ... body of routine ...  */

    if (comm_ptr->coll_fns != NULL && comm_ptr->coll_fns->Bcast != NULL)
    {
	mpi_errno = comm_ptr->coll_fns->Bcast(buffer, count,
                                              datatype, root, comm_ptr);
    }
    else
    {
	MPIR_Nest_incr();
        if (comm_ptr->comm_kind == MPID_INTRACOMM) 
            /* intracommunicator */
            mpi_errno = MPIR_Bcast( buffer, count, datatype, root, comm_ptr );
        else {
            /* intercommunicator */
	    mpi_errno = MPIR_Err_create_code( MPI_ERR_COMM, 
					      "**intercommcoll",
					      "**intercommcoll %s", FCNAME );
            /*mpi_errno = MPIR_Bcast_inter( buffer, count, datatype,
	      root, comm_ptr );*/
        }
	MPIR_Nest_decr();
    }
    if (mpi_errno == MPI_SUCCESS)
    {
	MPID_MPI_COLL_FUNC_EXIT(MPID_STATE_MPI_BCAST);
	return MPI_SUCCESS;
    }
    else
    {
	MPID_MPI_COLL_FUNC_EXIT(MPID_STATE_MPI_BCAST);
	return MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
    }
    /* ... end of body of routine ... */
}