int MPI_Comm_get_name(MPI_Comm comm, char *name, int *length)
{
if ( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if ( ompi_comm_invalid ( comm ) )
return OMPI_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
if ( NULL == name || NULL == length )
return OMPI_ERRHANDLER_INVOKE ( comm, MPI_ERR_ARG,
FUNC_NAME);
}
#ifdef USE_MUTEX_FOR_COMMS
OPAL_THREAD_LOCK(&(comm->c_lock));
#endif
if ( comm->c_flags & OMPI_COMM_NAMEISSET ) {
strncpy ( name, comm->c_name, MPI_MAX_OBJECT_NAME );
*length = strlen ( comm->c_name );
}
else {
memset ( name, 0, MPI_MAX_OBJECT_NAME );
*length = 0;
}
#ifdef USE_MUTEX_FOR_COMMS
OPAL_THREAD_UNLOCK(&(comm->c_lock));
#endif
return MPI_SUCCESS;
}
int MPI_Rsend(void *buf, int count, MPI_Datatype type, int dest, int tag, MPI_Comm comm)
{
int rc = MPI_SUCCESS;
if ( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM, FUNC_NAME);
} else if (count < 0) {
rc = MPI_ERR_COUNT;
} else if (type == MPI_DATATYPE_NULL) {
rc = MPI_ERR_TYPE;
} else if (tag < 0 || tag > mca_pml.pml_max_tag) {
rc = MPI_ERR_TAG;
} else if (ompi_comm_peer_invalid(comm, dest) &&
(MPI_PROC_NULL != dest)) {
rc = MPI_ERR_RANK;
} else {
OMPI_CHECK_DATATYPE_FOR_SEND(rc, type, count);
OMPI_CHECK_USER_BUFFER(rc, buf, type, count);
}
OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME);
}
if (MPI_PROC_NULL == dest) {
return MPI_SUCCESS;
}
rc = MCA_PML_CALL(send(buf, count, type, dest, tag,
MCA_PML_BASE_SEND_READY, comm));
OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME);
}
int MPI_Comm_set_name(MPI_Comm comm, char *name)
{
int rc;
if ( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if ( ompi_comm_invalid ( comm ) ) {
return OMPI_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
if ( NULL == name ) {
return OMPI_ERRHANDLER_INVOKE ( comm, MPI_ERR_ARG,
FUNC_NAME);
}
}
rc = ompi_comm_set_name (comm, name );
/* -- Tracing information for new communicator name -- */
#if 0
/* Force TotalView DLL to take note of this name setting */
++ompi_tv_comm_sequence_number;
#endif
#if OMPI_PROFILING_DEFINES
#include "ompi/mpi/c/profile/defines.h"
#endif
OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME);
}
int MPI_Comm_get_info(MPI_Comm comm, MPI_Info *info_used)
{
OPAL_CR_NOOP_PROGRESS();
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (NULL == info_used) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INFO,
FUNC_NAME);
}
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
}
if (NULL == comm->super.s_info) {
/*
* Setup any defaults if MPI_Win_set_info was never called
*/
opal_infosubscribe_change_info(&comm->super, &MPI_INFO_NULL->super);
}
(*info_used) = OBJ_NEW(ompi_info_t);
if (NULL == (*info_used)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_NO_MEM,
FUNC_NAME);
}
opal_info_t *opal_info_used = &(*info_used)->super;
opal_info_dup_mpistandard(comm->super.s_info, &opal_info_used);
return MPI_SUCCESS;
}
int MPI_Comm_set_errhandler(MPI_Comm comm, MPI_Errhandler errhandler)
{
/* Error checking */
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
} else if (NULL == errhandler ||
MPI_ERRHANDLER_NULL == errhandler ||
( OMPI_ERRHANDLER_TYPE_COMM != errhandler->eh_mpi_object_type &&
OMPI_ERRHANDLER_TYPE_PREDEFINED != errhandler->eh_mpi_object_type) ) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG,
FUNC_NAME);
}
}
/* Ditch the old errhandler, and decrement its refcount */
OBJ_RELEASE(comm->error_handler);
/* We have a valid comm and errhandler, so increment its refcount */
comm->error_handler = errhandler;
OBJ_RETAIN(comm->error_handler);
/* All done */
return MPI_SUCCESS;
}
int MPI_File_open(MPI_Comm comm, char *filename, int amode,
MPI_Info info, MPI_File *fh)
{
int rc;
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (NULL == info || ompi_info_is_freed(info)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INFO,
FUNC_NAME);
} else if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
if (OMPI_COMM_IS_INTER(comm)) {
return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM,
FUNC_NAME);
}
}
/* Note that MPI-2:9.7 (p265 in the ps; p261 in the pdf) says that
errors in MPI_FILE_OPEN (before the file handle is created)
should invoke the default error handler on MPI_FILE_NULL.
Hence, if we get a file handle out of ompi_file_open(), invoke
the error handler on that. If not, invoke the error handler on
MPI_FILE_NULL. */
/* The io framework is only initialized lazily. If it hasn't
already been initialized, do so now (note that MPI_FILE_OPEN
and MPI_FILE_DELETE are the only two places that it will be
initialized). */
if (!(mca_io_base_components_opened_valid ||
mca_io_base_components_available_valid)) {
if (OMPI_SUCCESS != (rc = mca_io_base_open())) {
return OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, rc, FUNC_NAME);
}
if (OMPI_SUCCESS !=
(rc = mca_io_base_find_available(OMPI_ENABLE_PROGRESS_THREADS,
OMPI_ENABLE_MPI_THREADS))) {
return OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, rc, FUNC_NAME);
}
}
/* Create an empty MPI_File handle */
*fh = MPI_FILE_NULL;
rc = ompi_file_open(comm, filename, amode, info, fh);
/* Creating the file handle also selects a component to use,
creates a module, and calls file_open() on the module. So
we're good to go. */
OMPI_ERRHANDLER_RETURN(rc, *fh, rc, FUNC_NAME);
}
int MPI_Allgather(void *sendbuf, int sendcount, MPI_Datatype sendtype,
void *recvbuf, int recvcount, MPI_Datatype recvtype,
MPI_Comm comm)
{
int err;
if (MPI_PARAM_CHECK) {
/* Unrooted operation -- same checks for all ranks on both
intracommunicators and intercommunicators */
err = MPI_SUCCESS;
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM, FUNC_NAME);
} else if (MPI_DATATYPE_NULL == recvtype) {
err = MPI_ERR_TYPE;
} else if (recvcount < 0) {
err = MPI_ERR_COUNT;
} else if (MPI_IN_PLACE == recvbuf) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME);
} else if (MPI_IN_PLACE != sendbuf) {
OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount);
}
OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME);
}
/* Do we need to do anything? Everyone had to give the same send
signature, which means that everyone must have given a
sendcount > 0 if there's anything to send. If we're doing
IN_PLACE, however, check recvcount, not sendcount. */
if ((MPI_IN_PLACE != sendbuf && 0 == sendcount) ||
(0 == recvcount)) {
return MPI_SUCCESS;
}
/* Invoke the coll component to perform the back-end operation */
err = comm->c_coll.coll_allgather(sendbuf, sendcount, sendtype,
recvbuf, recvcount, recvtype, comm);
OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME);
}
int MPI_Ssend_init(void *buf, int count, MPI_Datatype type,
int dest, int tag, MPI_Comm comm,
MPI_Request *request)
{
int rc;
if ( MPI_PARAM_CHECK ) {
rc = MPI_SUCCESS;
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM, FUNC_NAME);
} else if (count < 0) {
rc = MPI_ERR_COUNT;
} else if (type == MPI_DATATYPE_NULL) {
rc = MPI_ERR_TYPE;
} else if (tag < 0 || tag > mca_pml.pml_max_tag) {
rc = MPI_ERR_TAG;
} else if (ompi_comm_peer_invalid(comm, dest) &&
(MPI_PROC_NULL != dest)) {
rc = MPI_ERR_RANK;
} else if (request == NULL) {
rc = MPI_ERR_REQUEST;
}
OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME);
}
if (MPI_PROC_NULL == dest) {
*request = OBJ_NEW(ompi_request_t);
/* Other fields were initialized by the constructor for
ompi_request_t */
(*request)->req_type = OMPI_REQUEST_NOOP;
(*request)->req_status = ompi_request_empty.req_status;
(*request)->req_complete = true;
(*request)->req_state = OMPI_REQUEST_INACTIVE;
(*request)->req_persistent = true;
(*request)->req_free = ompi_request_persistent_proc_null_free;
return MPI_SUCCESS;
}
rc = MCA_PML_CALL(isend_init(buf,count,type,dest,tag,
MCA_PML_BASE_SEND_SYNCHRONOUS,comm,request));
OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME);
}
int MPI_Comm_set_info(MPI_Comm comm, MPI_Info info)
{
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (NULL == info || MPI_INFO_NULL == info ||
ompi_info_is_freed(info)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INFO,
FUNC_NAME);
}
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
}
/* At the moment, we do not support any communicator hints.
So... do nothing */
return MPI_SUCCESS;
}
int MPI_Win_create(void *base, MPI_Aint size, int disp_unit,
MPI_Info info, MPI_Comm comm, MPI_Win *win)
{
int ret = MPI_SUCCESS;
/* argument checking */
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid (comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
} else if (NULL == info || ompi_info_is_freed(info)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_INFO,
FUNC_NAME);
} else if (NULL == win) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_WIN, FUNC_NAME);
} else if ( size < 0 ) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_SIZE, FUNC_NAME);
} else if ( disp_unit <= 0 ) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_DISP, FUNC_NAME);
}
}
/* communicator must be an intracommunicator */
if (OMPI_COMM_IS_INTER(comm)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COMM, FUNC_NAME);
}
/* create window and return */
ret = ompi_win_create(base, (size_t)size, disp_unit, comm,
info, win);
if (OMPI_SUCCESS != ret) {
*win = MPI_WIN_NULL;
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_WIN, FUNC_NAME);
}
return MPI_SUCCESS;
}
int MPI_Comm_dup(MPI_Comm comm, MPI_Comm *newcomm)
{
int rc=MPI_SUCCESS;
/* argument checking */
if ( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid (comm))
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
if ( NULL == newcomm )
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG,
FUNC_NAME);
}
rc = ompi_comm_dup ( comm, newcomm);
OMPI_ERRHANDLER_RETURN ( rc, comm, rc, FUNC_NAME);
}
int MPI_Comm_group(MPI_Comm comm, MPI_Group *group) {
int rc;
/* argument checking */
if ( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if ( ompi_comm_invalid (comm) )
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
if ( NULL == group )
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG,
FUNC_NAME);
} /* end if ( MPI_PARAM_CHECK) */
rc = ompi_comm_group ( (ompi_communicator_t*)comm, (ompi_group_t**)group );
OMPI_ERRHANDLER_RETURN ( rc, comm, rc, FUNC_NAME);
}
int MPI_Comm_create(MPI_Comm comm, MPI_Group group, MPI_Comm *newcomm) {
int rc;
if ( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid (comm))
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
if ( MPI_GROUP_NULL == group )
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_GROUP,
FUNC_NAME);
if ( NULL == newcomm )
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG,
FUNC_NAME);
}
rc = ompi_comm_create ( (ompi_communicator_t*)comm, (ompi_group_t*)group,
(ompi_communicator_t**)newcomm );
OMPI_ERRHANDLER_RETURN ( rc, comm, rc, FUNC_NAME);
}
int MPI_Scatterv(void *sendbuf, int *sendcounts, int *displs,
MPI_Datatype sendtype, void *recvbuf, int recvcount,
MPI_Datatype recvtype, int root, MPI_Comm comm)
{
int i, size, err;
if (MPI_PARAM_CHECK) {
err = MPI_SUCCESS;
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
} else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == recvbuf) ||
(ompi_comm_rank(comm) == root && MPI_IN_PLACE == sendbuf)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME);
}
/* Errors for intracommunicators */
if (OMPI_COMM_IS_INTRA(comm)) {
/* Errors for all ranks */
if ((root >= ompi_comm_size(comm)) || (root < 0)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME);
}
if (MPI_IN_PLACE != recvbuf) {
if (recvcount < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT,
FUNC_NAME);
}
if (MPI_DATATYPE_NULL == recvtype) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE,
FUNC_NAME);
}
}
/* Errors for the root. Some of these could have been
combined into compound if statements above, but since
this whole section can be compiled out (or turned off at
run time) for efficiency, it's more clear to separate
them out into individual tests. */
if (ompi_comm_rank(comm) == root) {
if (NULL == displs) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME);
}
if (NULL == sendcounts) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
size = ompi_comm_size(comm);
for (i = 0; i < size; ++i) {
OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]);
OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME);
}
}
}
/* Errors for intercommunicators */
else {
if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) ||
MPI_ROOT == root || MPI_PROC_NULL == root)) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME);
}
/* Errors for the receivers */
if (MPI_ROOT != root && MPI_PROC_NULL != root) {
if (recvcount < 0) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
if (MPI_DATATYPE_NULL == recvtype) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME);
}
}
/* Errors for the root. Ditto on the comment above -- these
error checks could have been combined above, but let's
make the code easier to read. */
else if (MPI_ROOT == root) {
if (NULL == displs) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME);
}
if (NULL == sendcounts) {
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME);
}
size = ompi_comm_size(comm);
for (i = 0; i < size; ++i) {
OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]);
OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME);
}
}
}
}
/* Invoke the coll component to perform the back-end operation */
err = comm->c_coll.coll_scatterv(sendbuf, sendcounts, displs, sendtype,
recvbuf, recvcount, recvtype, root, comm);
OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME);
}
int MPI_Sendrecv_replace(void * buf, int count, MPI_Datatype datatype,
int dest, int sendtag, int source, int recvtag,
MPI_Comm comm, MPI_Status *status)
{
int rc = MPI_SUCCESS;
if ( MPI_PARAM_CHECK ) {
rc = MPI_SUCCESS;
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count);
if (ompi_comm_invalid(comm)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM, FUNC_NAME);
} else if (dest != MPI_PROC_NULL && ompi_comm_peer_invalid(comm, dest)) {
rc = MPI_ERR_RANK;
} else if (sendtag < 0 || sendtag > mca_pml.pml_max_tag) {
rc = MPI_ERR_TAG;
} else if (source != MPI_PROC_NULL && source != MPI_ANY_SOURCE && ompi_comm_peer_invalid(comm, source)) {
rc = MPI_ERR_RANK;
} else if (((recvtag < 0) && (recvtag != MPI_ANY_TAG)) || (recvtag > mca_pml.pml_max_tag)) {
rc = MPI_ERR_TAG;
}
OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME);
}
/* simple case */
if ( source == MPI_PROC_NULL || dest == MPI_PROC_NULL || count == 0 ) {
return MPI_Sendrecv(buf,count,datatype,dest,sendtag,buf,count,datatype,source,recvtag,comm,status);
} else {
ompi_convertor_t convertor;
struct iovec iov;
unsigned char recv_data[2048];
size_t packed_size, max_data;
uint32_t iov_count;
ompi_status_public_t recv_status;
ompi_proc_t* proc = ompi_comm_peer_lookup(comm,dest);
if(proc == NULL) {
rc = MPI_ERR_RANK;
OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME);
}
/* initialize convertor to unpack recv buffer */
OBJ_CONSTRUCT(&convertor, ompi_convertor_t);
ompi_convertor_copy_and_prepare_for_recv( proc->proc_convertor, datatype,
count, buf, 0, &convertor );
/* setup a buffer for recv */
ompi_convertor_get_packed_size( &convertor, &packed_size );
if( packed_size > sizeof(recv_data) ) {
rc = MPI_Alloc_mem(packed_size, MPI_INFO_NULL, &iov.iov_base);
if(OMPI_SUCCESS != rc) {
OMPI_ERRHANDLER_RETURN(OMPI_ERR_OUT_OF_RESOURCE, comm, MPI_ERR_BUFFER, FUNC_NAME);
}
} else {
iov.iov_base = (caddr_t)recv_data;
}
/* recv into temporary buffer */
rc = MPI_Sendrecv( buf, count, datatype, dest, sendtag, iov.iov_base, packed_size,
MPI_BYTE, source, recvtag, comm, &recv_status );
if (rc != MPI_SUCCESS) {
if(packed_size > sizeof(recv_data))
MPI_Free_mem(iov.iov_base);
OBJ_DESTRUCT(&convertor);
OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME);
}
/* unpack into users buffer */
iov.iov_len = recv_status._count;
iov_count = 1;
max_data = recv_status._count;
ompi_convertor_unpack(&convertor, &iov, &iov_count, &max_data );
/* return status to user */
if(status != MPI_STATUS_IGNORE) {
*status = recv_status;
}
/* release resources */
if(packed_size > sizeof(recv_data)) {
MPI_Free_mem(iov.iov_base);
}
OBJ_DESTRUCT(&convertor);
return MPI_SUCCESS;
}
}
int MPI_Comm_compare(MPI_Comm comm1, MPI_Comm comm2, int *result) {
/* local variables */
ompi_communicator_t *comp1, *comp2;
ompi_group_t *group1, *group2;
int size1, size2, rsize1, rsize2;
int lresult, rresult=MPI_CONGRUENT;
int sameranks=1;
int sameorder=1;
int i, j;
int found = 0;
if ( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (ompi_comm_invalid(comm1) || ompi_comm_invalid(comm2)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
FUNC_NAME);
}
if ( NULL == result ) {
return OMPI_ERRHANDLER_INVOKE(comm1, MPI_ERR_ARG,
FUNC_NAME);
}
}
comp1 = (ompi_communicator_t *) comm1;
comp2 = (ompi_communicator_t *) comm2;
if ( comp1->c_contextid == comp2->c_contextid ) {
*result = MPI_IDENT;
return MPI_SUCCESS;
}
if ( MPI_COMM_NULL == comm1 || MPI_COMM_NULL == comm2 ) {
*result = MPI_UNEQUAL;
return MPI_SUCCESS;
}
/* compare sizes of local and remote groups */
size1 = ompi_comm_size (comp1);
size2 = ompi_comm_size (comp2);
rsize1 = ompi_comm_remote_size (comp1);
rsize2 = ompi_comm_remote_size (comp2);
if ( size1 != size2 || rsize1 != rsize2 ) {
*result = MPI_UNEQUAL;
return MPI_SUCCESS;
}
/* Compare local groups */
/* we need to check whether the communicators contain
the same processes and in the same order */
group1 = (ompi_group_t *)comp1->c_local_group;
group2 = (ompi_group_t *)comp2->c_local_group;
for ( i = 0; i < size1; i++ ) {
if ( group1->grp_proc_pointers[i] != group2->grp_proc_pointers[i]) {
sameorder = 0;
break;
}
}
for ( i = 0; i < size1; i++ ) {
found = 0;
for ( j = 0; j < size2; j++ ) {
if ( group1->grp_proc_pointers[i] == group2->grp_proc_pointers[j]) {
found = 1;
break;
}
}
if ( !found ) {
sameranks = 0;
break;
}
}
if ( sameranks && sameorder )
lresult = MPI_CONGRUENT;
else if ( sameranks && !sameorder )
lresult = MPI_SIMILAR;
else
lresult = MPI_UNEQUAL;
if ( rsize1 > 0 ) {
/* Compare remote groups for inter-communicators */
/* we need to check whether the communicators contain
the same processes and in the same order */
sameranks = sameorder = 1;
group1 = (ompi_group_t *)comp1->c_remote_group;
group2 = (ompi_group_t *)comp2->c_remote_group;
for ( i = 0; i < rsize1; i++ ) {
if ( group1->grp_proc_pointers[i] != group2->grp_proc_pointers[i]) {
sameorder = 0;
break;
}
}
for ( i = 0; i < rsize1; i++ ) {
found = 0;
for ( j = 0; j < rsize2; j++ ) {
if ( group1->grp_proc_pointers[i] == group2->grp_proc_pointers[j]) {
found = 1;
break;
}
}
if ( !found ) {
sameranks = 0;
break;
}
}
if ( sameranks && sameorder )
rresult = MPI_CONGRUENT;
else if ( sameranks && !sameorder )
rresult = MPI_SIMILAR;
else
rresult = MPI_UNEQUAL;
}
/* determine final results */
if ( MPI_CONGRUENT == rresult ) {
*result = lresult;
}
else if ( MPI_SIMILAR == rresult ) {
if ( MPI_SIMILAR == lresult || MPI_CONGRUENT == lresult ) {
*result = MPI_SIMILAR;
}
else
*result = MPI_UNEQUAL;
}
else if ( MPI_UNEQUAL == rresult )
*result = MPI_UNEQUAL;
return MPI_SUCCESS;
}