自学教程：C++ HANDLE_GET_KIND函数代码示例

/* Find the requested attribute.  If it exists, return either the attribute   entry or the address of the entry, based on whether the request is for    a pointer-valued attribute (C or C++) or an integer-valued attribute   (Fortran, either 77 or 90).   If the attribute has the same type as the request, it is returned as-is.   Otherwise, the address of the attribute is returned.*/int MPIR_CommGetAttr( MPI_Comm comm, int comm_keyval, void *attribute_val, 		      int *flag, MPIR_AttrType outAttrType ){    static const char FCNAME[] = "MPIR_CommGetAttr";    int mpi_errno = MPI_SUCCESS;    MPID_Comm *comm_ptr = NULL;    static PreDefined_attrs attr_copy;    /* Used to provide a copy of the					     predefined attributes */    MPID_MPI_STATE_DECL(MPID_STATE_MPIR_COMM_GET_ATTR);    MPIR_ERRTEST_INITIALIZED_ORDIE();        MPID_MPI_FUNC_ENTER(MPID_STATE_MPIR_COMM_GET_ATTR);        /* Validate parameters, especially handles needing to be converted */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS;        {	    MPIR_ERRTEST_COMM(comm, mpi_errno);	    MPIR_ERRTEST_KEYVAL(comm_keyval, MPID_COMM, "communicator", mpi_errno);#           ifdef NEEDS_POINTER_ALIGNMENT_ADJUST            /* A common user error is to pass the address of a 4-byte	       int when the address of a pointer (or an address-sized int)	       should have been used.  We can test for this specific	       case.  Note that this code assumes sizeof(MPIR_Pint) is 	       a power of 2. */	    if ((MPIR_Pint)attribute_val & (sizeof(MPIR_Pint)-1)) {		MPIU_ERR_SET(mpi_errno,MPI_ERR_ARG,"**attrnotptr");	    }#           endif            if (mpi_errno != MPI_SUCCESS) goto fn_fail;        }        MPID_END_ERROR_CHECKS;    }#   endif    /* Convert MPI object handles to object pointers */    MPID_Comm_get_ptr( comm, comm_ptr );    /* Validate parameters and objects (post conversion) */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS;        {            /* Validate comm_ptr */            MPID_Comm_valid_ptr( comm_ptr, mpi_errno );	    /* If comm_ptr is not valid, it will be reset to null */	    MPIR_ERRTEST_ARGNULL(attribute_val, "attr_val", mpi_errno);	    MPIR_ERRTEST_ARGNULL(flag, "flag", mpi_errno);            if (mpi_errno) goto fn_fail;        }        MPID_END_ERROR_CHECKS;    }#   endif /* HAVE_ERROR_CHECKING */    /* ... body of routine ...  */        /* Check for builtin attribute */    /* This code is ok for correct programs, but it would be better       to copy the values from the per-process block and pass the user       a pointer to a copy */    /* Note that if we are called from Fortran, we must return the values,       not the addresses, of these attributes */    if (HANDLE_GET_KIND(comm_keyval) == HANDLE_KIND_BUILTIN) {	int attr_idx = comm_keyval & 0x0000000f;	void **attr_val_p = (void **)attribute_val;#ifdef HAVE_FORTRAN_BINDING	/* This is an address-sized int instead of a Fortran (MPI_Fint)	   integer because, even for the Fortran keyvals, the C interface is 	   used which stores the result in a pointer (hence we need a	   pointer-sized int).  Thus we use MPIR_Pint instead of MPI_Fint.	   On some 64-bit plaforms, such as Solaris-SPARC, using an MPI_Fint	   will cause the value to placed into the high, rather than low,	   end of the output value. */#endif	*flag = 1;	/* FIXME : We could initialize some of these here; only tag_ub is 	 used in the error checking. */	/* 	 * The C versions of the attributes return the address of a 	 * *COPY* of the value (to prevent the user from changing it)	 * and the Fortran versions provide the actual value (as an Fint)	 */	attr_copy = MPIR_Process.attrs;	switch (attr_idx) {	case 1: /* TAG_UB */	case 2:	    *attr_val_p = &attr_copy.tag_ub;	    break;	case 3: /* HOST *///.........这里部分代码省略.........

/*@MPI_Comm_free - Marks the communicator object for deallocationInput Parameters:. comm - Communicator to be destroyed (handle) Notes:This routine `frees` a communicator.  Because the communicator may stillbe in use by other MPI routines, the actual communicator storage will notbe freed until all references to this communicator are removed.  For mostusers, the effect of this routine is the same as if it was in fact freedat this time of this call.  Null Handles:The MPI 1.1 specification, in the section on opaque objects, explicitlydisallows freeing a null communicator.  The text from the standard is:.vb A null handle argument is an erroneous IN argument in MPI calls, unless an exception is explicitly stated in the text that defines the function. Such exception is allowed for handles to request objects in Wait and Test calls (sections Communication Completion and Multiple Completions ). Otherwise, a null handle can only be passed to a function that allocates a new object and returns a reference to it in the handle..ve.N ThreadSafe.N Fortran.N Errors.N MPI_SUCCESS.N MPI_ERR_COMM.N MPI_ERR_ARG@*/int MPI_Comm_free(MPI_Comm *comm){    int mpi_errno = MPI_SUCCESS;    MPID_Comm *comm_ptr = NULL;    MPID_MPI_STATE_DECL(MPID_STATE_MPI_COMM_FREE);    MPIR_ERRTEST_INITIALIZED_ORDIE();        MPIU_THREAD_CS_ENTER(ALLFUNC,);    MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_COMM_FREE);    /* 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 */        /* Get handles to MPI objects. */    MPID_Comm_get_ptr( *comm, comm_ptr );        /* Validate parameters and objects (post conversion) */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS;        {            /* Validate comm_ptr */            MPID_Comm_valid_ptr( comm_ptr, mpi_errno, TRUE );	    /* If comm_ptr is not valid, it will be reset to null */	    	    /* Cannot free the predefined communicators */	    if (HANDLE_GET_KIND(*comm) == HANDLE_KIND_BUILTIN) {		mpi_errno = MPIR_Err_create_code( MPI_SUCCESS,                       MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_COMM,					  "**commperm", "**commperm %s", 						  comm_ptr->name );	    }            if (mpi_errno) goto fn_fail;        }        MPID_END_ERROR_CHECKS;    }#   endif /* HAVE_ERROR_CHECKING */    /* ... body of routine ...  */        mpi_errno = MPIR_Comm_free_impl(comm_ptr);    if (mpi_errno != MPI_SUCCESS) goto fn_fail;        *comm = MPI_COMM_NULL;        /* ... end of body of routine ... */  fn_exit:    MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_COMM_FREE);    MPIU_THREAD_CS_EXIT(ALLFUNC,);    return mpi_errno;  fn_fail:    /* --BEGIN ERROR HANDLING-- */#   ifdef HAVE_ERROR_CHECKING    {	mpi_errno = MPIR_Err_create_code(//.........这里部分代码省略.........

//.........这里部分代码省略.........    static const char FCNAME[] = "MPI_Bsend";    int mpi_errno = MPI_SUCCESS;    MPID_Comm *comm_ptr = NULL;    MPID_Request *request_ptr = NULL;    MPID_MPI_STATE_DECL(MPID_STATE_MPI_BSEND);    MPIR_ERRTEST_INITIALIZED_ORDIE();        MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);    MPID_MPI_PT2PT_FUNC_ENTER_FRONT(MPID_STATE_MPI_BSEND);        /* Validate handle parameters 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 */    MPID_Comm_get_ptr( comm, comm_ptr );    /* Validate object pointers if error checking is enabled */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS;        {	    MPIR_ERRTEST_COUNT(count,mpi_errno);            /* Validate comm_ptr */            MPID_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE );            if (mpi_errno) goto fn_fail;	    /* If comm_ptr is not valid, it will be reset to null */	    if (comm_ptr) {		MPIR_ERRTEST_SEND_TAG(tag,mpi_errno);		MPIR_ERRTEST_SEND_RANK(comm_ptr,dest,mpi_errno)	    }	    /* Validate datatype handle */	    MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);	    /* Validate datatype object */	    if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN)	    {		MPID_Datatype *datatype_ptr = NULL;		MPID_Datatype_get_ptr(datatype, datatype_ptr);		MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno);		if (mpi_errno) goto fn_fail;		MPID_Datatype_committed_ptr(datatype_ptr, mpi_errno);		if (mpi_errno) goto fn_fail;	    }	    	    /* Validate buffer */	    MPIR_ERRTEST_USERBUFFER(buf,count,datatype,mpi_errno);        }        MPID_END_ERROR_CHECKS;    }#   endif /* HAVE_ERROR_CHECKING */    /* ... body of routine ...  */    #   ifdef MPID_HAS_TBSEND    {	mpi_errno = MPID_tBsend( buf, count, datatype, dest, tag, comm_ptr, 0 );	if (mpi_errno == MPI_SUCCESS)	{	    goto fn_exit;	}	/* FIXME: Check for MPID_WOULD_BLOCK? */    }#   endif        mpi_errno = MPIR_Bsend_isend( buf, count, datatype, dest, tag, comm_ptr, 				  BSEND, &request_ptr );    /* Note that we can ignore the request_ptr because it is handled internally       by the bsend util routines */    if (mpi_errno != MPI_SUCCESS) goto fn_fail;    /* ... end of body of routine ... */      fn_exit:    MPID_MPI_PT2PT_FUNC_EXIT(MPID_STATE_MPI_BSEND);    MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);    return mpi_errno;	  fn_fail:    /* --BEGIN ERROR HANDLING-- */#   ifdef HAVE_ERROR_CHECKING    {	mpi_errno = MPIR_Err_create_code(	    mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_bsend",	    "**mpi_bsend %p %d %D %i %t %C", buf, count, datatype, dest, tag, comm);    }#   endif    mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );    goto fn_exit;    /* --END ERROR HANDLING-- */}

/*@MPI_Neighbor_allgather - In this function, each process i gathers data itemsfrom each process j if an edge (j,i) exists in the topology graph, and eachprocess i sends the same data items to all processes j where an edge (i,j)exists. The send buffer is sent to each neighboring process and the l-th blockin the receive buffer is received from the l-th neighbor.Input Parameters:+ sendbuf - starting address of the send buffer (choice). sendcount - number of elements sent to each neighbor (non-negative integer). sendtype - data type of send buffer elements (handle). recvcount - number of elements received from each neighbor (non-negative integer). recvtype - data type of receive buffer elements (handle)- comm - communicator (handle)Output Parameters:. recvbuf - starting address of the receive buffer (choice).N ThreadSafe.N Fortran.N Errors@*/int MPI_Neighbor_allgather(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm){    int mpi_errno = MPI_SUCCESS;    MPID_Comm *comm_ptr = NULL;    MPID_MPI_STATE_DECL(MPID_STATE_MPI_NEIGHBOR_ALLGATHER);    MPIU_THREAD_CS_ENTER(ALLFUNC,);    MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_NEIGHBOR_ALLGATHER);    /* Validate parameters, especially handles needing to be converted */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS        {            MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno);            MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno);            MPIR_ERRTEST_COMM(comm, mpi_errno);            /* TODO more checks may be appropriate */        }        MPID_END_ERROR_CHECKS    }#   endif /* HAVE_ERROR_CHECKING */    /* Convert MPI object handles to object pointers */    MPID_Comm_get_ptr(comm, comm_ptr);    /* Validate parameters and objects (post conversion) */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS        {            if (HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) {                MPID_Datatype *sendtype_ptr = NULL;                MPID_Datatype_get_ptr(sendtype, sendtype_ptr);                MPID_Datatype_valid_ptr(sendtype_ptr, mpi_errno);                MPID_Datatype_committed_ptr(sendtype_ptr, mpi_errno);            }            if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) {                MPID_Datatype *recvtype_ptr = NULL;                MPID_Datatype_get_ptr(recvtype, recvtype_ptr);                MPID_Datatype_valid_ptr(recvtype_ptr, mpi_errno);                MPID_Datatype_committed_ptr(recvtype_ptr, mpi_errno);            }            MPID_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE );            /* TODO more checks may be appropriate (counts, in_place, buffer aliasing, etc) */            if (mpi_errno != MPI_SUCCESS) goto fn_fail;        }        MPID_END_ERROR_CHECKS    }#   endif /* HAVE_ERROR_CHECKING */    /* ... body of routine ...  */    mpi_errno = MPIR_Neighbor_allgather_impl(sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, comm_ptr);    if (mpi_errno) MPIU_ERR_POP(mpi_errno);    /* ... end of body of routine ... */fn_exit:    MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_NEIGHBOR_ALLGATHER);    MPIU_THREAD_CS_EXIT(ALLFUNC,);    return mpi_errno;fn_fail:    /* --BEGIN ERROR HANDLING-- */#   ifdef HAVE_ERROR_CHECKING    {        mpi_errno = MPIR_Err_create_code(            mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER,            "**mpi_neighbor_allgather", "**mpi_neighbor_allgather %p %d %D %p %d %D %C", sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, comm);    }#   endif    mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno);//.........这里部分代码省略.........

/*@   MPI_Accumulate - Accumulate data into the target process using remote    memory access Input Parameters:+ origin_addr - initial address of buffer (choice) . origin_count - number of entries in buffer (nonnegative integer) . origin_datatype - datatype of each buffer entry (handle) . target_rank - rank of target (nonnegative integer) . target_disp - displacement from start of window to beginning of target   buffer (nonnegative integer)  . target_count - number of entries in target buffer (nonnegative integer) . target_datatype - datatype of each entry in target buffer (handle) . op - predefined reduce operation (handle) - win - window object (handle)    Notes:The basic components of both the origin and target datatype must be the same predefined datatype (e.g., all 'MPI_INT' or all 'MPI_DOUBLE_PRECISION')..N Fortran.N Errors.N MPI_SUCCESS.N MPI_ERR_ARG.N MPI_ERR_COUNT.N MPI_ERR_RANK.N MPI_ERR_TYPE.N MPI_ERR_WIN.seealso: MPI_Raccumulate@*/int MPI_Accumulate(const void *origin_addr, int origin_count, MPI_Datatype                   origin_datatype, int target_rank, MPI_Aint                   target_disp, int target_count, MPI_Datatype                   target_datatype, MPI_Op op, MPI_Win win) {    static const char FCNAME[] = "MPI_Accumulate";    int mpi_errno = MPI_SUCCESS;    MPIR_Win *win_ptr = NULL;    MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_ACCUMULATE);    MPIR_ERRTEST_INITIALIZED_ORDIE();        MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);    MPIR_FUNC_TERSE_RMA_ENTER(MPID_STATE_MPI_ACCUMULATE);    /* Validate parameters, especially handles needing to be converted */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS;        {	    MPIR_ERRTEST_WIN(win, mpi_errno);        }        MPID_END_ERROR_CHECKS;    }#   endif /* HAVE_ERROR_CHECKING */        /* Convert MPI object handles to object pointers */    MPIR_Win_get_ptr( win, win_ptr );    /* Validate parameters and objects (post conversion) */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS;        {	    MPIR_Comm * comm_ptr;	                /* Validate win_ptr */            MPIR_Win_valid_ptr( win_ptr, mpi_errno );            if (mpi_errno) goto fn_fail;	    MPIR_ERRTEST_COUNT(origin_count, mpi_errno);	    MPIR_ERRTEST_DATATYPE(origin_datatype, "origin_datatype", mpi_errno);	    MPIR_ERRTEST_USERBUFFER(origin_addr, origin_count, origin_datatype, mpi_errno);	    MPIR_ERRTEST_COUNT(target_count, mpi_errno);	    MPIR_ERRTEST_DATATYPE(target_datatype, "target_datatype", mpi_errno);            if (win_ptr->create_flavor != MPI_WIN_FLAVOR_DYNAMIC)                MPIR_ERRTEST_DISP(target_disp, mpi_errno);            if (HANDLE_GET_KIND(origin_datatype) != HANDLE_KIND_BUILTIN)            {                MPIR_Datatype *datatype_ptr = NULL;                                MPID_Datatype_get_ptr(origin_datatype, datatype_ptr);                MPIR_Datatype_valid_ptr(datatype_ptr, mpi_errno);                if (mpi_errno != MPI_SUCCESS) goto fn_fail;                MPID_Datatype_committed_ptr(datatype_ptr, mpi_errno);                if (mpi_errno != MPI_SUCCESS) goto fn_fail;            }            if (HANDLE_GET_KIND(target_datatype) != HANDLE_KIND_BUILTIN)            {                MPIR_Datatype *datatype_ptr = NULL;                                MPID_Datatype_get_ptr(target_datatype, datatype_ptr);                MPIR_Datatype_valid_ptr(datatype_ptr, mpi_errno);                if (mpi_errno != MPI_SUCCESS) goto fn_fail;                MPID_Datatype_committed_ptr(datatype_ptr, mpi_errno);                if (mpi_errno != MPI_SUCCESS) goto fn_fail;//.........这里部分代码省略.........

/*@MPI_Type_size_x - Return the number of bytes occupied by entries                  in the datatypeInput Parameters:. datatype - datatype (handle)Output Parameters:. size - datatype size (integer).N ThreadSafe.N Fortran.N Errors@*/int MPI_Type_size_x(MPI_Datatype datatype, MPI_Count *size){    int mpi_errno = MPI_SUCCESS;    MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_TYPE_SIZE_X);    MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);    MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_TYPE_SIZE_X);    /* Validate parameters, especially handles needing to be converted */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS        {            MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);            /* TODO more checks may be appropriate */            if (mpi_errno != MPI_SUCCESS) goto fn_fail;        }        MPID_END_ERROR_CHECKS    }#   endif /* HAVE_ERROR_CHECKING */    /* Convert MPI object handles to object pointers */    /* Validate parameters and objects (post conversion) */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS        {            if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN) {                MPIR_Datatype *datatype_ptr = NULL;                MPID_Datatype_get_ptr(datatype, datatype_ptr);                MPIR_Datatype_valid_ptr(datatype_ptr, mpi_errno);            }            /* TODO more checks may be appropriate (counts, in_place, buffer aliasing, etc) */            if (mpi_errno != MPI_SUCCESS) goto fn_fail;        }        MPID_END_ERROR_CHECKS    }#   endif /* HAVE_ERROR_CHECKING */    /* ... body of routine ...  */    mpi_errno = MPIR_Type_size_x_impl(datatype, size);    if (mpi_errno) MPIR_ERR_POP(mpi_errno);    /* ... end of body of routine ... */fn_exit:    MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_TYPE_SIZE_X);    MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);    return mpi_errno;fn_fail:    /* --BEGIN ERROR HANDLING-- */#   ifdef HAVE_ERROR_CHECKING    {        mpi_errno = MPIR_Err_create_code(            mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER,            "**mpi_type_size_x", "**mpi_type_size_x %D %p", datatype, size);    }#   endif    mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno);    goto fn_exit;    /* --END ERROR HANDLING-- */}

/*@    MPI_Sendrecv - Sends and receives a messageInput Parameters:+ sendbuf - initial address of send buffer (choice). sendcount - number of elements in send buffer (integer). sendtype - type of elements in send buffer (handle). dest - rank of destination (integer). sendtag - send tag (integer). recvcount - number of elements in receive buffer (integer). recvtype - type of elements in receive buffer (handle). source - rank of source (integer). recvtag - receive tag (integer)- comm - communicator (handle)Output Parameters:+ recvbuf - initial address of receive buffer (choice)- status - status object (Status).  This refers to the receive operation..N ThreadSafe.N Fortran.N FortranStatus.N Errors.N MPI_SUCCESS.N MPI_ERR_COMM.N MPI_ERR_COUNT.N MPI_ERR_TYPE.N MPI_ERR_TAG.N MPI_ERR_RANK@*/int MPI_Sendrecv(const void *sendbuf, int sendcount, MPI_Datatype sendtype,                 int dest, int sendtag,                 void *recvbuf, int recvcount, MPI_Datatype recvtype,                 int source, int recvtag, MPI_Comm comm, MPI_Status * status){    int mpi_errno = MPI_SUCCESS;    MPIR_Comm *comm_ptr = NULL;    MPIR_Request *sreq = NULL;    MPIR_Request *rreq = NULL;    MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_SENDRECV);    MPIR_ERRTEST_INITIALIZED_ORDIE();    MPID_THREAD_CS_ENTER(VCI_GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);    MPIR_FUNC_TERSE_PT2PT_ENTER_BOTH(MPID_STATE_MPI_SENDRECV);    /* Validate handle parameters 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 handles to MPI objects. */    MPIR_Comm_get_ptr(comm, comm_ptr);#ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS;        {            /* Validate communicator */            MPIR_Comm_valid_ptr(comm_ptr, mpi_errno, FALSE);            if (mpi_errno)                goto fn_fail;            /* Validate count */            MPIR_ERRTEST_COUNT(sendcount, mpi_errno);            MPIR_ERRTEST_COUNT(recvcount, mpi_errno);            /* Validate status (status_ignore is not the same as null) */            MPIR_ERRTEST_ARGNULL(status, "status", mpi_errno);            /* Validate tags */            MPIR_ERRTEST_SEND_TAG(sendtag, mpi_errno);            MPIR_ERRTEST_RECV_TAG(recvtag, mpi_errno);            /* Validate source and destination */            if (comm_ptr) {                MPIR_ERRTEST_SEND_RANK(comm_ptr, dest, mpi_errno);                MPIR_ERRTEST_RECV_RANK(comm_ptr, source, mpi_errno);            }            /* Validate datatype handles */            MPIR_ERRTEST_DATATYPE(sendtype, "datatype", mpi_errno);            MPIR_ERRTEST_DATATYPE(recvtype, "datatype", mpi_errno);            /* Validate datatype objects */            if (HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) {                MPIR_Datatype *datatype_ptr = NULL;                MPIR_Datatype_get_ptr(sendtype, datatype_ptr);                MPIR_Datatype_valid_ptr(datatype_ptr, mpi_errno);//.........这里部分代码省略.........

/*@MPI_Group_free - Frees a groupInput Parameters:. group - group to free (handle) Notes:On output, group is set to 'MPI_GROUP_NULL'..N ThreadSafe.N Fortran.N Errors.N MPI_SUCCESS.N MPI_ERR_ARG.N MPI_ERR_PERM_GROUP@*/int MPI_Group_free(MPI_Group *group){    int mpi_errno = MPI_SUCCESS;    MPID_Group *group_ptr = NULL;    MPID_MPI_STATE_DECL(MPID_STATE_MPI_GROUP_FREE);    MPIR_ERRTEST_INITIALIZED_ORDIE();        MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);    MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_GROUP_FREE);    /* Validate parameters, especially handles needing to be converted */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS;        {	    MPIR_ERRTEST_GROUP(*group, mpi_errno);        }        MPID_END_ERROR_CHECKS;    }#   endif        /* Convert MPI object handles to object pointers */    MPID_Group_get_ptr( *group, group_ptr );    /* Validate parameters and objects (post conversion) */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS;        {            /* Validate group_ptr */            MPID_Group_valid_ptr( group_ptr, mpi_errno );	    /* If group_ptr is not valid, it will be reset to null */	    /* Cannot free the predefined groups, but allow GROUP_EMPTY 	       because otherwise many tests fail */	    if ((HANDLE_GET_KIND(*group) == HANDLE_KIND_BUILTIN) &&                *group != MPI_GROUP_EMPTY) {		mpi_errno = MPIR_Err_create_code( MPI_SUCCESS,                       MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_GROUP,					  "**groupperm", 0);	    }            if (mpi_errno) goto fn_fail;        }        MPID_END_ERROR_CHECKS;    }#   endif /* HAVE_ERROR_CHECKING */    /* ... body of routine ...  */    mpi_errno = MPIR_Group_free_impl(group_ptr);    *group = MPI_GROUP_NULL;    if (mpi_errno != MPI_SUCCESS) goto fn_fail;    /* ... end of body of routine ... */  fn_exit:    MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_GROUP_FREE);    MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);    return mpi_errno;  fn_fail:    /* --BEGIN ERROR HANDLING-- */#   ifdef HAVE_ERROR_CHECKING    {	mpi_errno = MPIR_Err_create_code(	    mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_group_free", "**mpi_group_free %p", group);    }#   endif    mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );    goto fn_exit;    /* --END ERROR HANDLING-- */}

static int MPIR_Bcast_binomial_MV2(    void *buffer,    int count,    MPI_Datatype datatype,    int root,    MPID_Comm *comm_ptr,    int *errflag){    int        rank, comm_size, src, dst;    int        relative_rank, mask;    int mpi_errno = MPI_SUCCESS;    int mpi_errno_ret = MPI_SUCCESS;    int nbytes=0;    int type_size, is_contig, is_homogeneous;    int position;    void *tmp_buf=NULL;    MPI_Comm comm;    MPID_Datatype *dtp;    MPIU_CHKLMEM_DECL(1);    comm = comm_ptr->handle;    comm_size = comm_ptr->local_size;    rank = comm_ptr->rank;    /* If there is only one process, return */    if (comm_size == 1) goto fn_exit;    if (HANDLE_GET_KIND(datatype) == HANDLE_KIND_BUILTIN)        is_contig = 1;    else {        MPID_Datatype_get_ptr(datatype, dtp);        is_contig = dtp->is_contig;    }    is_homogeneous = 1;#ifdef MPID_HAS_HETERO    if (comm_ptr->is_hetero)        is_homogeneous = 0;#endif    /* MPI_Type_size() might not give the accurate size of the packed     * datatype for heterogeneous systems (because of padding, encoding,     * etc). On the other hand, MPI_Pack_size() can become very     * expensive, depending on the implementation, especially for     * heterogeneous systems. We want to use MPI_Type_size() wherever     * possible, and MPI_Pack_size() in other places.     */    if (is_homogeneous)        MPID_Datatype_get_size_macro(datatype, type_size);    else        MPIR_Pack_size_impl(1, datatype, &type_size);    nbytes = type_size * count;    if (!is_contig || !is_homogeneous)    {        MPIU_CHKLMEM_MALLOC(tmp_buf, void *, nbytes, mpi_errno, "tmp_buf");        /* TODO: Pipeline the packing and communication */        position = 0;        if (rank == root) {            mpi_errno = MPIR_Pack_impl(buffer, count, datatype, tmp_buf, nbytes,                                       &position);            if (mpi_errno) MPIU_ERR_POP(mpi_errno);        }    }

/*@MPI_Allreduce - Combines values from all processes and distributes the result                back to all processesInput Parameters:+ sendbuf - starting address of send buffer (choice) . count - number of elements in send buffer (integer) . datatype - data type of elements of send buffer (handle) . op - operation (handle) - comm - communicator (handle) Output Parameter:. recvbuf - starting address of receive buffer (choice) .N ThreadSafe.N Fortran.N collops.N Errors.N MPI_ERR_BUFFER.N MPI_ERR_COUNT.N MPI_ERR_TYPE.N MPI_ERR_OP.N MPI_ERR_COMM@*/int MPI_Allreduce ( void *sendbuf, void *recvbuf, int count, 		    MPI_Datatype datatype, MPI_Op op, MPI_Comm comm ){    static const char FCNAME[] = "MPI_Allreduce";    int mpi_errno = MPI_SUCCESS;    MPID_Comm *comm_ptr = NULL;    int errflag = FALSE;    MPID_MPI_STATE_DECL(MPID_STATE_MPI_ALLREDUCE);    MPIR_ERRTEST_INITIALIZED_ORDIE();        MPIU_THREAD_CS_ENTER(ALLFUNC,);    MPID_MPI_COLL_FUNC_ENTER(MPID_STATE_MPI_ALLREDUCE);    /* Validate parameters, especially handles needing to be converted */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS;        {	    MPIR_ERRTEST_COMM(comm, mpi_errno);            if (mpi_errno != MPI_SUCCESS) goto fn_fail;	}        MPID_END_ERROR_CHECKS;    }#   endif /* HAVE_ERROR_CHECKING */    /* Convert MPI object handles to object pointers */    MPID_Comm_get_ptr( comm, comm_ptr );    /* Validate parameters and objects (post conversion) */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS;        {            MPID_Datatype *datatype_ptr = NULL;            MPID_Op *op_ptr = NULL;            MPID_Comm_valid_ptr( comm_ptr, mpi_errno );            if (mpi_errno != MPI_SUCCESS) goto fn_fail;	    MPIR_ERRTEST_COUNT(count, mpi_errno);	    MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);	    MPIR_ERRTEST_OP(op, 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 );                MPID_Datatype_committed_ptr( datatype_ptr, mpi_errno );            }	    if (comm_ptr->comm_kind == MPID_INTERCOMM)                MPIR_ERRTEST_SENDBUF_INPLACE(sendbuf, count, mpi_errno);                        if (sendbuf != MPI_IN_PLACE)                 MPIR_ERRTEST_USERBUFFER(sendbuf,count,datatype,mpi_errno);            MPIR_ERRTEST_RECVBUF_INPLACE(recvbuf, count, mpi_errno);	    MPIR_ERRTEST_USERBUFFER(recvbuf,count,datatype,mpi_errno);	    if (mpi_errno != MPI_SUCCESS) goto fn_fail;            if (HANDLE_GET_KIND(op) != HANDLE_KIND_BUILTIN) {                MPID_Op_get_ptr(op, op_ptr);                MPID_Op_valid_ptr( op_ptr, mpi_errno );            }            if (HANDLE_GET_KIND(op) == HANDLE_KIND_BUILTIN) {                mpi_errno =                     ( * MPIR_Op_check_dtype_table[op%16 - 1] )(datatype);             }	    if (count != 0) {		MPIR_ERRTEST_ALIAS_COLL(sendbuf, recvbuf, mpi_errno);	    }	    if (mpi_errno != MPI_SUCCESS) goto fn_fail;	}//.........这里部分代码省略.........

/*@  MPID_Type_vector - create a vector datatypeInput Parameters:+ count - number of blocks in vector. blocklength - number of elements in each block. stride - distance from beginning of one block to the next (see next  parameter for units). strideinbytes - if nonzero, then stride is in bytes, otherwise stride  is in terms of extent of oldtype- oldtype - type (using handle) of datatype on which vector is basedOutput Parameters:. newtype - handle of new vector datatype  Return Value:  0 on success, MPI error code on failure.@*/int MPID_Type_vector(int count,		     int blocklength,		     MPI_Aint stride,		     int strideinbytes,		     MPI_Datatype oldtype,		     MPI_Datatype *newtype){    int mpi_errno = MPI_SUCCESS;    int is_builtin, old_is_contig;    MPI_Aint el_sz, old_sz;    MPI_Datatype el_type;    MPI_Aint old_lb, old_ub, old_extent, old_true_lb, old_true_ub, eff_stride;    MPID_Datatype *new_dtp;    if (count == 0) return MPID_Type_zerolen(newtype);    /* allocate new datatype object and handle */    new_dtp = (MPID_Datatype *) MPIU_Handle_obj_alloc(&MPID_Datatype_mem);    if (!new_dtp) {	/* --BEGIN ERROR HANDLING-- */	mpi_errno = MPIR_Err_create_code(MPI_SUCCESS, MPIR_ERR_RECOVERABLE,					 "MPID_Type_vector", __LINE__,					 MPI_ERR_OTHER, "**nomem", 0);	return mpi_errno;	/* --END ERROR HANDLING-- */    }    /* handle is filled in by MPIU_Handle_obj_alloc() */    MPIU_Object_set_ref(new_dtp, 1);    new_dtp->is_permanent = 0;    new_dtp->is_committed = 0;    new_dtp->attributes   = NULL;    new_dtp->cache_id     = 0;    new_dtp->name[0]      = 0;    new_dtp->contents     = NULL;    new_dtp->dataloop       = NULL;    new_dtp->dataloop_size  = -1;    new_dtp->dataloop_depth = -1;    new_dtp->hetero_dloop       = NULL;    new_dtp->hetero_dloop_size  = -1;    new_dtp->hetero_dloop_depth = -1;    is_builtin = (HANDLE_GET_KIND(oldtype) == HANDLE_KIND_BUILTIN);    if (is_builtin) {	el_sz   = (MPI_Aint) MPID_Datatype_get_basic_size(oldtype);	el_type = oldtype;	old_lb        = 0;	old_true_lb   = 0;	old_ub        = el_sz;	old_true_ub   = el_sz;	old_sz        = el_sz;	old_extent    = el_sz;	old_is_contig = 1;	new_dtp->size           = (MPI_Aint) count *	                          (MPI_Aint) blocklength * el_sz;	new_dtp->has_sticky_lb  = 0;	new_dtp->has_sticky_ub  = 0;	new_dtp->alignsize    = el_sz; /* ??? */	new_dtp->n_builtin_elements   = count * blocklength;	new_dtp->builtin_element_size = el_sz;	new_dtp->basic_type       = el_type;	new_dtp->max_contig_blocks = count;	eff_stride = (strideinbytes) ? stride : (stride * el_sz);    }    else /* user-defined base type (oldtype) */ {	MPID_Datatype *old_dtp;	MPID_Datatype_get_ptr(oldtype, old_dtp);	el_sz   = old_dtp->builtin_element_size;	el_type = old_dtp->basic_type;	old_lb        = old_dtp->lb;	old_true_lb   = old_dtp->true_lb;	old_ub        = old_dtp->ub;//.........这里部分代码省略.........

//.........这里部分代码省略.........                                         MPIR_ALLREDUCE_TAG, comm,                                         MPI_STATUS_IGNORE, 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 reduction on received data. since the                   ordering is right, it doesn't matter whether                   the operation is commutative or not. */                mpi_errno = MPIR_Reduce_local_impl(tmp_buf, recvbuf, count, datatype, op);                if (mpi_errno) MPIU_ERR_POP(mpi_errno);                /* change the rank */                newrank = rank / 2;            }        }        else  /* rank >= 2*rem */            newrank = rank - rem;                /* If op is user-defined or count is less than pof2, use           recursive doubling algorithm. Otherwise do a reduce-scatter           followed by allgather. (If op is user-defined,           derived datatypes are allowed and the user could pass basic           datatypes on one process and derived on another as long as           the type maps are the same. Breaking up derived           datatypes to do the reduce-scatter is tricky, therefore           using recursive doubling in that case.) */        if (newrank != -1) {            if ((count*type_size <= MPIR_PARAM_ALLREDUCE_SHORT_MSG_SIZE) ||                (HANDLE_GET_KIND(op) != HANDLE_KIND_BUILTIN) ||                  (count < pof2)) { /* use recursive doubling */                mask = 0x1;                while (mask < pof2) {                    newdst = newrank ^ mask;                    /* find real rank of dest */                    dst = (newdst < rem) ? newdst*2 + 1 : newdst + rem;                    /* Send the most current data, which is in recvbuf. Recv                       into tmp_buf */                     mpi_errno = MPIC_Sendrecv_ft(recvbuf, count, datatype,                                                  dst, MPIR_ALLREDUCE_TAG, tmp_buf,                                                 count, datatype, dst,                                                 MPIR_ALLREDUCE_TAG, comm,                                                 MPI_STATUS_IGNORE, 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);                    }                                        /* tmp_buf contains data received in this step.                       recvbuf contains data accumulated so far */                                        if (is_commutative  || (dst < rank)) {                        /* op is commutative OR the order is already right */                        mpi_errno = MPIR_Reduce_local_impl(tmp_buf, recvbuf, count, datatype, op);                        if (mpi_errno) MPIU_ERR_POP(mpi_errno);                    }                    else {                        /* op is noncommutative and the order is not right */                        mpi_errno = MPIR_Reduce_local_impl(recvbuf, tmp_buf, count, datatype, op);

int MPIR_Pack_impl(const void *inbuf,                   int incount,                   MPI_Datatype datatype,                   void *outbuf,                   MPI_Aint outsize,                   MPI_Aint *position){    int mpi_errno = MPI_SUCCESS;    MPI_Aint first, last;    MPID_Segment *segp;    int contig;    MPI_Aint dt_true_lb;    MPI_Aint data_sz;    if (incount == 0) {	goto fn_exit;    }    /* Handle contig case quickly */    if (HANDLE_GET_KIND(datatype) == HANDLE_KIND_BUILTIN) {        contig     = TRUE;        dt_true_lb = 0;        data_sz    = incount * MPID_Datatype_get_basic_size(datatype);    } else {        MPID_Datatype *dt_ptr;        MPID_Datatype_get_ptr(datatype, dt_ptr);	contig     = dt_ptr->is_contig;        dt_true_lb = dt_ptr->true_lb;        data_sz    = incount * dt_ptr->size;    }    if (contig) {        MPIU_Memcpy((char *) outbuf + *position, (char *)inbuf + dt_true_lb, data_sz);        *position = (int)((MPI_Aint)*position + data_sz);        goto fn_exit;    }        /* non-contig case */        /* TODO: CHECK RETURN VALUES?? */    /* TODO: SHOULD THIS ALL BE IN A MPID_PACK??? */    segp = MPID_Segment_alloc();    MPIU_ERR_CHKANDJUMP1(segp == NULL, mpi_errno, MPI_ERR_OTHER, "**nomem", "**nomem %s", "MPID_Segment");        mpi_errno = MPID_Segment_init(inbuf, incount, datatype, segp, 0);    if (mpi_errno) MPIU_ERR_POP(mpi_errno);    /* NOTE: the use of buffer values and positions in MPI_Pack and in     * MPID_Segment_pack are quite different.  See code or docs or something.     */    first = 0;    last  = SEGMENT_IGNORE_LAST;    /* Ensure that pointer increment fits in a pointer */    MPID_Ensure_Aint_fits_in_pointer((MPI_VOID_PTR_CAST_TO_MPI_AINT outbuf) +				     (MPI_Aint) *position);    MPID_Segment_pack(segp,		      first,		      &last,		      (void *) ((char *) outbuf + *position));    /* Ensure that calculation fits into an int datatype. */    MPID_Ensure_Aint_fits_in_int((MPI_Aint)*position + last);    *position = (int)((MPI_Aint)*position + last);    MPID_Segment_free(segp);         fn_exit:    return mpi_errno; fn_fail:    goto fn_exit;}

/*@    MPI_Pack - Packs a datatype into contiguous memoryInput Parameters:+  inbuf - input buffer start (choice).  incount - number of input data items (non-negative integer).  datatype - datatype of each input data item (handle).  outsize - output buffer size, in bytes (non-negative integer)-  comm - communicator for packed message (handle)Output Parameters:.  outbuf - output buffer start (choice)Input/Output Parameters:.  position - current position in buffer, in bytes (integer)  Notes (from the specifications):  The input value of position is the first location in the output buffer to be  used for packing.  position is incremented by the size of the packed message,  and the output value of position is the first location in the output buffer  following the locations occupied by the packed message.  The comm argument is  the communicator that will be subsequently used for sending the packed  message..N Fortran.N Errors.N MPI_SUCCESS.N MPI_ERR_ARG.N MPI_ERR_OTHER@*/int MPI_Pack(const void *inbuf,	     int incount,	     MPI_Datatype datatype,	     void *outbuf,	     int outsize,	     int *position,	     MPI_Comm comm){    int mpi_errno = MPI_SUCCESS;    MPI_Aint position_x;    MPID_Comm *comm_ptr = NULL;        MPID_MPI_STATE_DECL(MPID_STATE_MPI_PACK);    MPIR_ERRTEST_INITIALIZED_ORDIE();    MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_PACK);    /* 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 */    MPID_Comm_get_ptr(comm, comm_ptr);    /* Validate parameters and objects (post conversion) */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS;        {	    MPIR_ERRTEST_COUNT(incount,mpi_errno);	    MPIR_ERRTEST_COUNT(outsize,mpi_errno);	    /* NOTE: inbuf could be null (MPI_BOTTOM) */	    if (incount > 0) {		MPIR_ERRTEST_ARGNULL(outbuf, "output buffer", mpi_errno);	    }	    MPIR_ERRTEST_ARGNULL(position, "position", mpi_errno);            /* Validate comm_ptr */	    /* If comm_ptr is not valid, it will be reset to null */            MPID_Comm_valid_ptr(comm_ptr, mpi_errno);	    if (mpi_errno != MPI_SUCCESS) goto fn_fail;	    MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);            if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN) {                MPID_Datatype *datatype_ptr = NULL;                MPID_Datatype_get_ptr(datatype, datatype_ptr);                MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno);                if (mpi_errno != MPI_SUCCESS) goto fn_fail;                MPID_Datatype_committed_ptr(datatype_ptr, mpi_errno);                if (mpi_errno != MPI_SUCCESS) goto fn_fail;            }        }        MPID_END_ERROR_CHECKS;    }#   endif /* HAVE_ERROR_CHECKING */#ifdef HAVE_ERROR_CHECKING /* IMPLEMENTATION-SPECIFIC ERROR CHECKS */    {//.........这里部分代码省略.........

/*@MPI_Igatherv - XXX description hereInput Parameters:+ sendbuf - starting address of the send buffer (choice). sendcount - number of elements in send buffer (non-negative integer). sendtype - data type of send buffer elements (handle). recvcounts - non-negative integer array (of length group size) containing the number of elements that are received from each process (significant only at root). displs - integer array (of length group size). Entry i specifies the displacement relative to recvbuf at which to place the incoming data from process i (significant only at root). recvtype - data type of receive buffer elements (significant only at root) (handle). root - rank of receiving process (integer)- comm - communicator (handle)Output Parameters:+ recvbuf - starting address of the receive buffer (significant only at root) (choice)- request - communication request (handle).N ThreadSafe.N Fortran.N Errors@*/int MPI_Igatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf,                 const int recvcounts[], const int displs[], MPI_Datatype recvtype, int root,                 MPI_Comm comm, MPI_Request *request){    int mpi_errno = MPI_SUCCESS;    MPID_Comm *comm_ptr = NULL;    MPID_MPI_STATE_DECL(MPID_STATE_MPI_IGATHERV);    MPIU_THREAD_CS_ENTER(ALLFUNC,);    MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_IGATHERV);    /* Validate parameters, especially handles needing to be converted */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS        {            MPIR_ERRTEST_COMM(comm, mpi_errno);            /* TODO more checks may be appropriate */        }        MPID_END_ERROR_CHECKS    }#   endif /* HAVE_ERROR_CHECKING */    /* Convert MPI object handles to object pointers */    MPID_Comm_get_ptr(comm, comm_ptr);    /* Validate parameters and objects (post conversion) */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS        {            MPID_Datatype *sendtype_ptr=NULL, *recvtype_ptr=NULL;            int i, rank, comm_size;            MPID_Comm_valid_ptr( comm_ptr, mpi_errno );            if (mpi_errno != MPI_SUCCESS) goto fn_fail;            if (comm_ptr->comm_kind == MPID_INTRACOMM) {                MPIR_ERRTEST_INTRA_ROOT(comm_ptr, root, mpi_errno);                if (sendbuf != MPI_IN_PLACE) {                    MPIR_ERRTEST_COUNT(sendcount, mpi_errno);                    MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno);                    if (HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) {                        MPID_Datatype_get_ptr(sendtype, sendtype_ptr);                        MPID_Datatype_valid_ptr( sendtype_ptr, mpi_errno );                        if (mpi_errno != MPI_SUCCESS) goto fn_fail;                        MPID_Datatype_committed_ptr( sendtype_ptr, mpi_errno );                        if (mpi_errno != MPI_SUCCESS) goto fn_fail;                    }                    MPIR_ERRTEST_USERBUFFER(sendbuf,sendcount,sendtype,mpi_errno);                }                rank = comm_ptr->rank;                if (rank == root) {                    comm_size = comm_ptr->local_size;                    for (i=0; i<comm_size; i++) {                        MPIR_ERRTEST_COUNT(recvcounts[i], mpi_errno);                        MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno);                    }                    if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) {                        MPID_Datatype_get_ptr(recvtype, recvtype_ptr);                        MPID_Datatype_valid_ptr( recvtype_ptr, mpi_errno );                        if (mpi_errno != MPI_SUCCESS) goto fn_fail;                        MPID_Datatype_committed_ptr( recvtype_ptr, mpi_errno );                        if (mpi_errno != MPI_SUCCESS) goto fn_fail;                    }                    for (i=0; i<comm_size; i++) {                        if (recvcounts[i] > 0) {                            MPIR_ERRTEST_RECVBUF_INPLACE(recvbuf, recvcounts[i], mpi_errno);                            MPIR_ERRTEST_USERBUFFER(recvbuf,recvcounts[i],recvtype,mpi_errno);                            break;                        }                    }                }//.........这里部分代码省略.........

/*@    MPI_Bsend_init - Builds a handle for a buffered sendInput Parameters:+ buf - initial address of send buffer (choice) . count - number of elements sent (integer) . datatype - type of each element (handle) . dest - rank of destination (integer) . tag - message tag (integer) - comm - communicator (handle) Output Parameters:. request - communication request (handle) .N ThreadSafe.N Fortran.N Errors.N MPI_SUCCESS.N MPI_ERR_COMM.N MPI_ERR_COUNT.N MPI_ERR_TYPE.N MPI_ERR_RANK.N MPI_ERR_TAG.seealso: MPI_Buffer_attach@*/int MPI_Bsend_init(const void *buf, int count, MPI_Datatype datatype,                   int dest, int tag, MPI_Comm comm, MPI_Request *request){    static const char FCNAME[] = "MPI_Bsend_init";    int mpi_errno = MPI_SUCCESS;    MPID_Request *request_ptr = NULL;    MPID_Comm *comm_ptr = NULL;    MPID_MPI_STATE_DECL(MPID_STATE_MPI_BSEND_INIT);    MPIR_ERRTEST_INITIALIZED_ORDIE();        MPIU_THREAD_CS_ENTER(ALLFUNC,);    MPID_MPI_PT2PT_FUNC_ENTER(MPID_STATE_MPI_BSEND_INIT);        /* Validate handle parameters 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 */    MPID_Comm_get_ptr( comm, comm_ptr );    /* Validate parameters if error checking is enabled */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS;        {            MPID_Comm_valid_ptr( comm_ptr, mpi_errno );            if (mpi_errno) goto fn_fail;	    	    MPIR_ERRTEST_COUNT(count, mpi_errno);	    MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);	    MPIR_ERRTEST_SEND_RANK(comm_ptr, dest, mpi_errno);	    MPIR_ERRTEST_SEND_TAG(tag, mpi_errno);	    MPIR_ERRTEST_ARGNULL(request,"request",mpi_errno);	    /* Validate datatype object */	    if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN)	    {		MPID_Datatype *datatype_ptr = NULL;		MPID_Datatype_get_ptr(datatype, datatype_ptr);		MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno);		if (mpi_errno) goto fn_fail;		MPID_Datatype_committed_ptr(datatype_ptr, mpi_errno);		if (mpi_errno) goto fn_fail;	    }        }        MPID_END_ERROR_CHECKS;    }#   endif /* HAVE_ERROR_CHECKING */    /* ... body of routine ...  */        mpi_errno = MPID_Bsend_init(buf, count, datatype, dest, tag, comm_ptr,				MPID_CONTEXT_INTRA_PT2PT, &request_ptr);    if (mpi_errno != MPI_SUCCESS) goto fn_fail;    /* return the handle of the request to the user */    MPIU_OBJ_PUBLISH_HANDLE(*request, request_ptr->handle);    /* ... end of body of routine ... */      fn_exit:    MPID_MPI_PT2PT_FUNC_EXIT(MPID_STATE_MPI_BSEND_INIT);    MPIU_THREAD_CS_EXIT(ALLFUNC,);//.........这里部分代码省略.........

/*@MPI_Igather - Gathers together values from a group of processes in              a nonblocking wayInput Parameters:+ sendbuf - starting address of the send buffer (choice). sendcount - number of elements in send buffer (non-negative integer). sendtype - data type of send buffer elements (handle). recvcount - number of elements for any single receive (non-negative integer, significant only at root). recvtype - data type of receive buffer elements (significant only at root) (handle). root - rank of receiving process (integer)- comm - communicator (handle)Output Parameters:+ recvbuf - starting address of the receive buffer (significant only at root) (choice)- request - communication request (handle).N ThreadSafe.N Fortran.N Errors@*/int MPI_Igather(const void *sendbuf, int sendcount, MPI_Datatype sendtype,                void *recvbuf, int recvcount, MPI_Datatype recvtype,                int root, MPI_Comm comm, MPI_Request * request){    int mpi_errno = MPI_SUCCESS;    MPIR_Comm *comm_ptr = NULL;    MPIR_Request *request_ptr = NULL;    MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_IGATHER);    MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);    MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_IGATHER);    /* 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;        {            MPIR_Datatype *sendtype_ptr = NULL, *recvtype_ptr = NULL;            int rank;            MPIR_Comm_valid_ptr(comm_ptr, mpi_errno, FALSE);            if (mpi_errno != MPI_SUCCESS)                goto fn_fail;            if (comm_ptr->comm_kind == MPIR_COMM_KIND__INTRACOMM) {                MPIR_ERRTEST_INTRA_ROOT(comm_ptr, root, mpi_errno);                if (sendbuf != MPI_IN_PLACE) {                    MPIR_ERRTEST_COUNT(sendcount, mpi_errno);                    MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno);                    if (HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) {                        MPIR_Datatype_get_ptr(sendtype, sendtype_ptr);                        MPIR_Datatype_valid_ptr(sendtype_ptr, mpi_errno);                        if (mpi_errno != MPI_SUCCESS)                            goto fn_fail;                        MPIR_Datatype_committed_ptr(sendtype_ptr, mpi_errno);                        if (mpi_errno != MPI_SUCCESS)                            goto fn_fail;                    }                    MPIR_ERRTEST_USERBUFFER(sendbuf, sendcount, sendtype, mpi_errno);                }                rank = comm_ptr->rank;                if (rank == root) {                    MPIR_ERRTEST_COUNT(recvcount, mpi_errno);                    MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno);                    if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) {                        MPIR_Datatype_get_ptr(recvtype, recvtype_ptr);                        MPIR_Datatype_valid_ptr(recvtype_ptr, mpi_errno);                        if (mpi_errno != MPI_SUCCESS)                            goto fn_fail;                        MPIR_Datatype_committed_ptr(recvtype_ptr, mpi_errno);                        if (mpi_errno != MPI_SUCCESS)                            goto fn_fail;                    }                    MPIR_ERRTEST_RECVBUF_INPLACE(recvbuf, recvcount, mpi_errno);                    MPIR_ERRTEST_USERBUFFER(recvbuf, recvcount, recvtype, mpi_errno);                    /* catch common aliasing cases */                    if (recvbuf != MPI_IN_PLACE && sendtype == recvtype && sendcount == recvcount &&                        sendcount != 0) {                        MPI_Aint recvtype_size;                        MPIR_Datatype_get_size_macro(recvtype, recvtype_size);//.........这里部分代码省略.........

/*@   MPI_Finalize - Terminates MPI execution environment   Notes:   All processes must call this routine before exiting.  The number of   processes running `after` this routine is called is undefined;    it is best not to perform much more than a 'return rc' after calling   'MPI_Finalize'.Thread and Signal Safety:The MPI standard requires that 'MPI_Finalize' be called `only` by the same thread that initialized MPI with either 'MPI_Init' or 'MPI_Init_thread'..N Fortran.N Errors.N MPI_SUCCESS@*/int MPI_Finalize( void ){    static const char FCNAME[] = "MPI_Finalize";    int mpi_errno = MPI_SUCCESS;#if defined(HAVE_USLEEP) && defined(USE_COVERAGE)    int rank=0;#endif    MPID_MPI_FINALIZE_STATE_DECL(MPID_STATE_MPI_FINALIZE);    MPIR_ERRTEST_INITIALIZED_ORDIE();    /* Note: Only one thread may ever call MPI_Finalize (MPI_Finalize may       be called at most once in any program) */    MPIU_THREAD_CS_ENTER(ALLFUNC,);    MPID_MPI_FINALIZE_FUNC_ENTER(MPID_STATE_MPI_FINALIZE);        /* ... body of routine ... */    /* If the user requested for asynchronous progress, we need to     * shutdown the progress thread */    if (MPIR_async_thread_initialized) {        mpi_errno = MPIR_Finalize_async_thread();        if (mpi_errno) goto fn_fail;    }    #if defined(HAVE_USLEEP) && defined(USE_COVERAGE)    /* We need to get the rank before freeing MPI_COMM_WORLD */    rank = MPIR_Process.comm_world->rank;#endif        /* Remove the attributes, executing the attribute delete routine.       Do this only if the attribute functions are defined. */     /* The standard (MPI-2, section 4.8) says that the attributes on        MPI_COMM_SELF are deleted before almost anything else happens */    /* Note that the attributes need to be removed from the communicators        so that they aren't freed twice. (The communicators are released       in MPID_Finalize) */    if (MPIR_Process.attr_free && MPIR_Process.comm_self->attributes) {        mpi_errno = MPIR_Process.attr_free( MPI_COMM_SELF,					    &MPIR_Process.comm_self->attributes);	MPIR_Process.comm_self->attributes = 0;    }    if (MPIR_Process.attr_free && MPIR_Process.comm_world->attributes) {        mpi_errno = MPIR_Process.attr_free( MPI_COMM_WORLD,                                             &MPIR_Process.comm_world->attributes);	MPIR_Process.comm_world->attributes = 0;    }    /*      * Now that we're finalizing, we need to take control of the error handlers     * At this point, we will release any user-defined error handlers on      * comm self and comm world     */    /* no MPI_OBJ CS needed here */    if (MPIR_Process.comm_world->errhandler && 	! (HANDLE_GET_KIND(MPIR_Process.comm_world->errhandler->handle) == 	   HANDLE_KIND_BUILTIN) ) {	int in_use;	MPIR_Errhandler_release_ref( MPIR_Process.comm_world->errhandler,				     &in_use);	if (!in_use) {	    MPIU_Handle_obj_free( &MPID_Errhandler_mem, 				  MPIR_Process.comm_world->errhandler );            MPIR_Process.comm_world->errhandler = NULL;	}    }    if (MPIR_Process.comm_self->errhandler && 	! (HANDLE_GET_KIND(MPIR_Process.comm_self->errhandler->handle) == 	   HANDLE_KIND_BUILTIN) ) {	int in_use;	MPIR_Errhandler_release_ref( MPIR_Process.comm_self->errhandler,				     &in_use);	if (!in_use) {	    MPIU_Handle_obj_free( &MPID_Errhandler_mem, 				  MPIR_Process.comm_self->errhandler );            MPIR_Process.comm_self->errhandler = NULL;	}    }    /* FIXME: Why is this not one of the finalize callbacks?.  Do we need       pre and post MPID_Finalize callbacks? */    MPIU_Timer_finalize();//.........这里部分代码省略.........

//.........这里部分代码省略.........                                     datatype, rank-1,                                     MPIR_ALLREDUCE_TAG, comm_ptr,                                     MPI_STATUS_IGNORE, 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);            }            /* do the reduction on received data. since the               ordering is right, it doesn't matter whether               the operation is commutative or not. */            mpi_errno = MPIR_Reduce_local(tmp_buf, recvbuf, count, datatype, op);            if (mpi_errno) MPIR_ERR_POP(mpi_errno);            /* change the rank */            newrank = rank / 2;        }    }    else  /* rank >= 2*rem */        newrank = rank - rem;    /* If op is user-defined or count is less than pof2, use       recursive doubling algorithm. Otherwise do a reduce-scatter       followed by allgather. (If op is user-defined,       derived datatypes are allowed and the user could pass basic       datatypes on one process and derived on another as long as       the type maps are the same. Breaking up derived       datatypes to do the reduce-scatter is tricky, therefore       using recursive doubling in that case.) */#ifdef HAVE_ERROR_CHECKING    MPIR_Assert(HANDLE_GET_KIND(op)==HANDLE_KIND_BUILTIN);    MPIR_Assert(count >= pof2);#endif /* HAVE_ERROR_CHECKING */    if (newrank != -1) {      MPIR_CHKLMEM_MALLOC(cnts, int *, pof2*sizeof(int), mpi_errno, "counts", MPL_MEM_BUFFER);      MPIR_CHKLMEM_MALLOC(disps, int *, pof2*sizeof(int), mpi_errno, "displacements", MPL_MEM_BUFFER);      for (i=0; i<pof2; i++)          cnts[i] = count/pof2;      if ((count % pof2) > 0) {          for (i=0; i<(count % pof2); i++)              cnts[i] += 1;      }      disps[0] = 0;      for (i=1; i<pof2; i++)          disps[i] = disps[i-1] + cnts[i-1];      mask = 0x1;      send_idx = recv_idx = 0;      last_idx = pof2;      while (mask < pof2) {          newdst = newrank ^ mask;          /* find real rank of dest */          dst = (newdst < rem) ? newdst*2 + 1 : newdst + rem;          send_cnt = recv_cnt = 0;          if (newrank < newdst) {              send_idx = recv_idx + pof2/(mask*2);              for (i=send_idx; i<last_idx; i++)                  send_cnt += cnts[i];              for (i=recv_idx; i<send_idx; i++)

//.........这里部分代码省略.........@*/int MPI_Fetch_and_op(const void *origin_addr, void *result_addr,        MPI_Datatype datatype, int target_rank, MPI_Aint target_disp,        MPI_Op op, MPI_Win win){    static const char FCNAME[] = "MPI_Fetch_and_op";    int mpi_errno = MPI_SUCCESS;    MPIR_Win *win_ptr = NULL;    MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_FETCH_AND_OP);    MPIR_ERRTEST_INITIALIZED_ORDIE();        MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);    MPIR_FUNC_TERSE_RMA_ENTER(MPID_STATE_MPI_FETCH_AND_OP);    /* Validate parameters, especially handles needing to be converted */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS;        {            MPIR_ERRTEST_WIN(win, mpi_errno);        }        MPID_END_ERROR_CHECKS;    }#   endif /* HAVE_ERROR_CHECKING */        /* Convert MPI object handles to object pointers */    MPIR_Win_get_ptr( win, win_ptr );    /* Validate parameters and objects (post conversion) */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS;        {            MPIR_Comm *comm_ptr;                        /* Validate win_ptr */            MPIR_Win_valid_ptr( win_ptr, mpi_errno );            if (mpi_errno) goto fn_fail;            if (op != MPI_NO_OP) {                /* NOTE: when op is MPI_NO_OP, origin_addr is allowed to be NULL.                 * In such case, MPI_Fetch_and_op equals to an atomic GET. */                MPIR_ERRTEST_ARGNULL(origin_addr, "origin_addr", mpi_errno);            }            MPIR_ERRTEST_ARGNULL(result_addr, "result_addr", mpi_errno);            MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);            if (!MPIR_DATATYPE_IS_PREDEFINED(datatype))            {                MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_TYPE, "**typenotpredefined");            }            if (win_ptr->create_flavor != MPI_WIN_FLAVOR_DYNAMIC)                MPIR_ERRTEST_DISP(target_disp, mpi_errno);            comm_ptr = win_ptr->comm_ptr;            MPIR_ERRTEST_SEND_RANK(comm_ptr, target_rank, mpi_errno);            MPIR_ERRTEST_OP_GACC(op, mpi_errno);            if (HANDLE_GET_KIND(op) != HANDLE_KIND_BUILTIN)            {                MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OP, "**opnotpredefined");            }        }        MPID_END_ERROR_CHECKS;    }#   endif /* HAVE_ERROR_CHECKING */    /* ... body of routine ...  */        mpi_errno = MPID_Fetch_and_op(origin_addr,                                  result_addr, datatype,                                  target_rank, target_disp,                                  op, win_ptr);    if (mpi_errno != MPI_SUCCESS) goto fn_fail;    /* ... end of body of routine ... */  fn_exit:    MPIR_FUNC_TERSE_RMA_EXIT(MPID_STATE_MPI_FETCH_AND_OP);    MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);    return mpi_errno;  fn_fail:    /* --BEGIN ERROR HANDLING-- */#   ifdef HAVE_ERROR_CHECKING    {        mpi_errno = MPIR_Err_create_code(            mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_fetch_and_op",            "**mpi_fetch_and_op %p %p %D %d %d %O %W", origin_addr,            result_addr, datatype, target_rank, target_disp, op, win);    }#   endif    mpi_errno = MPIR_Err_return_win( win_ptr, FCNAME, mpi_errno );    goto fn_exit;    /* --END ERROR HANDLING-- */}

/*@    MPI_Recv - Blocking receive for a messageOutput Parameters:+ buf - initial address of receive buffer (choice) - status - status object (Status) Input Parameters:+ count - maximum number of elements in receive buffer (integer) . datatype - datatype of each receive buffer element (handle) . source - rank of source (integer) . tag - message tag (integer) - comm - communicator (handle) Notes:The 'count' argument indicates the maximum length of a message; the actual length of the message can be determined with 'MPI_Get_count'.  .N ThreadSafe.N Fortran.N FortranStatus.N Errors.N MPI_SUCCESS.N MPI_ERR_COMM.N MPI_ERR_TYPE.N MPI_ERR_COUNT.N MPI_ERR_TAG.N MPI_ERR_RANK@*/int MPI_Recv(void *buf, int count, MPI_Datatype datatype, int source, int tag,	     MPI_Comm comm, MPI_Status *status){    static const char FCNAME[] = "MPI_Recv";    int mpi_errno = MPI_SUCCESS;    MPID_Comm *comm_ptr = NULL;    MPID_Request * request_ptr = NULL;    MPID_MPI_STATE_DECL(MPID_STATE_MPI_RECV);    MPIR_ERRTEST_INITIALIZED_ORDIE();        MPIU_THREAD_CS_ENTER(ALLFUNC,);    MPID_MPI_PT2PT_FUNC_ENTER_BACK(MPID_STATE_MPI_RECV);        /* Validate handle parameters needing to be converted */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS;        {	    MPIR_ERRTEST_COMM(comm, mpi_errno);	    /* NOTE: MPI_STATUS_IGNORE != NULL */	    MPIR_ERRTEST_ARGNULL(status, "status", mpi_errno);	}        MPID_END_ERROR_CHECKS;    }    #   endif /* HAVE_ERROR_CHECKING */        /* Convert MPI object handles to object pointers */    MPID_Comm_get_ptr( comm, comm_ptr );    /* Validate parameters if error checking is enabled */#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS;        {            MPID_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE );            if (mpi_errno) goto fn_fail;	    	    MPIR_ERRTEST_COUNT(count, mpi_errno);	    MPIR_ERRTEST_RECV_RANK(comm_ptr, source, mpi_errno);	    MPIR_ERRTEST_RECV_TAG(tag, mpi_errno);	    	    /* Validate datatype handle */	    MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);	    	    /* Validate datatype object */	    if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN)	    {		MPID_Datatype *datatype_ptr = NULL;		MPID_Datatype_get_ptr(datatype, datatype_ptr);		MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno);		if (mpi_errno) goto fn_fail;		MPID_Datatype_committed_ptr(datatype_ptr, mpi_errno);		if (mpi_errno) goto fn_fail;	    }	    	    /* Validate buffer */	    MPIR_ERRTEST_USERBUFFER(buf,count,datatype,mpi_errno);        }        MPID_END_ERROR_CHECKS;    }#   endif /* HAVE_ERROR_CHECKING */    /* ... body of routine ...  *///.........这里部分代码省略.........

/* MPIR_Type_get_elements * * Arguments: * - bytes_p - input/output byte count * - count - maximum number of this type to subtract from the bytes; a count *           of <0 indicates use as many as we like * - datatype - input datatype * * Returns number of elements available given the two constraints of number of * bytes and count of types.  Also reduces the byte count by the amount taken * up by the types. * * This is called from MPI_Get_elements() when it sees a type with multiple * element types (datatype_ptr->element_sz = -1).  This function calls itself too. */PMPI_LOCAL MPI_Count MPIR_Type_get_elements(MPI_Count *bytes_p,                                            MPI_Count count,                                            MPI_Datatype datatype){    MPIR_Datatype *datatype_ptr = NULL;    MPID_Datatype_get_ptr(datatype, datatype_ptr); /* invalid if builtin */    /* if we have gotten down to a type with only one element type,     * call MPIR_Type_get_basic_type_elements() and return.     */    if (HANDLE_GET_KIND(datatype) == HANDLE_KIND_BUILTIN ||        datatype == MPI_FLOAT_INT ||        datatype == MPI_DOUBLE_INT ||        datatype == MPI_LONG_INT ||        datatype == MPI_SHORT_INT ||        datatype == MPI_LONG_DOUBLE_INT)    {        return MPIR_Type_get_basic_type_elements(bytes_p, count, datatype);    }    else if (datatype_ptr->builtin_element_size >= 0) {        MPI_Datatype basic_type = MPI_DATATYPE_NULL;        MPID_Datatype_get_basic_type(datatype_ptr->basic_type, basic_type);        return MPIR_Type_get_basic_type_elements(bytes_p,                                                 count * datatype_ptr->n_builtin_elements,                                                 basic_type);    }    else {        /* we have bytes left and still don't have a single element size; must         * recurse.         */        int i, j, *ints;        MPI_Count typecount = 0, nr_elements = 0, last_nr_elements;        MPI_Aint *aints;        MPI_Datatype *types;        /* Establish locations of arrays */        MPID_Type_access_contents(datatype_ptr->handle, &ints, &aints, &types);        if (!ints || !aints || !types)            return MPI_ERR_TYPE;        switch (datatype_ptr->contents->combiner) {            case MPI_COMBINER_NAMED:            case MPI_COMBINER_DUP:            case MPI_COMBINER_RESIZED:                return MPIR_Type_get_elements(bytes_p, count, *types);                break;            case MPI_COMBINER_CONTIGUOUS:            case MPI_COMBINER_VECTOR:            case MPI_COMBINER_HVECTOR_INTEGER:            case MPI_COMBINER_HVECTOR:                /* count is first in ints array */                return MPIR_Type_get_elements(bytes_p, count * (*ints), *types);                break;            case MPI_COMBINER_INDEXED_BLOCK:            case MPI_COMBINER_HINDEXED_BLOCK:                /* count is first in ints array, blocklength is second */                return MPIR_Type_get_elements(bytes_p,                                              count * ints[0] * ints[1],                                              *types);                break;            case MPI_COMBINER_INDEXED:            case MPI_COMBINER_HINDEXED_INTEGER:            case MPI_COMBINER_HINDEXED:                for (i=0; i < (*ints); i++) {                    /* add up the blocklengths to get a max. # of the next type */                    typecount += ints[i+1];                }                return MPIR_Type_get_elements(bytes_p, count * typecount, *types);                break;            case MPI_COMBINER_STRUCT_INTEGER:            case MPI_COMBINER_STRUCT:                /* In this case we can't simply multiply the count of the next                 * type by the count of the current type, because we need to                 * cycle through the types just as the struct would.  thus the                 * nested loops.                 *                 * We need to keep going until we get less elements than expected                 * or we run out of bytes.                 */                last_nr_elements = 1; /* seed value */                for (j=0;                     (count < 0 || j < count) &&//.........这里部分代码省略.........

/*@    MPI_Type_hindexed - Creates an indexed datatype with offsets in bytesInput Parameters:+ count - number of blocks -- also number of entries in indices and blocklens. blocklens - number of elements in each block (array of nonnegative integers) . indices - byte displacement of each block (array of MPI_Aint) - old_type - old datatype (handle) Output Parameter:. newtype - new datatype (handle) .N DeprecatedThis routine is replaced by 'MPI_Type_create_hindexed'..N ThreadSafe.N FortranThe indices are displacements, and are based on a zero origin.  A common erroris to do something like to following.vb    integer a(100)    integer blens(10), indices(10)    do i=1,10         blens(i)   = 110       indices(i) = (1 + (i-1)*10) * sizeofint    call MPI_TYPE_HINDEXED(10,blens,indices,MPI_INTEGER,newtype,ierr)    call MPI_TYPE_COMMIT(newtype,ierr)    call MPI_SEND(a,1,newtype,...).veexpecting this to send 'a(1),a(11),...' because the indices have values '1,11,...'.   Because these are `displacements` from the beginning of 'a',it actually sends 'a(1+1),a(1+11),...'.If you wish to consider the displacements as indices into a Fortran array,consider declaring the Fortran array with a zero origin.vb    integer a(0:99).ve.N Errors.N MPI_SUCCESS.N MPI_ERR_TYPE.N MPI_ERR_COUNT.N MPI_ERR_EXHAUSTED.N MPI_ERR_ARG@*/int MPI_Type_hindexed(int count,		      int blocklens[],		      MPI_Aint indices[],		      MPI_Datatype old_type,		      MPI_Datatype *newtype){    static const char FCNAME[] = "MPI_Type_hindexed";    int mpi_errno = MPI_SUCCESS;    MPI_Datatype new_handle;    MPID_Datatype *new_dtp;    int i, *ints;    MPIU_CHKLMEM_DECL(1);    MPID_MPI_STATE_DECL(MPID_STATE_MPI_TYPE_HINDEXED);    MPIR_ERRTEST_INITIALIZED_ORDIE();        MPIU_THREAD_CS_ENTER(ALLFUNC,);    MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_TYPE_HINDEXED);#   ifdef HAVE_ERROR_CHECKING    {        MPID_BEGIN_ERROR_CHECKS;        {	    int j;	    MPID_Datatype *datatype_ptr = NULL;	    MPIR_ERRTEST_COUNT(count, mpi_errno);	    MPIR_ERRTEST_DATATYPE(old_type, "datatype", mpi_errno);	    if (count > 0) {		MPIR_ERRTEST_ARGNULL(blocklens, "blocklens", mpi_errno);		MPIR_ERRTEST_ARGNULL(indices, "indices", mpi_errno);	    }	    if (mpi_errno == MPI_SUCCESS) {		if (HANDLE_GET_KIND(old_type) != HANDLE_KIND_BUILTIN) {		    MPID_Datatype_get_ptr( old_type, datatype_ptr );		    MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno);		}		/* verify that all blocklengths are >= 0 */		for (j=0; j < count; j++) {		    MPIR_ERRTEST_ARGNEG(blocklens[j], "blocklen", mpi_errno);		}	    }	    MPIR_ERRTEST_ARGNULL(newtype, "newtype", mpi_errno);            if (mpi_errno != MPI_SUCCESS) goto fn_fail;        }        MPID_END_ERROR_CHECKS;    }#   endif /* HAVE_ERROR_CHECKING */    /* ... body of routine ...  */        mpi_errno = MPID_Type_indexed(count,//.........这里部分代码省略.........

int MPIR_Get_elements_x_impl(const MPI_Status *status, MPI_Datatype datatype, MPI_Count *elements){    int mpi_errno = MPI_SUCCESS;    MPIR_Datatype *datatype_ptr = NULL;    MPI_Count byte_count;    if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN) {        MPID_Datatype_get_ptr(datatype, datatype_ptr);    }    /* three cases:     * - nice, simple, single element type     * - derived type with a zero size     * - type with multiple element types (nastiest)     */    if (HANDLE_GET_KIND(datatype) == HANDLE_KIND_BUILTIN ||        (datatype_ptr->builtin_element_size != -1 && datatype_ptr->size > 0))    {        byte_count = MPIR_STATUS_GET_COUNT(*status);        /* QUESTION: WHAT IF SOMEONE GAVE US AN MPI_UB OR MPI_LB???         */        /* in both cases we do not limit the number of types that might         * be in bytes         */        if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN) {            MPI_Datatype basic_type = MPI_DATATYPE_NULL;            MPID_Datatype_get_basic_type(datatype_ptr->basic_type, basic_type);            *elements = MPIR_Type_get_basic_type_elements(&byte_count,                                                          -1,                                                          basic_type);        }        else {            /* Behaves just like MPI_Get_Count in the predefined case */            MPI_Count size;            MPID_Datatype_get_size_macro(datatype, size);            if ((byte_count % size) != 0)                *elements = MPI_UNDEFINED;            else                *elements = MPIR_Type_get_basic_type_elements(&byte_count,                                                              -1,                                                              datatype);        }        MPIR_Assert(byte_count >= 0);    }    else if (datatype_ptr->size == 0) {        if (MPIR_STATUS_GET_COUNT(*status) > 0) {            /* --BEGIN ERROR HANDLING-- */            /* datatype size of zero and count > 0 should never happen. */            (*elements) = MPI_UNDEFINED;            /* --END ERROR HANDLING-- */        }        else {            /* This is ambiguous.  However, discussions on MPI Forum             * reached a consensus that this is the correct return             * value             */            (*elements) = 0;        }    }    else /* derived type with weird element type or weird size */ {        MPIR_Assert(datatype_ptr->builtin_element_size == -1);        byte_count = MPIR_STATUS_GET_COUNT(*status);        *elements = MPIR_Type_get_elements(&byte_count, -1, datatype);    }    return mpi_errno;}

/*@  MPI_Errhandler_set - Sets the error handler for a communicatorInput Parameters:+ comm - communicator to set the error handler for (handle) - errhandler - new MPI error handler for communicator (handle) .N ThreadSafe.N DeprecatedThe replacement for this routine is 'MPI_Comm_set_errhandler'..N Fortran.N Errors.N MPI_SUCCESS.N MPI_ERR_COMM.N MPI_ERR_ARG.seealso: MPI_Comm_set_errhandler, MPI_Errhandler_create, MPI_Comm_create_errhandler@*/int MPI_Errhandler_set(MPI_Comm comm, MPI_Errhandler errhandler){    int mpi_errno = MPI_SUCCESS;    MPIR_Comm *comm_ptr = NULL;    MPIR_Errhandler *errhan_ptr;    MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_ERRHANDLER_SET);    MPIR_ERRTEST_INITIALIZED_ORDIE();        MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);    MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_ERRHANDLER_SET);    /* 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 );    MPIR_Errhandler_get_ptr( errhandler, errhan_ptr );    /* 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) goto fn_fail;	    MPIR_ERRTEST_ERRHANDLER(errhandler, mpi_errno);	    if (HANDLE_GET_KIND(errhandler) != HANDLE_KIND_BUILTIN) {                MPIR_Errhandler_valid_ptr( errhan_ptr, mpi_errno );                if (mpi_errno) goto fn_fail;            }        }        MPID_END_ERROR_CHECKS;    }#   endif /* HAVE_ERROR_CHECKING */    /* ... body of routine ...  */        MPIR_Comm_set_errhandler_impl(comm_ptr, errhan_ptr);        /* ... end of body of routine ... */#   ifdef HAVE_ERROR_CHECKING  fn_exit:#   endif    MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_ERRHANDLER_SET);    MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);    return mpi_errno;#   ifdef HAVE_ERROR_CHECKING  fn_fail:    /* --BEGIN ERROR HANDLING-- */    {	mpi_errno = MPIR_Err_create_code(	    mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_errhandler_set",	    "**mpi_errhandler_set %C %E", comm, errhandler);    }    mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );    goto fn_exit;    /* --END ERROR HANDLING-- */#   endif}

int MPIR_Iallreduce_redscat_allgather(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPID_Comm *comm_ptr, MPID_Sched_t s){    int mpi_errno = MPI_SUCCESS;    int comm_size, rank, newrank, pof2, rem;    int i, send_idx, recv_idx, last_idx, mask, newdst, dst, send_cnt, recv_cnt;    MPI_Aint true_lb, true_extent, extent;    void *tmp_buf = NULL;    int *cnts, *disps;    MPIR_SCHED_CHKPMEM_DECL(1);    MPIU_CHKLMEM_DECL(2);    /* we only support builtin datatypes for now, breaking up user types to do     * the reduce-scatter is tricky */    MPIU_Assert(HANDLE_GET_KIND(op) == HANDLE_KIND_BUILTIN);    comm_size = comm_ptr->local_size;    rank = comm_ptr->rank;    /* need to allocate temporary buffer to store incoming data*/    MPIR_Type_get_true_extent_impl(datatype, &true_lb, &true_extent);    MPID_Datatype_get_extent_macro(datatype, extent);    MPID_Ensure_Aint_fits_in_pointer(count * MPIR_MAX(extent, true_extent));    MPIR_SCHED_CHKPMEM_MALLOC(tmp_buf, void *, count*(MPIR_MAX(extent,true_extent)), mpi_errno, "temporary buffer");    /* adjust for potential negative lower bound in datatype */    tmp_buf = (void *)((char*)tmp_buf - true_lb);    /* copy local data into recvbuf */    if (sendbuf != MPI_IN_PLACE) {        mpi_errno = MPID_Sched_copy(sendbuf, count, datatype,                                    recvbuf, count, datatype, s);        if (mpi_errno) MPIU_ERR_POP(mpi_errno);        MPID_SCHED_BARRIER(s);    }    /* find nearest power-of-two less than or equal to comm_size */    pof2 = 1;    while (pof2 <= comm_size) pof2 <<= 1;    pof2 >>=1;    rem = comm_size - pof2;    /* In the non-power-of-two case, all even-numbered       processes of rank < 2*rem send their data to       (rank+1). These even-numbered processes no longer       participate in the algorithm until the very end. The       remaining processes form a nice power-of-two. */    if (rank < 2*rem) {        if (rank % 2 == 0) { /* even */            mpi_errno = MPID_Sched_send(recvbuf, count, datatype, rank+1, comm_ptr, s);            if (mpi_errno) MPIU_ERR_POP(mpi_errno);            MPID_SCHED_BARRIER(s);            /* temporarily set the rank to -1 so that this               process does not pariticipate in recursive               doubling */            newrank = -1;        }        else { /* odd */            mpi_errno = MPID_Sched_recv(tmp_buf, count, datatype, rank-1, comm_ptr, s);            if (mpi_errno) MPIU_ERR_POP(mpi_errno);            MPID_SCHED_BARRIER(s);            /* do the reduction on received data. since the               ordering is right, it doesn't matter whether               the operation is commutative or not. */            mpi_errno = MPID_Sched_reduce(tmp_buf, recvbuf, count, datatype, op, s);            if (mpi_errno) MPIU_ERR_POP(mpi_errno);            MPID_SCHED_BARRIER(s);            /* change the rank */            newrank = rank / 2;        }    }    else  /* rank >= 2*rem */        newrank = rank - rem;    if (newrank != -1) {        /* for the reduce-scatter, calculate the count that           each process receives and the displacement within           the buffer */        /* TODO I ([email
C++ HANDLE_MSG函数代码示例
C++ HANDLE_ERROR函数代码示例