diff --git a/src/mpi/c/comm_compare.c b/src/mpi/c/comm_compare.c index 61bb8bc9dd..76b7bbefa8 100644 --- a/src/mpi/c/comm_compare.c +++ b/src/mpi/c/comm_compare.c @@ -5,12 +5,139 @@ #include #include "mpi.h" +#include "runtime/runtime.h" #include "mpi/c/bindings.h" +#include "communicator/communicator.h" #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES #pragma weak MPI_Comm_compare = PMPI_Comm_compare #endif int MPI_Comm_compare(MPI_Comm comm1, MPI_Comm comm2, int *result) { + + /* local variables */ + lam_communicator_t *comp1, *comp2; + lam_group_t *grp1, *grp2; + int size1, size2, rsize1, rsize2; + int lresult, rresult; + int sameranks = 1; + int sameorder = 1; + int i, j; + int found = 0; + + if ( MPI_PARAM_CHECK ) { + if ( lam_mpi_finalized ) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INTERN, + "MPI_Comm_compare"); + + if ( MPI_COMM_NULL == comm1 || MPI_COMM_NULL == comm2 || + lam_comm_invalid ( comm1 ) || lam_comm_invalid (comm2) ) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM, + "MPI_Comm_compare"); + + if ( NULL == result ) + return LAM_ERRHANDLER_INVOKE(comm1, MPI_ERR_ARG, + "MPI_Comm_compare"); + } + + comp1 = (lam_communicator_t *) comm1; + comp2 = (lam_communicator_t *) comm2; + + /* compare sizes of local and remote groups */ + size1 = lam_comm_size (comp1); + size2 = lam_comm_size (comp1); + rsize1 = lam_comm_remote_size (comp1); + rsize2 = lam_comm_remote_size (comp1); + + 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 */ + grp1 = (lam_group_t *)comp1->c_local_group; + grp2 = (lam_group_t *)comp2->c_local_group; + for ( i = 0; i < size1; i++ ) { + if ( grp1->grp_proc_pointers[i] != grp2->grp_proc_pointers[i]) { + sameorder = 0; + break; + } + } + + for ( i = 0; i < size1; i++ ) { + found = 0; + for ( j = 0; j < size2; j++ ) { + if ( grp1->grp_proc_pointers[i] == grp2->grp_proc_pointers[j]) { + found = 1; + break; + } + } + if ( !found ) { + sameranks = 0; + break; + } + } + + if ( sameranks && sameorder ) + lresult = MPI_SIMILAR; + else if ( sameranks && !sameorder ) + lresult = MPI_CONGRUENT; + 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; + rresult = MPI_SIMILAR; + + grp1 = (lam_group_t *)comp1->c_remote_group; + grp2 = (lam_group_t *)comp2->c_remote_group; + for ( i = 0; i < rsize1; i++ ) { + if ( grp1->grp_proc_pointers[i] != grp2->grp_proc_pointers[i]) { + sameorder = 0; + break; + } + } + + for ( i = 0; i < size1; i++ ) { + found = 0; + for ( j = 0; j < size2; j++ ) { + if ( grp1->grp_proc_pointers[i] == grp2->grp_proc_pointers[j]) { + found = 1; + break; + } + } + if ( !found ) { + sameranks = 0; + break; + } + } + + if ( sameranks && sameorder ) + rresult = MPI_SIMILAR; + else if ( sameranks && !sameorder ) + rresult = MPI_CONGRUENT; + else + rresult = MPI_UNEQUAL; + } + + /* determine final results */ + if ( MPI_SIMILAR == rresult ) { + *result = lresult; + } + else if ( MPI_CONGRUENT == rresult ) { + if ( MPI_SIMILAR == lresult ) + *result = MPI_CONGRUENT; + else + *result = MPI_SIMILAR; + } + else if ( MPI_UNEQUAL == rresult ) + *result = MPI_UNEQUAL; + return MPI_SUCCESS; } diff --git a/src/mpi/c/comm_create.c b/src/mpi/c/comm_create.c index 3a54c75821..07b14e5dee 100644 --- a/src/mpi/c/comm_create.c +++ b/src/mpi/c/comm_create.c @@ -6,11 +6,35 @@ #include "mpi.h" #include "mpi/c/bindings.h" +#include "runtime/runtime.h" +#include "communicator/communicator.h" #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES #pragma weak MPI_Comm_create = PMPI_Comm_create #endif int MPI_Comm_create(MPI_Comm comm, MPI_Group group, MPI_Comm *newcomm) { - return MPI_SUCCESS; + + int rc; + + if ( MPI_PARAM_CHECK ) { + if ( lam_mpi_finalized ) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INTERN, + "MPI_Comm_create"); + + if ( MPI_COMM_NULL == comm || lam_comm_invalid (comm)) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM, + "MPI_Comm_create"); + + if ( MPI_GROUP_NULL == group ) + return LAM_ERRHANDLER_INVOKE(comm, MPI_ERR_GROUP, + "MPI_Comm_create"); + + if ( NULL == newcomm ) + return LAM_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + "MPI_Comm_create"); + } + + rc = lam_comm_create ( comm, group, newcomm ); + LAM_ERRHANDLER_RETURN ( rc, comm, rc, "MPI_Comm_create"); } diff --git a/src/mpi/c/comm_dup.c b/src/mpi/c/comm_dup.c index 70eaa5a620..64d55afa16 100644 --- a/src/mpi/c/comm_dup.c +++ b/src/mpi/c/comm_dup.c @@ -3,14 +3,85 @@ */ #include "lam_config.h" #include +#include #include "mpi.h" #include "mpi/c/bindings.h" +#include "runtime/runtime.h" +#include "communicator/communicator.h" #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES #pragma weak MPI_Comm_dup = PMPI_Comm_dup #endif int MPI_Comm_dup(MPI_Comm comm, MPI_Comm *newcomm) { + + /* local variables */ + lam_communicator_t *comp, *newcomp; + int rc; + + /* argument checking */ + if ( MPI_PARAM_CHECK ) { + if (lam_mpi_finalized) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INTERN, + "MPI_Comm_dup"); + + if (MPI_COMM_NULL == comm || lam_comm_invalid (comm)) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM, + "MPI_Comm_dup"); + + if ( NULL == newcomm ) + return LAM_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + "MPI_Comm_dup"); + } + + comp = (lam_communicator_t *) comm; + /* This routine allocates an element, allocates the according groups, + sets the f2c handle and increases the reference counters of + comm, group and remote_group */ + newcomp = lam_comm_allocate (comp->c_local_group->grp_proc_count, + comp->c_remote_group->grp_proc_count ); + + /* copy local group */ + newcomp->c_local_group->grp_my_rank = comp->c_local_group->grp_my_rank; + memcpy (newcomp->c_local_group->grp_proc_pointers, + comp->c_local_group->grp_proc_pointers, + comp->c_local_group->grp_proc_count * sizeof(lam_proc_t *)); + lam_group_increment_proc_count(newcomp->c_local_group); + + if ( comp->c_flags & LAM_COMM_INTER ) { + /* copy remote group */ + memcpy (newcomp->c_remote_group->grp_proc_pointers, + comp->c_remote_group->grp_proc_pointers, + comp->c_remote_group->grp_proc_count * sizeof(lam_proc_t *)); + lam_group_increment_proc_count(newcomp->c_remote_group); + + /* Get new context id */ + newcomp->c_contextid = lam_comm_nextcid (comm, LAM_COMM_INTER_INTER); + } + else { + /* Get new context id */ + newcomp->c_contextid = lam_comm_nextcid (comm, LAM_COMM_INTRA_INTRA); + } + + /* other fields */ + newcomp->c_my_rank = comp->c_my_rank; + newcomp->c_flags = comp->c_flags; + + + /* Copy topology information */ + + + /* Copy error handler */ + newcomp->error_handler = comp->error_handler; + OBJ_RETAIN ( comp->error_handler ); + + /* Copy attributes */ + rc = lam_attr_copy_all ( COMM_ATTR, comp, newcomp ); + if ( rc != LAM_SUCCESS ) { + lam_comm_free ( (MPI_Comm *)newcomp ); + return LAM_ERRHANDLER_INVOKE ( comm, rc, "MPI_Comm_dup"); + } + return MPI_SUCCESS; } diff --git a/src/mpi/c/comm_free.c b/src/mpi/c/comm_free.c index 2ecba560db..1a834a1752 100644 --- a/src/mpi/c/comm_free.c +++ b/src/mpi/c/comm_free.c @@ -6,11 +6,32 @@ #include "mpi.h" #include "mpi/c/bindings.h" +#include "runtime/runtime.h" +#include "communicator/communicator.h" #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES #pragma weak MPI_Comm_free = PMPI_Comm_free #endif int MPI_Comm_free(MPI_Comm *comm) { + + if ( MPI_PARAM_CHECK ) { + if (lam_mpi_finalized ) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INTERN, + "MPI_Comm_free"); + + if ( NULL == *comm || MPI_COMM_WORLD == *comm || + MPI_COMM_SELF == *comm || lam_comm_invalid (*comm)) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM, + "MPI_Comm_free"); + } + + /* Call attribute delete functions */ + + /* free the object */ + + lam_comm_free ( (lam_communicator_t *) comm ); + + *comm = MPI_COMM_NULL; return MPI_SUCCESS; } diff --git a/src/mpi/c/comm_get_name.c b/src/mpi/c/comm_get_name.c index 428e1275ff..e12b299c37 100644 --- a/src/mpi/c/comm_get_name.c +++ b/src/mpi/c/comm_get_name.c @@ -10,14 +10,38 @@ #include "include/totalview.h" #include "mpi.h" #include "mpi/c/bindings.h" +#include "runtime/runtime.h" #include "communicator/communicator.h" #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES #pragma weak MPI_Comm_get_name = PMPI_Comm_get_name #endif -int -MPI_Comm_get_name(MPI_Comm a, char *b, int *c) -{ - return MPI_ERR_UNKNOWN; +int MPI_Comm_get_name(MPI_Comm comm, char *name, int *length) { + + if ( MPI_PARAM_CHECK ) { + if ( lam_mpi_finalized ) + return LAM_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_INTERN, + "MPI_Comm_get_name"); + + if ( MPI_COMM_NULL == comm || lam_comm_invalid ( comm ) ) + return LAM_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_COMM, + "MPI_Comm_get_name"); + + if ( NULL == name || NULL == length ) + return LAM_ERRHANDLER_INVOKE ( comm, MPI_ERR_ARG, + "MPI_Comm_get_name"); + } + + + if ( comm->c_flags & LAM_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; + } + + return MPI_SUCCESS; } diff --git a/src/mpi/c/comm_group.c b/src/mpi/c/comm_group.c index 4b053f7d51..cf39747f0a 100644 --- a/src/mpi/c/comm_group.c +++ b/src/mpi/c/comm_group.c @@ -6,11 +6,33 @@ #include "mpi.h" #include "mpi/c/bindings.h" +#include "runtime/runtime.h" +#include "communicator/communicator.h" #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES #pragma weak MPI_Comm_group = PMPI_Comm_group #endif int MPI_Comm_group(MPI_Comm comm, MPI_Group *group) { - return MPI_SUCCESS; + + int rc; + + /* argument checking */ + if ( MPI_PARAM_CHECK ) { + if ( lam_mpi_finalized ) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INTERN, + "MPI_Comm_group"); + + if ( MPI_COMM_NULL == comm || lam_comm_invalid (comm) ) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM, + "MPI_Comm_group"); + + if ( NULL == group ) + return LAM_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + "MPI_Comm_group"); + } /* end if ( MPI_PARAM_CHECK) */ + + + rc = lam_comm_group ( comm, group ); + LAM_ERRHANDLER_RETURN ( rc, comm, rc, "MPI_Comm_group"); } diff --git a/src/mpi/c/comm_rank.c b/src/mpi/c/comm_rank.c index 3e792795a8..206b79cd28 100644 --- a/src/mpi/c/comm_rank.c +++ b/src/mpi/c/comm_rank.c @@ -5,6 +5,7 @@ #include #include "mpi.h" +#include "runtime/runtime.h" #include "mpi/c/bindings.h" #include "communicator/communicator.h" @@ -14,6 +15,21 @@ int MPI_Comm_rank(MPI_Comm comm, int *rank) { + + if ( MPI_PARAM_CHECK ) { + if ( lam_mpi_finalized ) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INTERN, + "MPI_Comm_rank"); + + if ( MPI_COMM_NULL == comm || lam_comm_invalid (comm)) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM, + "MPI_Comm_rank"); + + if ( NULL == rank ) + return LAM_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + "MPI_Comm_rank"); + } + *rank = lam_comm_rank(comm); return MPI_SUCCESS; } diff --git a/src/mpi/c/comm_remote_group.c b/src/mpi/c/comm_remote_group.c index 78602a5c51..4bc38f95d6 100644 --- a/src/mpi/c/comm_remote_group.c +++ b/src/mpi/c/comm_remote_group.c @@ -3,9 +3,13 @@ */ #include "lam_config.h" #include +#include #include "mpi.h" #include "mpi/c/bindings.h" +#include "runtime/runtime.h" +#include "communicator/communicator.h" + #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES #pragma weak MPI_Comm_remote_group = PMPI_Comm_remote_group @@ -13,5 +17,44 @@ int MPI_Comm_remote_group(MPI_Comm comm, MPI_Group *group) { + + lam_communicator_t *comp; + lam_group_t *group_p; + + if ( MPI_PARAM_CHECK ) { + if ( lam_mpi_finalized ) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INTERN, + "MPI_Comm_remote_group"); + + if (MPI_COMM_NULL == comm || lam_comm_invalid (comm)) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM, + "MPI_Comm_remote_group"); + + if ( NULL == group ) + return LAM_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + "MPI_Comm_remote_group"); + } + + comp = (lam_communicator_t *) comm; + if ( comp->c_flags & LAM_COMM_INTER ) { + /* get new group struct */ + group_p=lam_group_allocate(comp->c_remote_group->grp_proc_count); + if( NULL == group_p ) { + return LAM_ERRHANDLER_INVOKE (comm, MPI_ERR_INTERN, + "MPI_Comm_remote_group"); + } + + group_p->grp_my_rank = MPI_UNDEFINED; + memcpy ( group_p->grp_proc_pointers, + comp->c_remote_group->grp_proc_pointers, + group_p->grp_proc_count * sizeof ( lam_proc_t *)); + /* increment proc reference counters */ + lam_group_increment_proc_count(group_p); + } + else + return LAM_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, + "MPI_Comm_remote_group"); + + *group = (MPI_Group) group_p; return MPI_SUCCESS; } diff --git a/src/mpi/c/comm_remote_size.c b/src/mpi/c/comm_remote_size.c index bae449b859..ab21dedfc8 100644 --- a/src/mpi/c/comm_remote_size.c +++ b/src/mpi/c/comm_remote_size.c @@ -6,6 +6,8 @@ #include "mpi.h" #include "mpi/c/bindings.h" +#include "runtime/runtime.h" +#include "communicator/communicator.h" #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES #pragma weak MPI_Comm_remote_size = PMPI_Comm_remote_size @@ -13,5 +15,21 @@ int MPI_Comm_remote_size(MPI_Comm comm, int *size) { + + if ( MPI_PARAM_CHECK ) { + if ( lam_mpi_finalized ) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INTERN, + "MPI_Comm_remote_size"); + + if (MPI_COMM_NULL == comm || lam_comm_invalid (comm)) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM, + "MPI_Comm_remote_size"); + + if ( NULL == size ) + return LAM_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + "MPI_Comm_remote_size"); + } + + *size = lam_comm_remote_size (comm); return MPI_SUCCESS; } diff --git a/src/mpi/c/comm_set_name.c b/src/mpi/c/comm_set_name.c index 583f20a00b..00bf8e9d9c 100644 --- a/src/mpi/c/comm_set_name.c +++ b/src/mpi/c/comm_set_name.c @@ -10,32 +10,38 @@ #include "include/totalview.h" #include "mpi.h" #include "mpi/c/bindings.h" +#include "runtime/runtime.h" #include "communicator/communicator.h" #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES #pragma weak MPI_Comm_set_name = PMPI_Comm_set_name #endif -int -MPI_Comm_set_name(MPI_Comm comm, char *name) -{ - if (comm == MPI_COMM_NULL) { - /* -- Invoke error function -- */ - } - - if (name == NULL) { - /* -- Invoke error function -- */ - } +int MPI_Comm_set_name(MPI_Comm comm, char *name) { - /* -- Thread safety entrance -- */ - /* Copy in the name */ - - strncpy(comm->c_name, name, MPI_MAX_OBJECT_NAME); - comm->c_name[MPI_MAX_OBJECT_NAME - 1] = 0; + if ( MPI_PARAM_CHECK ) { + if ( lam_mpi_finalized ) + return LAM_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_INTERN, + "MPI_Comm_set_name"); - /* -- Tracing information for new communicator name -- */ + if ( MPI_COMM_NULL == comm || lam_comm_invalid ( comm ) ) + return LAM_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_COMM, + "MPI_Comm_set_name"); + if ( NULL == name ) + return LAM_ERRHANDLER_INVOKE ( comm, MPI_ERR_ARG, + "MPI_Comm_set_name"); + } + + /* -- Thread safety entrance -- */ + + /* Copy in the name */ + strncpy(comm->c_name, name, MPI_MAX_OBJECT_NAME); + comm->c_name[MPI_MAX_OBJECT_NAME - 1] = 0; + comm->c_flags |= LAM_COMM_NAMEISSET; + + /* -- Tracing information for new communicator name -- */ #if 0 /* Force TotalView DLL to take note of this name setting */ diff --git a/src/mpi/c/comm_size.c b/src/mpi/c/comm_size.c index 127ea93fc0..c1e23e2e61 100644 --- a/src/mpi/c/comm_size.c +++ b/src/mpi/c/comm_size.c @@ -5,6 +5,7 @@ #include #include "mpi.h" +#include "runtime/runtime.h" #include "mpi/c/bindings.h" #include "communicator/communicator.h" @@ -13,6 +14,20 @@ #endif int MPI_Comm_size(MPI_Comm comm, int *size) { + + if ( MPI_PARAM_CHECK ) { + if ( lam_mpi_finalized ) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, + MPI_ERR_INTERN, "MPI_Comm_size"); + + if ( MPI_COMM_NULL == comm || lam_comm_invalid (comm)) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, + MPI_ERR_COMM, "MPI_Comm_size"); + + if ( NULL == size ) + return LAM_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, "MPI_Comm_size"); + } + *size = lam_comm_size(comm); return MPI_SUCCESS; } diff --git a/src/mpi/c/comm_split.c b/src/mpi/c/comm_split.c index 43d66cf306..8dfedb92fd 100644 --- a/src/mpi/c/comm_split.c +++ b/src/mpi/c/comm_split.c @@ -6,11 +6,35 @@ #include "mpi.h" #include "mpi/c/bindings.h" +#include "runtime/runtime.h" +#include "communicator/communicator.h" #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES #pragma weak MPI_Comm_split = PMPI_Comm_split #endif int MPI_Comm_split(MPI_Comm comm, int color, int key, MPI_Comm *newcomm) { - return MPI_SUCCESS; + + int rc; + + if ( MPI_PARAM_CHECK ) { + if ( lam_mpi_finalized ) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INTERN, + "MPI_Comm_split"); + + if ( comm == MPI_COMM_NULL || lam_comm_invalid ( comm )) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM, + "MPI_Comm_split"); + + if ( color < 0 && MPI_UNDEFINED != color ) + return LAM_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + "MPI_Comm_split"); + + if ( NULL == newcomm ) + return LAM_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + "MPI_Comm_split"); + } + + rc = lam_comm_split ( comm, color, key, newcomm ); + LAM_ERRHANDLER_RETURN ( rc, comm, rc, "MPI_Comm_split"); } diff --git a/src/mpi/c/comm_test_inter.c b/src/mpi/c/comm_test_inter.c index 4d4c8a385a..42471228f4 100644 --- a/src/mpi/c/comm_test_inter.c +++ b/src/mpi/c/comm_test_inter.c @@ -6,11 +6,29 @@ #include "mpi.h" #include "mpi/c/bindings.h" +#include "runtime/runtime.h" +#include "communicator/communicator.h" #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES #pragma weak MPI_Comm_test_inter = PMPI_Comm_test_inter #endif int MPI_Comm_test_inter(MPI_Comm comm, int *flag) { + + if ( MPI_PARAM_CHECK ) { + if (lam_mpi_finalized ) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INTERN, + "MPI_Comm_test_inter"); + + if ( MPI_COMM_NULL == comm || lam_comm_invalid ( comm ) ) + return LAM_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_COMM, + "MPI_Comm_test_inter"); + + if ( NULL == flag ) + return LAM_ERRHANDLER_INVOKE ( comm, MPI_ERR_ARG, + "MPI_Comm_test_inter"); + } + + *flag = (comm->c_flags & LAM_COMM_INTER); return MPI_SUCCESS; } diff --git a/src/mpi/c/intercomm_create.c b/src/mpi/c/intercomm_create.c index ddb221850f..1fb6df1643 100644 --- a/src/mpi/c/intercomm_create.c +++ b/src/mpi/c/intercomm_create.c @@ -6,6 +6,9 @@ #include "mpi.h" #include "mpi/c/bindings.h" +#include "runtime/runtime.h" +#include "communicator/communicator.h" + #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES #pragma weak MPI_Intercomm_create = PMPI_Intercomm_create @@ -14,5 +17,49 @@ int MPI_Intercomm_create(MPI_Comm local_comm, int local_leader, MPI_Comm bridge_comm, int remote_leader, int tag, MPI_Comm *newintercomm) { + + int local_size, local_rank; + + if ( MPI_PARAM_CHECK ) { + if ( lam_mpi_finalized ) + return LAM_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_INTERN, + "MPI_Intercomm_create"); + + if ( MPI_COMM_NULL == local_comm || lam_comm_invalid ( local_comm ) || + ( local_comm->c_flags & LAM_COMM_INTER ) ) + return LAM_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_COMM, + "MPI_Intercomm_create"); + + if ( NULL == newintercomm ) + return LAM_ERRHANDLER_INVOKE ( local_comm, MPI_ERR_ARG, + "MPI_Intercomm_create"); + + if ( tag < 0 || tag > MPI_TAG_UB ) + return LAM_ERRHANDLER_INVOKE ( local_comm, MPI_ERR_ARG, + "MPI_Intercomm_create"); + } + + local_size = lam_comm_size ( local_comm ); + local_rank = lam_comm_size ( local_comm ); + + if ( MPI_PARAM_CHECK ) { + if ( local_leader < 0 || local_leader > local_size ) + return LAM_ERRHANDLER_INVOKE ( local_comm, MPI_ERR_ARG, + "MPI_Intercomm_create"); + + /* remember that the remote_leader and bridge_comm arguments + just have to be valid at the local_leader */ + if ( local_rank == local_leader ) { + if ( MPI_COMM_NULL == bridge_comm || lam_comm_invalid ( bridge_comm) || + bridge_comm->c_flags & LAM_COMM_INTER ) + return LAM_ERRHANDLER_INVOKE ( local_comm, MPI_ERR_COMM, + "MPI_Intercomm_create"); + + if ( remote_leader < 0 || remote_leader > lam_comm_size(bridge_comm)) + return LAM_ERRHANDLER_INVOKE ( local_comm, MPI_ERR_ARG, + "MPI_Intercomm_create"); + } /* if ( local_rank == local_leader ) */ + } + return MPI_SUCCESS; } diff --git a/src/mpi/c/intercomm_merge.c b/src/mpi/c/intercomm_merge.c index ca2aa7417f..7983685948 100644 --- a/src/mpi/c/intercomm_merge.c +++ b/src/mpi/c/intercomm_merge.c @@ -6,12 +6,31 @@ #include "mpi.h" #include "mpi/c/bindings.h" +#include "runtime/runtime.h" +#include "communicator/communicator.h" #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES #pragma weak MPI_Intercomm_merge = PMPI_Intercomm_merge #endif int MPI_Intercomm_merge(MPI_Comm intercomm, int high, - MPI_Comm *newintercomm) { + MPI_Comm *newcomm) { + + + if ( MPI_PARAM_CHECK ) { + if ( lam_mpi_finalized ) + return LAM_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_INTERN, + "MPI_Intercomm_merge"); + + if ( MPI_COMM_NULL == intercomm || lam_comm_invalid ( intercomm ) || + !( intercomm->c_flags & LAM_COMM_INTER ) ) + return LAM_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_COMM, + "MPI_Intercomm_merge"); + + if ( NULL == newcomm ) + return LAM_ERRHANDLER_INVOKE ( intercomm, MPI_ERR_ARG, + "MPI_Intercomm_merge"); + } + return MPI_SUCCESS; } diff --git a/src/mpi/c/topo_test.c b/src/mpi/c/topo_test.c index 623fc7430a..21a28f5059 100644 --- a/src/mpi/c/topo_test.c +++ b/src/mpi/c/topo_test.c @@ -6,6 +6,8 @@ #include "mpi.h" #include "mpi/c/bindings.h" +#include "runtime/runtime.h" +#include "communicator/communicator.h" #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES #pragma weak MPI_Topo_test = PMPI_Topo_test @@ -13,5 +15,27 @@ int MPI_Topo_test(MPI_Comm comm, int *status) { + + if ( MPI_PARAM_CHECK ) { + if ( lam_mpi_finalized ) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INTERN, + "MPI_Topo_test"); + + if ( MPI_COMM_NULL == comm || lam_comm_invalid (comm)) + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM, + "MPI_Topo_test"); + + if ( NULL == status ) + return LAM_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + "MPI_Topo_test"); + } + + if ( comm->c_flags & LAM_COMM_CART ) + *status = MPI_CART; + else if ( comm->c_flags & LAM_COMM_GRAPH ) + *status = MPI_GRAPH; + else + *status = MPI_UNDEFINED; + return MPI_SUCCESS; }