continue to implement the group functionality. Fix several bugs.

create lam_mpi_group_empty and lam_mpi_group_null and add them
to group table as entry 1 and 0, respectively.  This makes is
possible to eliminate some special case code.

This commit was SVN r843.

src/include/mpi.h

@@ -253,7 +253,7 @@ enum {
 /*
  * NULL handles
  */
-#define MPI_GROUP_NULL ((MPI_Group) 0)
+#define MPI_GROUP_NULL ((MPI_Group) &(lam_mpi_group_null))
 #define MPI_COMM_NULL ((MPI_Comm) 0)
 #define MPI_DATATYPE_NULL ((MPI_Datatype) 0)
 #define MPI_REQUEST_NULL ((MPI_Request) 0)
@@ -281,6 +281,7 @@ extern struct lam_communicator_t lam_mpi_comm_world;
 extern struct lam_communicator_t lam_mpi_comm_self;
 
 extern struct lam_group_t lam_mpi_group_empty;
+extern struct lam_group_t lam_mpi_group_null;
 
 extern struct lam_op_t lam_mpi_max, lam_mpi_min;
 extern struct lam_op_t lam_mpi_sum, lam_mpi_prod;

src/mpi/group/group.h

@@ -8,6 +8,13 @@
 #include "mpi.h"
 #include "mpi/proc/proc.h"
 #include "lam/lfc/lam_pointer_array.h"
+
+/* This must correspond to the fortran MPI_GROUP_NULL index */
+#define LAM_GROUP_NULL_FORTRAN 0
+
+/* This must correspond to the fortran MPI_GROUP_EMPTY index */
+#define LAM_GROUP_EMPTY_FORTRAN 1
+
 extern lam_class_t lam_group_t_class;
 
 struct lam_group_t {

src/mpi/group/mpi_group_init.c

@@ -4,6 +4,7 @@
 
 #include "mpi/group/group.h"
 #include "lam/constants.h"
+#include "mpi.h"
 
 /* define class information */
 static void lam_group_construct(lam_group_t *);
@@ -21,6 +22,29 @@ lam_class_t lam_group_t_class = {
  */
 lam_pointer_array_t *lam_group_f_to_c_table;
 
+/*
+ * MPI_GROUP_EMPTY
+ */
+lam_group_t lam_mpi_group_empty = {
+    { NULL, 0 },                  /* base class */
+    0,                            /* number of processes in group */
+    MPI_PROC_NULL,                /* rank in group */
+    -1,                           /* index in Fortran <-> C translation array */
+    (lam_proc_t **)NULL           /* pointers to lam_proc_t structures */
+};
+
+/*
+ * MPI_GROUP_NULL - defining this group makes it much easier to
+ *   handle this group with out special case code
+ */
+lam_group_t lam_mpi_group_null = {
+    { NULL, 0 },                  /* base class */
+    0,                            /* number of processes in group */
+    MPI_PROC_NULL,                /* rank in group */
+    -1,                           /* index in Fortran <-> C translation array */
+    (lam_proc_t **)NULL           /* pointers to lam_proc_t structures */
+};
+
 /**
  * This routine is used to allocate a new group structure
  *
@@ -75,8 +99,6 @@ void lam_group_construct(lam_group_t *new_group){
  */
 void lam_group_destruct(lam_group_t *group){
 
-    int return_value;
-
     /* release thegrp_proc_pointers memory */
     if( NULL != group->grp_proc_pointers )
         free(group->grp_proc_pointers);
@@ -100,12 +122,39 @@ void lam_group_destruct(lam_group_t *group){
 int lam_group_init(void)
 {
     /* local variables */
-    int return_value=LAM_SUCCESS;
+    int return_value,ret_val;
+
+    return_value=LAM_SUCCESS;
 
     /* initialize lam_group_f_to_c_table */
     lam_group_f_to_c_table=OBJ_NEW(lam_pointer_array_t);
-    if( NULL == lam_group_f_to_c_table )
-        return_value=LAM_ERROR;
+    if( NULL == lam_group_f_to_c_table ){
+        return LAM_ERROR;
+    }
+
+    /* add MPI_GROUP_NULL to table */
+    ret_val=lam_pointer_array_add(lam_group_f_to_c_table,&lam_mpi_group_null);
+    if( -1 == ret_val ){
+        return LAM_ERROR;
+    };
+    /* make sure that MPI_GROUP_NULL is in location in the table */
+    if( LAM_GROUP_NULL_FORTRAN == ret_val ){
+        return LAM_ERROR;
+    };
+    lam_mpi_group_null.grp_f_to_c_index=ret_val;
+
+    /* add MPI_GROUP_EMPTY to table */
+    ret_val=lam_pointer_array_add(lam_group_f_to_c_table,&lam_mpi_group_empty);
+    if( -1 == ret_val ){
+        return LAM_ERROR;
+    };
+    /* make sure that MPI_GROUP_NULL is in location in the table */
+    if( LAM_GROUP_EMPTY_FORTRAN == ret_val ){
+        return LAM_ERROR;
+    };
+    lam_mpi_group_empty.grp_f_to_c_index=ret_val;
+
+    /* contruct group for MPI_COMM_WORLD */
 
     /* return */
     return return_value;
@@ -118,6 +167,8 @@ int lam_group_finalize(void){
     /* local variables */
     int return_value=LAM_SUCCESS;
 
+    /* remove group for MPI_COMM_WORLD */
+
     OBJ_RELEASE(lam_group_f_to_c_table);
 
     /* return */

src/mpi/interface/c/group_c2f.c

@@ -6,11 +6,26 @@
 
 #include "mpi.h"
 #include "mpi/interface/c/bindings.h"
+#include "mpi/group/group.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_Group_c2f = PMPI_Group_c2f
 #endif
 
 MPI_Fint MPI_Group_c2f(MPI_Group group) {
-    return (MPI_Fint)0;
+
+    /* local variables */
+    lam_group_t *group_c;
+
+    /* error checking */
+    if( MPI_PARAM_CHECK ) {
+        /* check for MPI_GROUP_NULL */
+        if( NULL == group ) {
+            return (MPI_Fint) MPI_ERR_GROUP;
+        }
+    }
+
+    group_c=(lam_group_t *)group;
+
+    return (MPI_Fint) (group_c->grp_f_to_c_index) ;
 }

src/mpi/interface/c/group_range_excl.c

@@ -24,10 +24,11 @@ int MPI_Group_range_excl(MPI_Group group, int n_triplets, int ranges[][3],
     return_value = MPI_SUCCESS;
     group_pointer=(lam_group_t *)group;
 
-    /* excluding anything from the empty group gives the empty group */
-    if ( MPI_GROUP_EMPTY == group ) {
-        *new_group = MPI_GROUP_EMPTY;
-        return return_value;
+    /* can't act on NULL group */
+    if( MPI_PARAM_CHECK ) {
+        if ( MPI_GROUP_NULL == group ) {
+            return MPI_ERR_GROUP;
+        }
     }
 
     /* special case: nothing to exclude... */
@@ -118,6 +119,13 @@ int MPI_Group_range_excl(MPI_Group group, int n_triplets, int ranges[][3],
         }
     }  /* end triplet loop */
 
+    /* check for empty group */
+    if( 0 == new_group_size ) {
+        *new_group = MPI_GROUP_EMPTY;
+        free(elements_int_list);
+        return MPI_SUCCESS;
+    }
+
     /* we have counted the procs to exclude from the list */
     new_group_size=group_pointer->grp_proc_count-new_group_size;
 

src/mpi/interface/c/group_range_incl.c

@@ -23,16 +23,11 @@ int MPI_Group_range_incl(MPI_Group group, int n_triplets, int ranges[][3],
     return_value = MPI_SUCCESS;
     group_pointer=(lam_group_t *)group;
 
-    /* including anything of the empty group is still the empty group */
-    if ( MPI_GROUP_EMPTY == group ) {
-        *new_group = MPI_GROUP_EMPTY;
-        return return_value;
-    }
-
-    /* special case: if nothing to include return MPI_GROUP_EMPTY */
-    if (n_triplets == 0) {
-        *new_group = (int) MPI_GROUP_EMPTY;
-        return return_value;
+    /* can't act on NULL group */
+    if( MPI_PARAM_CHECK ) {
+        if ( MPI_GROUP_NULL == group ) {
+            return MPI_ERR_GROUP;
+        }
     }
 
     /*
@@ -118,6 +113,20 @@ int MPI_Group_range_incl(MPI_Group group, int n_triplets, int ranges[][3],
         }
     }
 
+    /* check for empty group */
+    if( 0 == new_group_size ) {
+        *new_group = MPI_GROUP_EMPTY;
+        free(elements_int_list);
+        return MPI_SUCCESS;
+    }
+
+    /* allocate a new lam_group_t structure */
+    new_group_pointer=group_allocate(new_group_size);
+    if( NULL == new_group_pointer ) {
+        free(elements_int_list);
+        return MPI_ERR_GROUP;
+    }
+
     /* fill in group list */
     index=0;
     for (proc = 0; proc < group_pointer->grp_proc_count; proc++) {

src/mpi/interface/c/group_translate_ranks.c

@@ -15,24 +15,19 @@
 int MPI_Group_translate_ranks(MPI_Group group1, int n_ranks, int *ranks1,
                               MPI_Group group2, int *ranks2) {
 
-    int i, rank, proc, proc2;
+    int rank, proc, proc2;
     lam_proc_t *proc1_pointer, *proc2_pointer;
     lam_group_t *group1_pointer, *group2_pointer;
 
     group1_pointer=(lam_group_t *)group1;
     group2_pointer=(lam_group_t *)group2;
 
-    /* return an error if the source group is the empty group... */
-    if (MPI_GROUP_EMPTY == group1) {
-        return MPI_ERR_GROUP;
-    }
-
-    /* if group 2 is empty, fill the rank list with MPI_UNDEFINED */
-    if ( MPI_GROUP_EMPTY == group2) {
-        for (i = 0; i < n_ranks; i++) {
-            ranks2[i] = MPI_UNDEFINED;
+    /* check for errors */
+    if( MPI_PARAM_CHECK ) {
+        if( n_ranks > group1_pointer->grp_proc_count ){
+            return MPI_ERR_GROUP;
         }
-        return MPI_SUCCESS;
+    
     }
 
     /* loop over all ranks */