/*@ MPI_Comm_spawn_multiple - short description Input Parameters: + count - number of commands (positive integer, significant to MPI only at root . array_of_commands - programs to be executed (array of strings, significant only at root) . array_of_argv - arguments for commands (array of array of strings, significant only at root) . array_of_maxprocs - maximum number of processes to start for each command (array of integer, significant only at root) . array_of_info - info objects telling the runtime system where and how to start processes (array of handles, significant only at root) . root - rank of process in which previous arguments are examined (integer) - comm - intracommunicator containing group of spawning processes (handle) Output Parameters: + intercomm - intercommunicator between original group and newly spawned group (handle) - array_of_errcodes - one error code per process (array of integer) .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_COMM .N MPI_ERR_ARG .N MPI_ERR_INFO .N MPI_ERR_SPAWN @*/ int MPI_Comm_spawn_multiple(int count, char *array_of_commands[], char **array_of_argv[], const int array_of_maxprocs[], const MPI_Info array_of_info[], int root, MPI_Comm comm, MPI_Comm *intercomm, int array_of_errcodes[]) { static const char FCNAME[] = "MPI_Comm_spawn_multiple"; int mpi_errno = MPI_SUCCESS, i; MPID_Comm *comm_ptr = NULL; MPID_Comm *intercomm_ptr = NULL; MPID_Info **array_of_info_ptrs = NULL; MPIU_CHKLMEM_DECL(1); MPID_MPI_STATE_DECL(MPID_STATE_MPI_COMM_SPAWN_MULTIPLE); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_COMM_SPAWN_MULTIPLE); /* 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; { /* Validate comm_ptr */ MPID_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE ); /* If comm_ptr is not valid, it will be reset to null */ if (mpi_errno) goto fn_fail; MPIR_ERRTEST_COMM_INTRA(comm_ptr, mpi_errno); MPIR_ERRTEST_RANK(comm_ptr, root, mpi_errno); if (comm_ptr->rank == root) { MPIR_ERRTEST_ARGNULL(array_of_commands, "array_of_commands", mpi_errno); MPIR_ERRTEST_ARGNULL(array_of_maxprocs, "array_of_maxprocs", mpi_errno); MPIR_ERRTEST_ARGNONPOS(count, "count", mpi_errno, MPI_ERR_COUNT); for (i = 0; i < count; i++) { MPIR_ERRTEST_INFO_OR_NULL(array_of_info[i], mpi_errno); MPIR_ERRTEST_ARGNULL(array_of_commands[i], "array_of_commands[i]", mpi_errno); MPIR_ERRTEST_ARGNEG(array_of_maxprocs[i], "array_of_maxprocs[i]", mpi_errno); } } } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ if (comm_ptr->rank == root) { MPIU_CHKLMEM_MALLOC(array_of_info_ptrs, MPID_Info **, count * sizeof(MPID_Info*), mpi_errno, "array of info pointers"); for (i=0; i<count; i++) { MPID_Info_get_ptr(array_of_info[i], array_of_info_ptrs[i]); } }
/*@ MPIX_Comm_failure_get_acked - Get the group of acknowledged failures. Input Parameters: . comm - Communicator (handle) Output Parameters: . failed_group - Group (handle) Notes: .N COMMNULL .N ThreadSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_COMM @*/ int MPIX_Comm_failure_get_acked( MPI_Comm comm, MPI_Group *failedgrp ) { int mpi_errno = MPI_SUCCESS; MPIR_Comm *comm_ptr = NULL; MPIR_Group *group_ptr; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPIX_COMM_FAILURE_GET_ACKED); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPIX_COMM_FAILURE_GET_ACKED); /* Validate parameters, especially handles needing to be converted */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_COMM(comm, mpi_errno); } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* Convert MPI object handles to object pointers */ MPIR_Comm_get_ptr(comm, comm_ptr); /* Validate parameters and objects(post conversion */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { /* Validate comm_ptr */ MPIR_Comm_valid_ptr( comm_ptr, mpi_errno, TRUE ); /* If comm_ptr is not valid, it will be reset to null */ if (mpi_errno) goto fn_fail; } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPID_Comm_failure_get_acked(comm_ptr, &group_ptr); if (mpi_errno) goto fn_fail; *failedgrp = group_ptr->handle; /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPIX_COMM_FAILURE_GET_ACKED); 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, "**mpix_comm_failure_get_acked", "**mpix_comm_failure_get_acked %C %p", comm, failedgrp); } # endif mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Bsend - Basic send with user-provided buffering Input Parameters: + buf - initial address of send buffer (choice) . count - number of elements in send buffer (nonnegative integer) . datatype - datatype of each send buffer element (handle) . dest - rank of destination (integer) . tag - message tag (integer) - comm - communicator (handle) Notes: This send is provided as a convenience function; it allows the user to send messages without worring about where they are buffered (because the user `must` have provided buffer space with 'MPI_Buffer_attach'). In deciding how much buffer space to allocate, remember that the buffer space is not available for reuse by subsequent 'MPI_Bsend's unless you are certain that the message has been received (not just that it should have been received). For example, this code does not allocate enough buffer space .vb MPI_Buffer_attach( b, n*sizeof(double) + MPI_BSEND_OVERHEAD ); for (i=0; i<m; i++) { MPI_Bsend( buf, n, MPI_DOUBLE, ... ); } .ve because only enough buffer space is provided for a single send, and the loop may start a second 'MPI_Bsend' before the first is done making use of the buffer. In C, you can force the messages to be delivered by .vb MPI_Buffer_detach( &b, &n ); MPI_Buffer_attach( b, n ); .ve (The 'MPI_Buffer_detach' will not complete until all buffered messages are delivered.) .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, MPI_Ibsend, MPI_Bsend_init @*/ int MPI_Bsend(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm) { 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_Ialltoallw - Nonblocking generalized all-to-all communication allowing different datatypes, counts, and displacements for each partner Input Parameters: + sendbuf - starting address of the send buffer (choice) . sendcounts - non-negative integer array (of length group size) specifying the number of elements to send to each processor . sdispls - integer array (of length group size). Entry j specifies the displacement relative to sendbuf from which to take the outgoing data destined for process j . sendtypes - array of datatypes (of length group size). Entry j specifies the type of data to send to process j (array of handles) . recvcounts - non-negative integer array (of length group size) specifying the number of elements that can be received from each processor . rdispls - integer array (of length group size). Entry i specifies the displacement relative to recvbuf at which to place the incoming data from process i . recvtypes - array of datatypes (of length group size). Entry i specifies the type of data received from process i (array of handles) - comm - communicator (handle) Output Parameters: + recvbuf - starting address of the receive buffer (choice) - request - communication request (handle) .N ThreadSafe .N Fortran .N Errors @*/ int MPI_Ialltoallw(const void *sendbuf, const int sendcounts[], const int sdispls[], const MPI_Datatype sendtypes[], void *recvbuf, const int recvcounts[], const int rdispls[], const MPI_Datatype recvtypes[], 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_IALLTOALLW); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_IALLTOALLW); /* 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 */ MPIR_Comm_get_ptr(comm, comm_ptr); /* Validate parameters and objects (post conversion) */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS { MPIR_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; if (sendbuf != MPI_IN_PLACE) { MPIR_ERRTEST_ARGNULL(sendcounts,"sendcounts", mpi_errno); MPIR_ERRTEST_ARGNULL(sdispls,"sdispls", mpi_errno); MPIR_ERRTEST_ARGNULL(sendtypes,"sendtypes", mpi_errno); if (comm_ptr->comm_kind == MPIR_COMM_KIND__INTRACOMM && sendcounts == recvcounts && sendtypes == recvtypes) MPIR_ERRTEST_ALIAS_COLL(sendbuf,recvbuf,mpi_errno); } MPIR_ERRTEST_ARGNULL(recvcounts,"recvcounts", mpi_errno); MPIR_ERRTEST_ARGNULL(rdispls,"rdispls", mpi_errno); MPIR_ERRTEST_ARGNULL(recvtypes,"recvtypes", mpi_errno); if (comm_ptr->comm_kind == MPIR_COMM_KIND__INTERCOMM && sendbuf == MPI_IN_PLACE) { MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**sendbuf_inplace"); } MPIR_ERRTEST_ARGNULL(request,"request", mpi_errno); /* TODO more checks may be appropriate (counts, in_place, etc) */ } MPID_END_ERROR_CHECKS } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_Ialltoallw(sendbuf, sendcounts, sdispls, sendtypes, recvbuf, recvcounts, rdispls, recvtypes, comm_ptr, &request_ptr); if (mpi_errno) MPIR_ERR_POP(mpi_errno); /* return the handle of the request to the user */ if(request_ptr) *request = request_ptr->handle; else *request = MPI_REQUEST_NULL; /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_IALLTOALLW); 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_ialltoallw", "**mpi_ialltoallw %p %p %p %p %p %p %p %p %C %p", sendbuf, sendcounts, sdispls, sendtypes, recvbuf, recvcounts, rdispls, recvtypes, comm, request); } # endif mpi_errno = MPIR_Err_return_comm(comm_ptr, FCNAME, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Comm_free - Marks the communicator object for deallocation Input Parameters: . comm - Communicator to be destroyed (handle) Notes: This routine `frees` a communicator. Because the communicator may still be in use by other MPI routines, the actual communicator storage will not be freed until all references to this communicator are removed. For most users, the effect of this routine is the same as if it was in fact freed at this time of this call. Null Handles: The MPI 1.1 specification, in the section on opaque objects, explicitly disallows 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( mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_comm_free", "**mpi_comm_free %p", comm); } # endif mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Sendrecv - Sends and receives a message Input 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); if (mpi_errno) goto fn_fail; MPIR_Datatype_committed_ptr(datatype_ptr, mpi_errno); if (mpi_errno) goto fn_fail; } if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) { MPIR_Datatype *datatype_ptr = NULL; MPIR_Datatype_get_ptr(recvtype, datatype_ptr); MPIR_Datatype_valid_ptr(datatype_ptr, mpi_errno); if (mpi_errno) goto fn_fail; MPIR_Datatype_committed_ptr(datatype_ptr, mpi_errno); if (mpi_errno) goto fn_fail; } /* Validate buffers */ MPIR_ERRTEST_USERBUFFER(sendbuf, sendcount, sendtype, mpi_errno); MPIR_ERRTEST_USERBUFFER(recvbuf, recvcount, recvtype, mpi_errno); } MPID_END_ERROR_CHECKS; } #endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPID_Irecv(recvbuf, recvcount, recvtype, source, recvtag, comm_ptr, MPIR_CONTEXT_INTRA_PT2PT, &rreq); if (mpi_errno != MPI_SUCCESS) goto fn_fail; /* FIXME - Performance for small messages might be better if MPID_Send() were used here instead of MPID_Isend() */ mpi_errno = MPID_Isend(sendbuf, sendcount, sendtype, dest, sendtag, comm_ptr, MPIR_CONTEXT_INTRA_PT2PT, &sreq); if (mpi_errno != MPI_SUCCESS) { /* --BEGIN ERROR HANDLING-- */ if (mpi_errno == MPIX_ERR_NOREQ) MPIR_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**nomem"); /* FIXME: should we cancel the pending (possibly completed) receive request or wait for it to complete? */ MPIR_Request_free(rreq); goto fn_fail; /* --END ERROR HANDLING-- */ } if (!MPIR_Request_is_complete(sreq) || !MPIR_Request_is_complete(rreq)) { MPID_Progress_state progress_state; MPID_Progress_start(&progress_state); while (!MPIR_Request_is_complete(sreq) || !MPIR_Request_is_complete(rreq)) { mpi_errno = MPID_Progress_wait(&progress_state); if (mpi_errno != MPI_SUCCESS) { /* --BEGIN ERROR HANDLING-- */ MPID_Progress_end(&progress_state); goto fn_fail; /* --END ERROR HANDLING-- */ } if (unlikely(MPIR_Request_is_anysrc_mismatched(rreq))) { /* --BEGIN ERROR HANDLING-- */ mpi_errno = MPIR_Request_handle_proc_failed(rreq); if (!MPIR_Request_is_complete(sreq)) { MPID_Cancel_send(sreq); MPIR_STATUS_SET_CANCEL_BIT(sreq->status, FALSE); } goto fn_fail; /* --END ERROR HANDLING-- */ } } MPID_Progress_end(&progress_state); } mpi_errno = rreq->status.MPI_ERROR; MPIR_Request_extract_status(rreq, status); MPIR_Request_free(rreq); if (mpi_errno == MPI_SUCCESS) { mpi_errno = sreq->status.MPI_ERROR; } MPIR_Request_free(sreq); if (mpi_errno != MPI_SUCCESS) goto fn_fail; /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_PT2PT_EXIT_BOTH(MPID_STATE_MPI_SENDRECV); MPID_THREAD_CS_EXIT(VCI_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, __func__, __LINE__, MPI_ERR_OTHER, "**mpi_sendrecv", "**mpi_sendrecv %p %d %D %i %t %p %d %D %i %t %C %p", sendbuf, sendcount, sendtype, dest, sendtag, recvbuf, recvcount, recvtype, source, recvtag, comm, status); } #endif mpi_errno = MPIR_Err_return_comm(comm_ptr, __func__, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Neighbor_allgather - In this function, each process i gathers data items from each process j if an edge (j,i) exists in the topology graph, and each process 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 block in 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); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Allreduce - Combines values from all processes and distributes the result back to all processes Input 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_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_Allreduce_impl(sendbuf, recvbuf, count, datatype, op, comm_ptr, &errflag); if (mpi_errno) goto fn_fail; /* ... end of body of routine ... */ fn_exit: MPID_MPI_COLL_FUNC_EXIT(MPID_STATE_MPI_ALLREDUCE); 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_allreduce", "**mpi_allreduce %p %p %d %D %O %C", sendbuf, recvbuf, count, datatype, op, comm); } # endif mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Bsend_init - Builds a handle for a buffered send Input 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,); 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_init", "**mpi_bsend_init %p %d %D %i %t %C %p", buf, count, datatype, dest, tag, comm, request); } # endif mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/* 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 */ case 4: *attr_val_p = &attr_copy.host; break; case 5: /* IO */ case 6: *attr_val_p = &attr_copy.io; break; case 7: /* WTIME */ case 8: *attr_val_p = &attr_copy.wtime_is_global; break; case 9: /* UNIVERSE_SIZE */ case 10: /* This is a special case. If universe is not set, then we attempt to get it from the device. If the device is doesn't supply a value, then we set the flag accordingly */ if (attr_copy.universe >= 0) { *attr_val_p = &attr_copy.universe; } else if (attr_copy.universe == MPIR_UNIVERSE_SIZE_NOT_AVAILABLE) { *flag = 0; } else { mpi_errno = MPID_Get_universe_size(&attr_copy.universe); /* --BEGIN ERROR HANDLING-- */ if (mpi_errno != MPI_SUCCESS) { attr_copy.universe = MPIR_UNIVERSE_SIZE_NOT_AVAILABLE; goto fn_fail; } /* --END ERROR HANDLING-- */ if (attr_copy.universe >= 0) { *attr_val_p = &attr_copy.universe; } else { attr_copy.universe = MPIR_UNIVERSE_SIZE_NOT_AVAILABLE; *flag = 0; } } break; case 11: /* LASTUSEDCODE */ case 12: *attr_val_p = &attr_copy.lastusedcode; break; case 13: /* APPNUM */ case 14: /* This is another special case. If appnum is negative, we take that as indicating no value of APPNUM, and set the flag accordingly */ if (attr_copy.appnum < 0) { *flag = 0; } else { *attr_val_p = &attr_copy.appnum; } break; } /* All of the predefined attributes are INTEGER; since we've set the output value as the pointer to these, we need to dereference it here. */ if (*flag) { /* Use the internal pointer-sized-int for systems (e.g., BG/P) that define MPI_Aint as a different size than MPIR_Pint. The casts must be as they are: On the right, the value is a pointer to an int, so to get the correct value, we need to extract the int. On the left, the output type is given by the argument outAttrType - and the cast must match the intended results */ if (outAttrType == MPIR_ATTR_AINT) *(MPIR_Pint*)attr_val_p = *(int*)*(void **)attr_val_p; else if (outAttrType == MPIR_ATTR_INT) *(int*)attr_val_p = *(int *)*(void **)attr_val_p; } } else { MPID_Attribute *p = comm_ptr->attributes; /* */ *flag = 0; while (p) { if (p->keyval->handle == comm_keyval) { *flag = 1; if (outAttrType == MPIR_ATTR_PTR) { if (p->attrType == MPIR_ATTR_INT) { /* This is the tricky case: if the system is bigendian, and we have to return a pointer to an int, then we may need to point to the correct location in the word. */ #if defined(WORDS_LITTLEENDIAN) || (SIZEOF_VOID_P == SIZEOF_INT) *(void**)attribute_val = &(p->value); #else int *p_loc = (int *)&(p->value); #if SIZEOF_VOID_P == 2 * SIZEOF_INT p_loc++; #else #error Expected sizeof(void*) to be either sizeof(int) or 2*sizeof(int) #endif *(void **)attribute_val = p_loc; #endif } else if (p->attrType == MPIR_ATTR_AINT) { *(void**)attribute_val = &(p->value); } else { *(void**)attribute_val = (void *)(MPIR_Pint)(p->value); } } else *(void**)attribute_val = (void *)(MPIR_Pint)(p->value); break; } p = p->next; } } /* ... end of body of routine ... */ fn_exit: MPID_MPI_FUNC_EXIT(MPID_STATE_MPIR_COMM_GET_ATTR); 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, "**mpir_comm_get_attr", "**mpir_comm_get_attr %C %d %p %p", comm, comm_keyval, attribute_val, flag); } # endif mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Pack - Packs a datatype into contiguous memory Input 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 */ { int tmp_sz; MPID_BEGIN_ERROR_CHECKS; /* Verify that there is space in the buffer to pack the type */ MPID_Datatype_get_size_macro(datatype, tmp_sz); if (tmp_sz * incount > outsize - *position) { if (*position < 0) { MPIU_ERR_SETANDJUMP1(mpi_errno,MPI_ERR_ARG, "**argposneg","**argposneg %d", *position); } else if (outsize < 0) { MPIU_ERR_SETANDJUMP2(mpi_errno,MPI_ERR_ARG,"**argneg", "**argneg %s %d","outsize",outsize); } else if (incount < 0) { MPIU_ERR_SETANDJUMP2(mpi_errno,MPI_ERR_ARG,"**argneg", "**argneg %s %d","incount",incount); } else { MPIU_ERR_SETANDJUMP2(mpi_errno,MPI_ERR_ARG,"**argpackbuf", "**argpackbuf %d %d", tmp_sz * incount, outsize - *position); } } MPID_END_ERROR_CHECKS; } #endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ position_x = *position; mpi_errno = MPIR_Pack_impl(inbuf, incount, datatype, outbuf, outsize, &position_x); MPIU_Assign_trunc(*position, position_x, int); if (mpi_errno) goto fn_fail; /* ... end of body of routine ... */ fn_exit: MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_PACK); 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_pack", "**mpi_pack %p %d %D %p %d %p %C", inbuf, incount, datatype, outbuf, outsize, position, comm); } # endif mpi_errno = MPIR_Err_return_comm(comm_ptr, FCNAME, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Cart_coords - Determines process coords in cartesian topology given rank in group Input Parameters: + comm - communicator with cartesian structure (handle) . rank - rank of a process within group of 'comm' (integer) - maxdims - length of vector 'coords' in the calling program (integer) Output Parameter: . coords - integer array (of size 'ndims') containing the Cartesian coordinates of specified process (integer) .N SignalSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_TOPOLOGY .N MPI_ERR_RANK .N MPI_ERR_DIMS .N MPI_ERR_ARG @*/ int MPI_Cart_coords(MPI_Comm comm, int rank, int maxdims, int *coords) { static const char FCNAME[] = "MPI_Cart_coords"; int mpi_errno = MPI_SUCCESS; MPID_Comm *comm_ptr = NULL; MPIR_Topology *cart_ptr; int i, nnodes; MPID_MPI_STATE_DECL(MPID_STATE_MPI_CART_COORDS); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_CART_COORDS); /* 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 /* 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 */ if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPIR_ERRTEST_RANK(comm_ptr, rank, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ cart_ptr = MPIR_Topology_get( comm_ptr ); # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIU_ERR_CHKANDJUMP((!cart_ptr || cart_ptr->kind != MPI_CART), mpi_errno, MPI_ERR_TOPOLOGY, "**notcarttopo"); MPIU_ERR_CHKANDJUMP2((cart_ptr->topo.cart.ndims > maxdims), mpi_errno, MPI_ERR_ARG, "**dimsmany", "**dimsmany %d %d", cart_ptr->topo.cart.ndims, maxdims); if (cart_ptr->topo.cart.ndims) { MPIR_ERRTEST_ARGNULL(coords,"coords",mpi_errno); if (mpi_errno) goto fn_fail; } } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ /* Calculate coords */ nnodes = cart_ptr->topo.cart.nnodes; for ( i=0; i < cart_ptr->topo.cart.ndims; i++ ) { nnodes = nnodes / cart_ptr->topo.cart.dims[i]; coords[i] = rank / nnodes; rank = rank % nnodes; } /* ... end of body of routine ... */ fn_exit: MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_CART_COORDS); 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_cart_coords", "**mpi_cart_coords %C %d %d %p", comm, rank, maxdims, coords); } # endif mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Ibsend - Starts a nonblocking buffered send Input Parameters: + buf - initial address of send buffer (choice) . count - number of elements in send buffer (integer) . datatype - datatype of each send buffer 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_TAG .N MPI_ERR_RANK .N MPI_ERR_BUFFER @*/ int MPI_Ibsend(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, MPI_Request * request) { int mpi_errno = MPI_SUCCESS; MPIR_Comm *comm_ptr = NULL; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_IBSEND); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPIR_FUNC_TERSE_PT2PT_ENTER_FRONT(MPID_STATE_MPI_IBSEND); /* 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 */ MPIR_Comm_get_ptr(comm, comm_ptr); /* Validate parameters if error checking is enabled */ #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_COUNT(count, mpi_errno); /* Validate comm_ptr */ MPIR_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) { MPIR_Datatype *datatype_ptr = NULL; MPIR_Datatype_get_ptr(datatype, datatype_ptr); MPIR_Datatype_valid_ptr(datatype_ptr, mpi_errno); if (mpi_errno) goto fn_fail; MPIR_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 ... */ mpi_errno = MPIR_Ibsend_impl(buf, count, datatype, dest, tag, comm_ptr, request); if (mpi_errno) goto fn_fail; /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_PT2PT_EXIT(MPID_STATE_MPI_IBSEND); MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); return mpi_errno; fn_fail: /* --BEGIN ERROR HANDLING-- */ /* FIXME: should we be setting the request at all in the case of an error? */ *request = MPI_REQUEST_NULL; #ifdef HAVE_ERROR_REPORTING { mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_ibsend", "**mpi_ibsend %p %d %D %i %t %C %p", buf, count, datatype, dest, tag, comm, request); } #endif mpi_errno = MPIR_Err_return_comm(comm_ptr, FCNAME, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Barrier - Blocks until all processes in the communicator have reached this routine. Input Parameters: . comm - communicator (handle) Notes: Blocks the caller until all processes in the communicator have called it; that is, the call returns at any process only after all members of the communicator have entered the call. .N ThreadSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_COMM @*/ int MPI_Barrier( MPI_Comm comm ) { int mpi_errno = MPI_SUCCESS; MPID_Comm *comm_ptr = NULL; MPIR_Errflag_t errflag = MPIR_ERR_NONE; MPID_MPI_STATE_DECL(MPID_STATE_MPI_BARRIER); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPID_MPI_COLL_FUNC_ENTER(MPID_STATE_MPI_BARRIER); /* 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 */ MPID_Comm_get_ptr( comm, comm_ptr ); /* Validate parameters and objects (post conversion) */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { /* Validate communicator */ MPID_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE ); if (mpi_errno) goto fn_fail; } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_Barrier_impl(comm_ptr, &errflag); if (mpi_errno) goto fn_fail; /* ... end of body of routine ... */ fn_exit: MPID_MPI_COLL_FUNC_EXIT(MPID_STATE_MPI_BARRIER); 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_barrier", "**mpi_barrier %C", comm); } # endif mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Igather - Gathers together values from a group of processes in a nonblocking way Input 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); MPIR_ERRTEST_ALIAS_COLL(sendbuf, (char *) recvbuf + comm_ptr->rank * recvcount * recvtype_size, mpi_errno); } } else MPIR_ERRTEST_SENDBUF_INPLACE(sendbuf, sendcount, mpi_errno); } if (comm_ptr->comm_kind == MPIR_COMM_KIND__INTERCOMM) { MPIR_ERRTEST_INTER_ROOT(comm_ptr, root, mpi_errno); if (root == MPI_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); } else if (root != MPI_PROC_NULL) { 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_SENDBUF_INPLACE(sendbuf, sendcount, mpi_errno); MPIR_ERRTEST_USERBUFFER(sendbuf, sendcount, sendtype, mpi_errno); } } } MPID_END_ERROR_CHECKS; } #endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_Igather(sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, root, comm_ptr, &request_ptr); if (mpi_errno) MPIR_ERR_POP(mpi_errno); /* create a complete request, if needed */ if (!request_ptr) request_ptr = MPIR_Request_create_complete(MPIR_REQUEST_KIND__COLL); /* return the handle of the request to the user */ *request = request_ptr->handle; /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_IGATHER); 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, __func__, __LINE__, MPI_ERR_OTHER, "**mpi_igather", "**mpi_igather %p %d %D %p %d %D %d %C %p", sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, root, comm, request); } #endif mpi_errno = MPIR_Err_return_comm(comm_ptr, __func__, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Cart_shift - Returns the shifted source and destination ranks, given a shift direction and amount Input Parameters: + comm - communicator with cartesian structure (handle) . direction - coordinate dimension of shift (integer) - disp - displacement (> 0: upwards shift, < 0: downwards shift) (integer) Output Parameters: + rank_source - rank of source process (integer) - rank_dest - rank of destination process (integer) Notes: The 'direction' argument is in the range '[0,n-1]' for an n-dimensional Cartesian mesh. .N SignalSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_TOPOLOGY .N MPI_ERR_COMM .N MPI_ERR_ARG @*/ int MPI_Cart_shift(MPI_Comm comm, int direction, int disp, int *rank_source, int *rank_dest) { int mpi_errno = MPI_SUCCESS; MPID_Comm *comm_ptr = NULL; MPID_MPI_STATE_DECL(MPID_STATE_MPI_CART_SHIFT); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_CART_SHIFT); /* 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; { /* Validate comm_ptr */ MPID_Comm_valid_ptr( comm_ptr, mpi_errno, TRUE ); if (mpi_errno) goto fn_fail; /* If comm_ptr is not valid, it will be reset to null */ MPIR_ERRTEST_ARGNULL( rank_source, "rank_source", mpi_errno ); MPIR_ERRTEST_ARGNULL( rank_dest, "rank_dest", mpi_errno ); MPIR_ERRTEST_ARGNEG( direction, "direction", mpi_errno ); /* Nothing in the standard indicates that a zero displacement is not valid, so we don't check for a zero shift */ } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_Cart_shift_impl(comm_ptr, direction, disp, rank_source, rank_dest); if (mpi_errno) MPIU_ERR_POP(mpi_errno); /* ... end of body of routine ... */ fn_exit: MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_CART_SHIFT); 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_cart_shift", "**mpi_cart_shift %C %d %d %p %p", comm, direction, disp, rank_source, rank_dest); } # endif mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Iprobe - Nonblocking test for a message Input Parameters: + source - source rank, or 'MPI_ANY_SOURCE' (integer) . tag - tag value or 'MPI_ANY_TAG' (integer) - comm - communicator (handle) Output Parameters: + flag - True if a message with the specified source, tag, and communicator is available (logical) - status - status object (Status) .N ThreadSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_COMM .N MPI_ERR_TAG .N MPI_ERR_RANK @*/ int MPI_Iprobe(int source, int tag, MPI_Comm comm, int *flag, MPI_Status *status) { static const char FCNAME[] = "MPI_Iprobe"; int mpi_errno = MPI_SUCCESS; MPID_Comm *comm_ptr = NULL; MPID_MPI_STATE_DECL(MPID_STATE_MPI_IPROBE); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPIU_THREAD_CS_ENTER(ALLFUNC,); MPID_MPI_PT2PT_FUNC_ENTER(MPID_STATE_MPI_IPROBE); /* 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; { /* Validate communicator */ MPID_Comm_valid_ptr( comm_ptr, mpi_errno ); if (mpi_errno) goto fn_fail; MPIR_ERRTEST_ARGNULL( flag, "flag", mpi_errno ); MPIR_ERRTEST_RECV_TAG(tag,mpi_errno); if (comm_ptr) { MPIR_ERRTEST_RECV_RANK(comm_ptr, source, mpi_errno); } } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ /* FIXME: Is this correct for intercomms? */ mpi_errno = MPID_Iprobe(source, tag, comm_ptr, MPID_CONTEXT_INTRA_PT2PT, flag, status); if (mpi_errno != MPI_SUCCESS) goto fn_fail; /* ... end of body of routine ... */ fn_exit: MPID_MPI_PT2PT_FUNC_EXIT(MPID_STATE_MPI_IPROBE); 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_iprobe", "**mpi_iprobe %i %t %C %p %p", source, tag, comm, flag, status); } # endif mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Cartdim_get - Retrieves Cartesian topology information associated with a communicator Input Parameters: . comm - communicator with cartesian structure (handle) Output Parameters: . ndims - number of dimensions of the cartesian structure (integer) .N SignalSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_COMM .N MPI_ERR_ARG @*/ int MPI_Cartdim_get(MPI_Comm comm, int *ndims) { static const char FCNAME[] = "MPI_Cartdim_get"; int mpi_errno = MPI_SUCCESS; MPIR_Comm *comm_ptr = NULL; MPIR_Topology *cart_ptr; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_CARTDIM_GET); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_CARTDIM_GET); /* 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 ); /* Validate parameters and objects (post conversion) */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_ARGNULL(ndims,"ndims",mpi_errno); /* Validate comm_ptr */ MPIR_Comm_valid_ptr( comm_ptr, mpi_errno, TRUE ); /* If comm_ptr is not valid, it will be reset to null */ if (mpi_errno) goto fn_fail; } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ cart_ptr = MPIR_Topology_get( comm_ptr ); MPIR_ERR_CHKANDJUMP((!cart_ptr || cart_ptr->kind != MPI_CART), mpi_errno, MPI_ERR_TOPOLOGY, "**notcarttopo"); *ndims = cart_ptr->topo.cart.ndims; /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_CARTDIM_GET); 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_cartdim_get", "**mpi_cartdim_get %C %p", comm, ndims); } # endif mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Recv - Blocking receive for a message Output 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 ... */ /* MT: Note that MPID_Recv may release the SINGLE_CS if it decides to block internally. MPID_Recv in that case will re-aquire the SINGLE_CS before returnning */ mpi_errno = MPID_Recv(buf, count, datatype, source, tag, comm_ptr, MPID_CONTEXT_INTRA_PT2PT, status, &request_ptr); if (mpi_errno != MPI_SUCCESS) goto fn_fail; if (request_ptr == NULL) { goto fn_exit; } /* If a request was returned, then we need to block until the request is complete */ if (!MPID_Request_is_complete(request_ptr)) { MPID_Progress_state progress_state; MPID_Progress_start(&progress_state); while (!MPID_Request_is_complete(request_ptr)) { /* MT: Progress_wait may release the SINGLE_CS while it waits */ mpi_errno = MPID_Progress_wait(&progress_state); if (mpi_errno != MPI_SUCCESS) { /* --BEGIN ERROR HANDLING-- */ MPID_Progress_end(&progress_state); goto fn_fail; /* --END ERROR HANDLING-- */ } if (unlikely(MPIR_CVAR_ENABLE_FT && !MPID_Request_is_complete(request_ptr) && MPID_Request_is_anysource(request_ptr) && !MPID_Comm_AS_enabled(request_ptr->comm))) { /* --BEGIN ERROR HANDLING-- */ MPID_Cancel_recv(request_ptr); MPIR_STATUS_SET_CANCEL_BIT(request_ptr->status, FALSE); MPIU_ERR_SET(request_ptr->status.MPI_ERROR, MPIX_ERR_PROC_FAILED, "**proc_failed"); mpi_errno = request_ptr->status.MPI_ERROR; goto fn_fail; /* --END ERROR HANDLING-- */ } } MPID_Progress_end(&progress_state); } mpi_errno = request_ptr->status.MPI_ERROR; MPIR_Request_extract_status(request_ptr, status); MPID_Request_release(request_ptr); if (mpi_errno != MPI_SUCCESS) goto fn_fail; /* ... end of body of routine ... */ fn_exit: MPID_MPI_PT2PT_FUNC_EXIT_BACK(MPID_STATE_MPI_RECV); 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_recv", "**mpi_recv %p %d %D %i %t %C %p", buf, count, datatype, source, tag, comm, status); } # endif mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPIX_Comm_revoke - Prevent a communicator from being used in the future Input Parameters: . comm - communicator to revoke Notes: Asynchronously notifies all MPI processes associated with the communicator 'comm'. This will be manifest by returning the MPIX_ERR_REVOKED during a subsequent MPI call. .N Fortran .N Errors .N MPI_SUCCESS @*/ int MPIX_Comm_revoke(MPI_Comm comm) { int mpi_errno = MPI_SUCCESS; MPIR_Comm *comm_ptr = NULL; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPIX_COMM_REVOKE); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPIX_COMM_REVOKE); /* 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); /* Validate parameters and objects (post conversion) */ #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { /* Validate comm_ptr */ MPIR_Comm_valid_ptr(comm_ptr, mpi_errno, TRUE); if (mpi_errno) goto fn_fail; } MPID_END_ERROR_CHECKS; } #endif /* ... body of routine ... */ mpi_errno = MPID_Comm_revoke(comm_ptr, 0); if (mpi_errno) MPIR_ERR_POP(mpi_errno); /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPIX_COMM_REVOKE); 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, "**mpix_comm_revoke", "**mpix_comm_revoke %C", comm); } #endif mpi_errno = MPIR_Err_return_comm(comm_ptr, FCNAME, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Dist_graph_neighbors - Provides adjacency information for a distributed graph topology. Input Parameters: + comm - communicator with distributed graph topology (handle) . maxindegree - size of sources and sourceweights arrays (non-negative integer) - maxoutdegree - size of destinations and destweights arrays (non-negative integer) Output Parameters: + sources - processes for which the calling process is a destination (array of non-negative integers) . sourceweights - weights of the edges into the calling process (array of non-negative integers) . destinations - processes for which the calling process is a source (array of non-negative integers) - destweights - weights of the edges out of the calling process (array of non-negative integers) .N ThreadSafe .N Fortran .N Errors .N MPI_SUCCESS @*/ int MPI_Dist_graph_neighbors(MPI_Comm comm, int maxindegree, int sources[], int sourceweights[], int maxoutdegree, int destinations[], int destweights[]) { int mpi_errno = MPI_SUCCESS; MPIR_Comm *comm_ptr = NULL; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_DIST_GRAPH_NEIGHBORS); MPIR_ERRTEST_INITIALIZED_ORDIE(); /* FIXME: Why does this routine need a CS */ MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_DIST_GRAPH_NEIGHBORS); /* 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); /* Validate parameters */ #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_Topology *topo_ptr = NULL; topo_ptr = MPIR_Topology_get(comm_ptr); MPIR_ERR_CHKANDJUMP(!topo_ptr || topo_ptr->kind != MPI_DIST_GRAPH, mpi_errno, MPI_ERR_TOPOLOGY, "**notdistgraphtopo"); MPIR_ERRTEST_ARGNEG(maxindegree, "maxindegree", mpi_errno); MPIR_ERRTEST_ARGNEG(maxoutdegree, "maxoutdegree", mpi_errno); MPIR_ERR_CHKANDJUMP3((maxindegree < topo_ptr->topo.dist_graph.indegree), mpi_errno, MPI_ERR_ARG, "**argtoosmall", "**argtoosmall %s %d %d", "maxindegree", maxindegree, topo_ptr->topo.dist_graph.indegree); MPIR_ERR_CHKANDJUMP3((maxoutdegree < topo_ptr->topo.dist_graph.outdegree), mpi_errno, MPI_ERR_ARG, "**argtoosmall", "**argtoosmall %s %d %d", "maxoutdegree", maxoutdegree, topo_ptr->topo.dist_graph.outdegree); } MPID_END_ERROR_CHECKS; } #endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_Dist_graph_neighbors_impl(comm_ptr, maxindegree, sources, sourceweights, maxoutdegree, destinations, destweights); if (mpi_errno) MPIR_ERR_POP(mpi_errno); /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_DIST_GRAPH_NEIGHBORS); 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_dist_graph_neighbors", "**mpi_dist_graph_neighbors %C %d %p %p %d %p %p", comm, maxindegree, sources, sourceweights, maxoutdegree, destinations, destweights); #endif mpi_errno = MPIR_Err_return_comm(comm_ptr, FCNAME, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Topo_test - Determines the type of topology (if any) associated with a communicator Input Parameters: . comm - communicator (handle) Output Parameters: . status - topology type of communicator 'comm' (integer). If the communicator has no associated topology, returns 'MPI_UNDEFINED'. .N SignalSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_COMM .N MPI_ERR_ARG .seealso: MPI_Graph_create, MPI_Cart_create @*/ int MPI_Topo_test(MPI_Comm comm, int *status) { #ifdef HAVE_ERROR_CHECKING static const char FCNAME[] = "MPI_Topo_test"; #endif int mpi_errno = MPI_SUCCESS; MPID_Comm *comm_ptr = NULL; MPIR_Topology *topo_ptr; MPID_MPI_STATE_DECL(MPID_STATE_MPI_TOPO_TEST); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_TOPO_TEST); /* 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; { /* Validate comm_ptr */ MPID_Comm_valid_ptr( comm_ptr, mpi_errno, TRUE ); if (mpi_errno) goto fn_fail; /* If comm_ptr is not valid, it will be reset to null */ MPIR_ERRTEST_ARGNULL(status, "status", mpi_errno); } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ topo_ptr = MPIR_Topology_get( comm_ptr ); if (topo_ptr) { *status = (int)(topo_ptr->kind); } else { *status = MPI_UNDEFINED; } /* ... end of body of routine ... */ #ifdef HAVE_ERROR_CHECKING fn_exit: #endif MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_TOPO_TEST); return mpi_errno; /* --BEGIN ERROR HANDLING-- */ # ifdef HAVE_ERROR_CHECKING fn_fail: { mpi_errno = MPIR_Err_create_code( mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_topo_test", "**mpi_topo_test %C %p", comm, status); } mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; # endif /* --END ERROR HANDLING-- */ }
/*@ MPI_Errhandler_set - Sets the error handler for a communicator Input Parameters: + comm - communicator to set the error handler for (handle) - errhandler - new MPI error handler for communicator (handle) .N ThreadSafe .N Deprecated The 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 }
/*@ MPI_Alltoallv - Sends data from all to all processes; each process may send a different amount of data and provide displacements for the input and output data. Input Parameters: + sendbuf - starting address of send buffer (choice) . sendcounts - integer array equal to the group size specifying the number of elements to send to each processor . sdispls - integer array (of length group size). Entry 'j' specifies the displacement (relative to sendbuf from which to take the outgoing data destined for process 'j' . sendtype - data type of send buffer elements (handle) . recvcounts - integer array equal to the group size specifying the maximum number of elements that can be received from each processor . rdispls - integer array (of length group size). Entry 'i' specifies the displacement (relative to recvbuf at which to place the incoming data from process 'i' . recvtype - data type of receive buffer elements (handle) - comm - communicator (handle) Output Parameters: . recvbuf - address of receive buffer (choice) .N ThreadSafe .N Fortran .N Errors .N MPI_ERR_COMM .N MPI_ERR_COUNT .N MPI_ERR_TYPE .N MPI_ERR_BUFFER @*/ int MPI_Alltoallv(const void *sendbuf, const int *sendcounts, const int *sdispls, MPI_Datatype sendtype, void *recvbuf, const int *recvcounts, const int *rdispls, MPI_Datatype recvtype, MPI_Comm comm) { int mpi_errno = MPI_SUCCESS; MPID_Comm *comm_ptr = NULL; MPIR_Errflag_t errflag = MPIR_ERR_NONE; MPID_MPI_STATE_DECL(MPID_STATE_MPI_ALLTOALLV); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPID_MPI_COLL_FUNC_ENTER(MPID_STATE_MPI_ALLTOALLV); /* 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 */ 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, comm_size; int check_send = (comm_ptr->comm_kind == MPID_INTRACOMM && sendbuf != MPI_IN_PLACE); MPID_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; if (comm_ptr->comm_kind == MPID_INTRACOMM) { comm_size = comm_ptr->local_size; if (sendbuf != MPI_IN_PLACE && sendtype == recvtype && sendcounts == recvcounts) MPIR_ERRTEST_ALIAS_COLL(sendbuf, recvbuf, mpi_errno); } else comm_size = comm_ptr->remote_size; if (comm_ptr->comm_kind == MPID_INTERCOMM && sendbuf == MPI_IN_PLACE) { MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**sendbuf_inplace"); } for (i=0; i<comm_size; i++) { if (check_send) { MPIR_ERRTEST_COUNT(sendcounts[i], mpi_errno); MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno); } MPIR_ERRTEST_COUNT(recvcounts[i], mpi_errno); MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno); } if (check_send && 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; } 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 && check_send; i++) { if (sendcounts[i] > 0) { MPIR_ERRTEST_USERBUFFER(sendbuf,sendcounts[i],sendtype,mpi_errno); } } 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; } } } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_Alltoallv_impl(sendbuf, sendcounts, sdispls, sendtype, recvbuf, recvcounts, rdispls, recvtype, comm_ptr, &errflag); if (mpi_errno) goto fn_fail; /* ... end of body of routine ... */ fn_exit: MPID_MPI_COLL_FUNC_EXIT(MPID_STATE_MPI_ALLTOALLV); 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_alltoallv", "**mpi_alltoallv %p %p %p %D %p %p %p %D %C", sendbuf, sendcounts, sdispls, sendtype, recvbuf, recvcounts, rdispls, recvtype, comm); } # endif mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Comm_connect - Make a request to form a new intercommunicator Input Parameters: + port_name - network address (string, used only on root) . info - implementation-dependent information (handle, used only on root) . root - rank in comm of root node (integer) - comm - intracommunicator over which call is collective (handle) Output Parameters: . newcomm - intercommunicator with server as remote group (handle) .N ThreadSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_COMM .N MPI_ERR_INFO .N MPI_ERR_PORT @*/ int MPI_Comm_connect(const char *port_name, MPI_Info info, int root, MPI_Comm comm, MPI_Comm *newcomm) { int mpi_errno = MPI_SUCCESS; MPIR_Comm *comm_ptr = NULL; MPIR_Comm *newcomm_ptr = NULL; MPIR_Info *info_ptr = NULL; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_COMM_CONNECT); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_COMM_CONNECT); /* Validate parameters, especially handles needing to be converted */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_COMM(comm, mpi_errno); MPIR_ERRTEST_INFO_OR_NULL(info, mpi_errno); } MPID_END_ERROR_CHECKS; } # endif /* Convert MPI object handles to object pointers */ MPIR_Comm_get_ptr( comm, comm_ptr ); MPIR_Info_get_ptr( info, info_ptr ); /* Validate parameters and objects (post conversion) */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { /* Validate comm_ptr */ MPIR_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE ); /* If comm_ptr is not valid, it will be reset to null */ if (mpi_errno) goto fn_fail; } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_Comm_connect_impl(port_name, info_ptr, root, comm_ptr, &newcomm_ptr); if (mpi_errno) goto fn_fail; MPIR_OBJ_PUBLISH_HANDLE(*newcomm, newcomm_ptr->handle); /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_COMM_CONNECT); 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_comm_connect", "**mpi_comm_connect %s %I %d %C %p", port_name, info, root, comm, newcomm); } # endif mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Comm_idup - nonblocking communicator duplication Input Parameters: . comm - communicator (handle) Output Parameters: + newcomm - copy of comm (handle) - request - communication request (handle) .N ThreadSafe .N Fortran .N Errors @*/ int MPI_Comm_idup(MPI_Comm comm, MPI_Comm *newcomm, MPI_Request *request) { int mpi_errno = MPI_SUCCESS; MPID_Comm *comm_ptr = NULL; MPID_Comm *newcomm_ptr = NULL; MPID_Request *dreq = NULL; MPID_MPI_STATE_DECL(MPID_STATE_MPI_COMM_IDUP); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_COMM_IDUP); /* 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_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPIR_ERRTEST_ARGNULL(request, "request", mpi_errno); /* TODO more checks may be appropriate (counts, in_place, buffer aliasing, etc) */ } MPID_END_ERROR_CHECKS } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ *request = MPI_REQUEST_NULL; *newcomm = MPI_COMM_NULL; mpi_errno = MPIR_Comm_idup_impl(comm_ptr, &newcomm_ptr, &dreq); if (mpi_errno) MPIR_ERR_POP(mpi_errno); /* NOTE: this is a publication for most of the comm, but the context ID * won't be valid yet, so we must "republish" relative to the request * handle at request completion time. */ MPIR_OBJ_PUBLISH_HANDLE(*newcomm, newcomm_ptr->handle); *request = dreq->handle; /* ... end of body of routine ... */ fn_exit: MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_COMM_IDUP); 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_comm_idup", "**mpi_comm_idup %C %p %p", comm, newcomm, request); } # endif mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Cart_rank - Determines process rank in communicator given Cartesian location Input Parameters: + comm - communicator with cartesian structure (handle) - coords - integer array (of size 'ndims', the number of dimensions of the Cartesian topology associated with 'comm') specifying the cartesian coordinates of a process Output Parameters: . rank - rank of specified process (integer) Notes: Out-of-range coordinates are erroneous for non-periodic dimensions. Versions of MPICH before 1.2.2 returned 'MPI_PROC_NULL' for the rank in this case. .N SignalSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_TOPOLOGY .N MPI_ERR_RANK .N MPI_ERR_ARG @*/ int MPI_Cart_rank(MPI_Comm comm, const int coords[], int *rank) { int mpi_errno = MPI_SUCCESS; MPIR_Comm *comm_ptr = NULL; MPIR_Topology *cart_ptr; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_CART_RANK); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_CART_RANK); /* 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 ); # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { /* Validate comm_ptr */ MPIR_Comm_valid_ptr( comm_ptr, mpi_errno, TRUE ); if (mpi_errno) goto fn_fail; /* If comm_ptr is not valid, it will be reset to null */ MPIR_ERRTEST_ARGNULL(rank,"rank",mpi_errno); } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ cart_ptr = MPIR_Topology_get( comm_ptr ); MPIR_ERR_CHKANDJUMP((!cart_ptr || cart_ptr->kind != MPI_CART), mpi_errno, MPI_ERR_TOPOLOGY, "**notcarttopo"); /* Validate coordinates */ # ifdef HAVE_ERROR_CHECKING { int i, ndims, coord; MPID_BEGIN_ERROR_CHECKS; { ndims = cart_ptr->topo.cart.ndims; if (ndims != 0) { MPIR_ERRTEST_ARGNULL(coords,"coords",mpi_errno); } for (i=0; i<ndims; i++) { if (!cart_ptr->topo.cart.periodic[i]) { coord = coords[i]; MPIR_ERR_CHKANDJUMP3( (coord < 0 || coord >= cart_ptr->topo.cart.dims[i] ), mpi_errno, MPI_ERR_ARG, "**cartcoordinvalid", "**cartcoordinvalid %d %d %d",i, coords[i], cart_ptr->topo.cart.dims[i]-1 ); } } } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ MPIR_Cart_rank_impl(cart_ptr, coords, rank); /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_CART_RANK); 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_cart_rank", "**mpi_cart_rank %C %p %p", comm, coords, rank); } # endif mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Igatherv - XXX description here Input 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; } } } else MPIR_ERRTEST_SENDBUF_INPLACE(sendbuf, sendcount, mpi_errno); } if (comm_ptr->comm_kind == MPID_INTERCOMM) { MPIR_ERRTEST_INTER_ROOT(comm_ptr, root, mpi_errno); if (root == MPI_ROOT) { comm_size = comm_ptr->remote_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; } } } else if (root != MPI_PROC_NULL) { 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_SENDBUF_INPLACE(sendbuf, sendcount, mpi_errno); MPIR_ERRTEST_USERBUFFER(sendbuf,sendcount,sendtype,mpi_errno); } } } MPID_END_ERROR_CHECKS } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_Igatherv_impl(sendbuf, sendcount, sendtype, recvbuf, recvcounts, displs, recvtype, root, comm_ptr, request); if (mpi_errno) MPIU_ERR_POP(mpi_errno); /* ... end of body of routine ... */ fn_exit: MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_IGATHERV); 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_igatherv", "**mpi_igatherv %p %d %D %p %p %p %D %d %C %p", sendbuf, sendcount, sendtype, recvbuf, recvcounts, displs, recvtype, root, comm, request); } # endif mpi_errno = MPIR_Err_return_comm(comm_ptr, FCNAME, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ goto fn_exit; }
/*@ MPI_Cart_shift - Returns the shifted source and destination ranks, given a shift direction and amount Input Parameters: + comm - communicator with cartesian structure (handle) . direction - coordinate dimension of shift (integer) - displ - displacement (> 0: upwards shift, < 0: downwards shift) (integer) Output Parameters: + source - rank of source process (integer) - dest - rank of destination process (integer) Notes: The 'direction' argument is in the range '[0,n-1]' for an n-dimensional Cartesian mesh. .N SignalSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_TOPOLOGY .N MPI_ERR_COMM .N MPI_ERR_ARG @*/ int MPI_Cart_shift(MPI_Comm comm, int direction, int displ, int *source, int *dest) { int mpi_errno = MPI_SUCCESS; MPID_Comm *comm_ptr = NULL; MPIR_Topology *cart_ptr; int i; int pos[MAX_CART_DIM]; int rank; MPID_MPI_STATE_DECL(MPID_STATE_MPI_CART_SHIFT); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_CART_SHIFT); /* 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 /* 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( source, "source", mpi_errno ); MPIR_ERRTEST_ARGNULL( dest, "dest", mpi_errno ); MPIR_ERRTEST_ARGNEG( direction, "direction", mpi_errno ); /* Nothing in the standard indicates that a zero displacement is not valid, so we don't check for a zero shift */ if (mpi_errno) goto fn_fail; } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ cart_ptr = MPIR_Topology_get( comm_ptr ); MPIU_ERR_CHKANDJUMP((!cart_ptr || cart_ptr->kind != MPI_CART), mpi_errno, MPI_ERR_TOPOLOGY, "**notcarttopo"); MPIU_ERR_CHKANDJUMP((cart_ptr->topo.cart.ndims == 0), mpi_errno, MPI_ERR_TOPOLOGY, "**dimszero"); MPIU_ERR_CHKANDJUMP2((direction >= cart_ptr->topo.cart.ndims), mpi_errno, MPI_ERR_ARG, "**dimsmany", "**dimsmany %d %d", cart_ptr->topo.cart.ndims, direction); /* Check for the case of a 0 displacement */ rank = comm_ptr->rank; if (displ == 0) { *source = *dest = rank; } else { /* To support advanced implementations that support MPI_Cart_create, we compute the new position and call PMPI_Cart_rank to get the source and destination. We could bypass that step if we know that the mapping is trivial. Copy the current position. */ for (i=0; i<cart_ptr->topo.cart.ndims; i++) { pos[i] = cart_ptr->topo.cart.position[i]; } /* We must return MPI_PROC_NULL if shifted over the edge of a non-periodic mesh */ pos[direction] += displ; if (!cart_ptr->topo.cart.periodic[direction] && (pos[direction] >= cart_ptr->topo.cart.dims[direction] || pos[direction] < 0)) { *dest = MPI_PROC_NULL; } else { MPIR_Cart_rank_impl( cart_ptr, pos, dest ); } pos[direction] = cart_ptr->topo.cart.position[direction] - displ; if (!cart_ptr->topo.cart.periodic[direction] && (pos[direction] >= cart_ptr->topo.cart.dims[direction] || pos[direction] < 0)) { *source = MPI_PROC_NULL; } else { MPIR_Cart_rank_impl( cart_ptr, pos, source ); } } /* ... end of body of routine ... */ fn_exit: MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_CART_SHIFT); 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_cart_shift", "**mpi_cart_shift %C %d %d %p %p", comm, direction, displ, source, dest); } # endif mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Intercomm_merge - Creates an intracommuncator from an intercommunicator Input Parameters: + intercomm - Intercommunicator (handle) - high - Used to order the groups within comm (logical) when creating the new communicator. This is a boolean value; the group that sets high true has its processes ordered `after` the group that sets this value to false. If all processes in the intercommunicator provide the same value, the choice of which group is ordered first is arbitrary. Output Parameters: . newintracomm - Created intracommunicator (handle) Notes: While all processes may provide the same value for the 'high' parameter, this requires the MPI implementation to determine which group of processes should be ranked first. .N ThreadSafe .N Fortran Algorithm: .Eb .i Allocate contexts .i Local and remote group leaders swap high values .i Determine the high value. .i Merge the two groups and make the intra-communicator .Ee .N Errors .N MPI_SUCCESS .N MPI_ERR_COMM .N MPI_ERR_EXHAUSTED .seealso: MPI_Intercomm_create, MPI_Comm_free @*/ int MPI_Intercomm_merge(MPI_Comm intercomm, int high, MPI_Comm *newintracomm) { int mpi_errno = MPI_SUCCESS; MPID_Comm *comm_ptr = NULL; MPID_Comm *new_intracomm_ptr; MPID_MPI_STATE_DECL(MPID_STATE_MPI_INTERCOMM_MERGE); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_INTERCOMM_MERGE); /* Validate parameters, especially handles needing to be converted */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_COMM(intercomm, mpi_errno); } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* Convert MPI object handles to object pointers */ MPID_Comm_get_ptr( intercomm, 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, FALSE ); /* If comm_ptr is not valid, it will be reset to null */ if (comm_ptr && comm_ptr->comm_kind != MPID_INTERCOMM) { mpi_errno = MPIR_Err_create_code( MPI_SUCCESS, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_COMM, "**commnotinter", 0 ); } if (mpi_errno) goto fn_fail; } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* Make sure that we have a local intercommunicator */ if (!comm_ptr->local_comm) { /* Manufacture the local communicator */ MPIR_Setup_intercomm_localcomm( comm_ptr ); } # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { int acthigh; MPIR_Errflag_t errflag = MPIR_ERR_NONE; /* Check for consistent valus of high in each local group. The Intel test suite checks for this; it is also an easy error to make */ acthigh = high ? 1 : 0; /* Clamp high into 1 or 0 */ mpi_errno = MPIR_Allreduce_impl( MPI_IN_PLACE, &acthigh, 1, MPI_INT, MPI_SUM, comm_ptr->local_comm, &errflag ); if (mpi_errno) MPIR_ERR_POP(mpi_errno); MPIR_ERR_CHKANDJUMP(errflag, mpi_errno, MPI_ERR_OTHER, "**coll_fail"); /* acthigh must either == 0 or the size of the local comm */ if (acthigh != 0 && acthigh != comm_ptr->local_size) { mpi_errno = MPIR_Err_create_code( MPI_SUCCESS, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_ARG, "**notsame", "**notsame %s %s", "high", "MPI_Intercomm_merge" ); goto fn_fail; } } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_Intercomm_merge_impl(comm_ptr, high, &new_intracomm_ptr); if (mpi_errno) goto fn_fail; MPIR_OBJ_PUBLISH_HANDLE(*newintracomm, new_intracomm_ptr->handle); /* ... end of body of routine ... */ fn_exit: MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_INTERCOMM_MERGE); 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_intercomm_merge", "**mpi_intercomm_merge %C %d %p", intercomm, high, newintracomm); } # endif mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }