implementation of the MPI-API for the MPI-1 intra-communicators.

For inter-communicators, I introduced already the argument checking, but not yet the proper code.

This commit was SVN r983.

src/mpi/c/comm_compare.c

@@ -5,12 +5,139 @@
 #include <stdio.h>
 
 #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;
 }

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");
 }

src/mpi/c/comm_dup.c

@@ -3,14 +3,85 @@
  */
 #include "lam_config.h"
 #include <stdio.h>
+#include <string.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_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;
 }

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;
 }

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
+int MPI_Comm_get_name(MPI_Comm comm, char *name, int *length)  {
-MPI_Comm_get_name(MPI_Comm a, char *b, int *c)
+
-{
+    if ( MPI_PARAM_CHECK ) {
-  return MPI_ERR_UNKNOWN;
+        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;
 }

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");
 }

src/mpi/c/comm_rank.c

@@ -5,6 +5,7 @@
 #include <stdio.h>
 
 #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;
 }

src/mpi/c/comm_remote_group.c

@@ -3,9 +3,13 @@
  */
 #include "lam_config.h"
 #include <stdio.h>
+#include <string.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_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;
 }

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;
 }

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
+int MPI_Comm_set_name(MPI_Comm comm, char *name) {
-MPI_Comm_set_name(MPI_Comm comm, char *name)
-{
-  if (comm == MPI_COMM_NULL) {
-    /* -- Invoke error function -- */
-  }
-  
-  if (name == NULL) {
-    /* -- Invoke error function -- */
-  }
 
-  /* -- Thread safety entrance -- */
 
-  /* Copy in the name */
+    if ( MPI_PARAM_CHECK ) {
-  
+        if ( lam_mpi_finalized ) 
-  strncpy(comm->c_name, name, MPI_MAX_OBJECT_NAME);
+            return LAM_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_INTERN,
-  comm->c_name[MPI_MAX_OBJECT_NAME - 1] = 0;
+                                           "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 */
 

src/mpi/c/comm_size.c

@@ -5,6 +5,7 @@
 #include <stdio.h>
 
 #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;
 }

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");
 }

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;
 }

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;
 }

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;
 }

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;
 }