End team implemented

Author: Alessandro Fanfarillo

src/libcaf.h

@@ -91,13 +91,22 @@ caf_deregister_t;
 typedef void* caf_token_t;
 #ifdef GCC_GE_7
 /** Add a dummy type representing teams in coarrays. */
+
 typedef void * caf_team_t;
+
 typedef struct caf_teams_list {
   caf_team_t team;
   int team_id;
   struct caf_teams_list *prev;
 }
 caf_teams_list;
+
+typedef struct caf_used_teams_list {
+  struct caf_teams_list *team_list_elem;
+  struct caf_used_teams_list *prev;
+}
+caf_used_teams_list;
+
 #endif
 
 /* When there is a vector subscript in this dimension, nvec == 0, otherwise,
@@ -277,6 +286,7 @@ void PREFIX (fail_image) (void) __attribute__ ((noreturn));
 
 void PREFIX (form_team) (int, caf_team_t *, int);
 void PREFIX (change_team) (caf_team_t *, int);
+void PREFIX (end_team) (caf_team_t *);
 
 int PREFIX (image_status) (int);
 void PREFIX (failed_images) (gfc_descriptor_t *, int, int *);

src/mpi/mpi_caf.c

@@ -44,6 +44,7 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.  */
 #include <mpi.h>
 #include <pthread.h>
 #include <signal.h>        /* For raise */
+#include <limits.h>
 
 #ifdef HAVE_MPI_EXT_H
 #include <mpi-ext.h>
@@ -215,7 +216,7 @@ char err_buffer[MPI_MAX_ERROR_STRING];
 MPI_Comm CAF_COMM_WORLD;
 
 static caf_teams_list *teams_list = NULL;
-static MPI_Comm current_team;
+static caf_used_teams_list *used_teams = NULL;
 
 #ifdef WITH_FAILED_IMAGES
 /* The stati of the other images.  image_stati is an array of size
@@ -798,7 +799,15 @@ PREFIX (init) (int *argc, char ***argv)
 
       stat_tok = malloc (sizeof (MPI_Win));
 
-      current_team = CAF_COMM_WORLD;
+      teams_list = (caf_teams_list *)calloc(1,sizeof(caf_teams_list));
+      teams_list->team_id = INT_MIN;
+      MPI_Comm *tmp_comm = (MPI_Comm *)calloc(1,sizeof(MPI_Comm));
+      *tmp_comm = CAF_COMM_WORLD;
+      teams_list->team = tmp_comm;
+      teams_list->prev = NULL;
+      used_teams = (caf_used_teams_list *)calloc(1,sizeof(caf_used_teams_list));
+      used_teams->team_list_elem = teams_list;
+      used_teams->prev = NULL;
 
 #ifdef WITH_FAILED_IMAGES
       MPI_Comm_dup (MPI_COMM_WORLD, &alive_comm);
@@ -5170,7 +5179,7 @@ void PREFIX (form_team) (int team_id, caf_team_t *team, int index __attribute__
   struct caf_teams_list *tmp;
   void * tmp_team;
   MPI_Comm *newcomm;
-  MPI_Comm *current_comm = &current_team;
+  MPI_Comm *current_comm = &CAF_COMM_WORLD;
 
   MPI_Barrier(CAF_COMM_WORLD);
   newcomm = (MPI_Comm *)calloc(1,sizeof(MPI_Comm));
@@ -5186,22 +5195,65 @@ void PREFIX (form_team) (int team_id, caf_team_t *team, int index __attribute__
 
 void PREFIX (change_team) (caf_team_t *team, int coselector __attribute__ ((unused)))
 {
+  caf_used_teams_list *tmp_used = NULL;
+  caf_teams_list * tmp_list = NULL;
   void *tmp_team;
   MPI_Comm *tmp_comm;
+
   MPI_Barrier(CAF_COMM_WORLD);
   tmp_team = (void *)*team;
   tmp_comm = (MPI_Comm *)tmp_team;
+
+  tmp_used = (caf_used_teams_list *)calloc(1,sizeof(caf_used_teams_list));
+  tmp_used->prev = used_teams;
+
+  /* We need to look in the teams_list and find the appropriate element.
+   * This is not efficient but can be easily fixed in the future. 
+   * Instead of keeping track of the communicator in the compiler 
+   * we should keep track of the caf_teams_list element associated with it. */
+
+  tmp_list = teams_list;
+
+  while(tmp_list)
+    {
+      if(tmp_list->team == tmp_team)
+	break;
+      tmp_list = tmp_list->prev;
+    }
+
+  if(tmp_list == NULL)
+    caf_runtime_error("CHANGE TEAM called on a non-existing team");
+  
+  tmp_used->team_list_elem = tmp_list;
+  used_teams = tmp_used;
+  tmp_team = tmp_used->team_list_elem->team;
+  tmp_comm = (MPI_Comm *)tmp_team;
   CAF_COMM_WORLD = *tmp_comm;
   MPI_Comm_rank(*tmp_comm,&caf_this_image);
   caf_this_image++;
   MPI_Comm_size(*tmp_comm,&caf_num_images);
-  
-  /* MPI_Comm_split(*current_comm, team_id, caf_this_image, &newcomm); */
-
-  /* tmp = calloc(1,sizeof(struct caf_teams_list)); */
-  /* tmp->prev = teams_list; */
-  /* teams_list = tmp; */
-  /* teams_list->team_id = team_id; */
-  /* teams_list->team = &newcomm; */
-  /* *team = &newcomm; */
+}
+
+void PREFIX (end_team) (caf_team_t *team __attribute__ ((unused)))
+{
+  caf_used_teams_list *tmp_used = NULL;
+  void *tmp_team;
+  MPI_Comm *tmp_comm;
+
+  MPI_Barrier(CAF_COMM_WORLD);
+  if(used_teams->prev == NULL)
+    caf_runtime_error("END TEAM called on initial team");
+
+  tmp_used = used_teams;
+  used_teams = used_teams->prev;
+  free(tmp_used);
+  tmp_used = used_teams;
+  tmp_team = tmp_used->team_list_elem->team;
+  tmp_comm = (MPI_Comm *)tmp_team;
+  CAF_COMM_WORLD = *tmp_comm;
+  MPI_Barrier(CAF_COMM_WORLD);
+  /* CAF_COMM_WORLD = (MPI_Comm)*tmp_used->team_list_elem->team; */
+  MPI_Comm_rank(CAF_COMM_WORLD,&caf_this_image);
+  caf_this_image++;
+  MPI_Comm_size(CAF_COMM_WORLD,&caf_num_images);
 }