[PATCH, fortran] Support Fortran 2018 teams

[PATCH, fortran] Support Fortran 2018 teams

[Damian Rouson]

[-- Attachment #1: Type: text/plain, Size: 4174 bytes --]

 
All,

Attached please find what I hope is the final version of the patch that adds partial support for teams of images, the last remaining major Fortran 2018 feature without current support in gfortran (or any other Fortran compiler of which I’m aware).  I submitted the first draft of this patch last September. Regression tests show no unexpected failures (i.e., the output of ‘grep -w FAIL gfortran.sum’ is empty). The Changelogs are below.

Among the details remaining for future commits are the following: support for the GET_TEAM intrinsic function is incomplete, the TEAM_NUMBER intrinsic function doesn’t yet accept the optional argument, and a SYNC TEAM test is needed.  Using any of the unsupported features generates a compile-time error message from gfortran or a runtime error message from OpenCoarrays. There are no internal compiler errors of which I’m aware.  And there remains one big, dissertation-worthy project in handling the use of teams in the presence of failed images.

Ok for trunk?

Damian


2018-01-18  Damian Rouson  <damian@sourceryinstitute.org>
        Alessandro Fanfarillo  <fanfarillo.gcc@gmail.com>

        Partial support for Fortran 2018 teams features.

        * array.c (gfc_match_array_ref): add team attribute in coarray
        transfers.
        * check.c (gfc_check_get_team, gfc_check_team_number): add new 
        functions for get_team and team_number.
        * dump-parse-tree.c (show_code_node): add new statements: form team,
        change team, end team, and sync team.
        * expr.c (gfc_find_team_co): add new function.
        * gfortran.h: add new statements.
        * intrinsic.c (add_functions): add get_team and team_number functions.
        * intrinsic.h: add get_team and team_number prototypes for check,
        simplify, and resolve.
        * iresolve.c (gfc_resolve_get_team, gfc_resolve_team_number): add new 
        functions.
        * iso-fortran-env.def: add the team_type derived type.
        * match.c (gfc_match_if, gfc_match_form_team, gfc_match_team_number)
        (gfc_match_end_team, gfc_match_sync_team, gfc_match_change_team):
        add change team, end team, form team, sync team match and functions.
        * match.h: add new prototypes for change team, end team, form team,
        and sync team.
        * parse.c (decode_statement): add cases for change team, end team,
        form team, and sync team.
        * resolve.c: add cases for exec form team, change team, end team, and 
        sync team.
        * simplify.c (gfc_simplify_get_team): add new function for get team.
        * st.c (gfc_free_statement): add cases exec for change team, end team,
        form team, sync team.
        * trans-decl.c (gfor_fndecl_caf_form_team)
        (gfor_fndecl_caf_change_team, gfor_fndecl_caf_end_team)
        (gfor_fndecl_caf_sync_team, gfor_fndecl_caf_get_team)
        (gfor_fndecl_caf_team_number): add functions and definitions.
        * trans-intrinsic.c (conv_caf_send, conv_intrinsic_team_number): add 
        new function and team_type argument support.
        * trans-stmt.c (gfc_trans_form_team, gfc_trans_change_team)
        (gfc_trans_end_team, gfc_trans_sync_team): add new functions.
        * trans-stmt.h: add new prototypes.
        * trans-types.c (gfc_get_derived_type): check condition for team_type.
        * trans.c (trans_code): new exec cases for form team, change team, end 
        team, and sync team.
        * trans.h: add new prototypes.

2018-01-18  Damian Rouson  <damian@sourceryinstitute.org>
        Alessandro Fanfarillo  <fanfarillo.gcc@gmail.com>

        Fortran 2018 teams tests.

        * gfortran.dg/team_number_1.f90: new test for team_number.
        * gfortran.dg/team_change_1.f90: new test for change team.
        * gfortran.dg/team_end_1.f90: new test for end team.
        * gfortran.dg/team_form_1.f90: new test for form team.




[-- Attachment #2: teams-patch.diff --]
[-- Type: application/octet-stream, Size: 56180 bytes --]

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index 882fe577b76..b4baf5be554 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -158,6 +158,7 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init,
   bool matched_bracket = false;
   gfc_expr *tmp;
   bool stat_just_seen = false;
+  bool team_just_seen = false;
 
   memset (ar, '\0', sizeof (*ar));
 
@@ -230,8 +231,21 @@ coarray:
       if (m == MATCH_ERROR)
 	return MATCH_ERROR;
 
+      team_just_seen = false;
       stat_just_seen = false;
-      if (gfc_match(" , stat = %e",&tmp) == MATCH_YES && ar->stat == NULL)
+      if (gfc_match (" , team = %e", &tmp) == MATCH_YES && ar->stat == NULL)
+	{
+	  ar->team = tmp;
+	  team_just_seen = true;
+	}
+
+      if (ar->team && !team_just_seen)
+	{
+	  gfc_error ("TEAM= attribute in %C misplaced");
+	  return MATCH_ERROR;
+	}
+
+      if (gfc_match (" , stat = %e",&tmp) == MATCH_YES && ar->stat == NULL)
 	{
 	  ar->stat = tmp;
 	  stat_just_seen = true;
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index a2c8b520d80..b73b3f76e0a 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1252,6 +1252,20 @@ gfc_check_failed_or_stopped_images (gfc_expr *team, gfc_expr *kind)
 }
 
 
+bool
+gfc_check_get_team (gfc_expr *level)
+{
+  if (level)
+    {
+      gfc_error ("%qs argument of %qs intrinsic at %L not yet supported",
+		 gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
+		 &level->where);
+      return false;
+    }
+  return true;
+}
+
+
 bool
 gfc_check_atomic_cas (gfc_expr *atom, gfc_expr *old, gfc_expr *compare,
 		      gfc_expr *new_val,  gfc_expr *stat)
@@ -2264,7 +2278,7 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
 	      return false;
 	    }
 	}
-      
+
       if (array->rank == 1 || boundary->rank == 0)
 	{
 	  if (!scalar_check (boundary, 2))
@@ -2313,7 +2327,7 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
 	case BT_COMPLEX:
 	case BT_CHARACTER:
 	  break;
-	  
+
 	default:
 	  gfc_error ("Missing %qs argument to %qs intrinsic at %L for %qs "
 		     "of type %qs", gfc_current_intrinsic_arg[2]->name,
@@ -5274,6 +5288,33 @@ gfc_check_num_images (gfc_expr *distance, gfc_expr *failed)
 }
 
 
+bool
+gfc_check_team_number (gfc_expr *team)
+{
+  if (flag_coarray == GFC_FCOARRAY_NONE)
+    {
+      gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to enable");
+      return false;
+    }
+
+  if (team)
+    {
+      /* TODO: this works on any derived type when
+         it should only work with team_type.  */
+      if (team->ts.type != BT_DERIVED)
+        {
+          gfc_error ("TEAM argument at %L to the intrinsic TEAM_NUMBER "
+                     "shall be of type TEAM_TYPE", &team->where);
+          return false;
+        }
+    }
+  else
+    return true;
+
+  return true;
+}
+
+
 bool
 gfc_check_this_image (gfc_expr *coarray, gfc_expr *dim, gfc_expr *distance)
 {
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 5ff531682e3..0de2a0f1d6a 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1868,6 +1868,22 @@ show_code_node (int level, gfc_code *c)
       fputs ("FAIL IMAGE ", dumpfile);
       break;
 
+    case EXEC_CHANGE_TEAM:
+      fputs ("CHANGE TEAM", dumpfile);
+      break;
+
+    case EXEC_END_TEAM:
+      fputs ("END TEAM", dumpfile);
+      break;
+
+    case EXEC_FORM_TEAM:
+      fputs ("FORM TEAM", dumpfile);
+      break;
+
+    case EXEC_SYNC_TEAM:
+      fputs ("SYNC TEAM", dumpfile);
+      break;
+
     case EXEC_SYNC_ALL:
       fputs ("SYNC ALL ", dumpfile);
       if (c->expr2 != NULL)
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 45ccc184fc1..1708487cdf8 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -5065,7 +5065,25 @@ gfc_ref_this_image (gfc_ref *ref)
 }
 
 gfc_expr *
-gfc_find_stat_co(gfc_expr *e)
+gfc_find_team_co (gfc_expr *e)
+{
+  gfc_ref *ref;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
+      return ref->u.ar.team;
+
+  if (e->value.function.actual->expr)
+    for (ref = e->value.function.actual->expr->ref; ref;
+	 ref = ref->next)
+      if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
+	return ref->u.ar.team;
+
+  return NULL;
+}
+
+gfc_expr *
+gfc_find_stat_co (gfc_expr *e)
 {
   gfc_ref *ref;
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6ddf450ad2e..f35430dcd20 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -263,7 +263,8 @@ enum gfc_statement
   ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, ST_OMP_ORDERED_DEPEND,
   ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
   ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST,
-  ST_EVENT_WAIT,ST_FAIL_IMAGE,ST_NONE
+  ST_EVENT_WAIT, ST_FAIL_IMAGE, ST_FORM_TEAM, ST_CHANGE_TEAM,
+  ST_END_TEAM, ST_SYNC_TEAM, ST_NONE
 };
 
 /* Types of interfaces that we can have.  Assignment interfaces are
@@ -455,6 +456,7 @@ enum gfc_isym_id
   GFC_ISYM_GETGID,
   GFC_ISYM_GETLOG,
   GFC_ISYM_GETPID,
+  GFC_ISYM_GET_TEAM,
   GFC_ISYM_GETUID,
   GFC_ISYM_GMTIME,
   GFC_ISYM_HOSTNM,
@@ -597,6 +599,7 @@ enum gfc_isym_id
   GFC_ISYM_SYSTEM_CLOCK,
   GFC_ISYM_TAN,
   GFC_ISYM_TANH,
+  GFC_ISYM_TEAM_NUMBER,
   GFC_ISYM_THIS_IMAGE,
   GFC_ISYM_TIME,
   GFC_ISYM_TIME8,
@@ -1913,6 +1916,7 @@ typedef struct gfc_array_ref
   int dimen;			/* # of components in the reference */
   int codimen;
   bool in_allocate;		/* For coarray checks. */
+  gfc_expr *team;
   gfc_expr *stat;
   locus where;
   gfc_array_spec *as;
@@ -2497,6 +2501,7 @@ enum gfc_exec_op
   EXEC_OPEN, EXEC_CLOSE, EXEC_WAIT,
   EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
   EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH,
+  EXEC_FORM_TEAM, EXEC_CHANGE_TEAM, EXEC_END_TEAM, EXEC_SYNC_TEAM,
   EXEC_LOCK, EXEC_UNLOCK, EXEC_EVENT_POST, EXEC_EVENT_WAIT, EXEC_FAIL_IMAGE,
   EXEC_OACC_KERNELS_LOOP, EXEC_OACC_PARALLEL_LOOP, EXEC_OACC_ROUTINE,
   EXEC_OACC_PARALLEL, EXEC_OACC_KERNELS, EXEC_OACC_DATA, EXEC_OACC_HOST_DATA,
@@ -3223,6 +3228,7 @@ bool gfc_is_coarray (gfc_expr *);
 int gfc_get_corank (gfc_expr *);
 bool gfc_has_ultimate_allocatable (gfc_expr *);
 bool gfc_has_ultimate_pointer (gfc_expr *);
+gfc_expr* gfc_find_team_co (gfc_expr *);
 gfc_expr* gfc_find_stat_co (gfc_expr *);
 gfc_expr* gfc_build_intrinsic_call (gfc_namespace *, gfc_isym_id, const char*,
 				    locus, unsigned, ...);
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 4844cee0c34..a47de413138 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -860,7 +860,7 @@ add_sym_5s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
 	    int kind3, int optional3, sym_intent intent3, const char *a4,
 	    bt type4, int kind4, int optional4, sym_intent intent4,
 	    const char *a5, bt type5, int kind5, int optional5,
-	    sym_intent intent5) 
+	    sym_intent intent5)
 {
   gfc_check_f cf;
   gfc_simplify_f sf;
@@ -1246,7 +1246,8 @@ add_functions (void)
     *num = "number", *tm = "time", *nm = "name", *md = "mode",
     *vl = "values", *p1 = "path1", *p2 = "path2", *com = "command",
     *ca = "coarray", *sub = "sub", *dist = "distance", *failed="failed",
-    *c_ptr_1 = "c_ptr_1", *c_ptr_2 = "c_ptr_2", *back = "back";
+    *c_ptr_1 = "c_ptr_1", *c_ptr_2 = "c_ptr_2", *back = "back",
+    *team = "team", *image = "image", *level = "level";
 
   int di, dr, dd, dl, dc, dz, ii;
 
@@ -1282,8 +1283,8 @@ add_functions (void)
 	     NULL, gfc_simplify_abs, gfc_resolve_abs,
 	     a, BT_COMPLEX, dz, REQUIRED);
 
-  add_sym_1 ("zabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU, 
-	     NULL, gfc_simplify_abs, gfc_resolve_abs, 
+  add_sym_1 ("zabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
+	     NULL, gfc_simplify_abs, gfc_resolve_abs,
 	     a, BT_COMPLEX, dd, REQUIRED);
 
   make_alias ("cdabs", GFC_STD_GNU);
@@ -1344,8 +1345,8 @@ add_functions (void)
   make_alias ("imag", GFC_STD_GNU);
   make_alias ("imagpart", GFC_STD_GNU);
 
-  add_sym_1 ("dimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU, 
-	     NULL, gfc_simplify_aimag, gfc_resolve_aimag, 
+  add_sym_1 ("dimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
+	     NULL, gfc_simplify_aimag, gfc_resolve_aimag,
 	     z, BT_COMPLEX, dd, REQUIRED);
 
   make_generic ("aimag", GFC_ISYM_AIMAG, GFC_STD_F77);
@@ -1397,7 +1398,7 @@ add_functions (void)
 	     x, BT_REAL, dd, REQUIRED);
 
   make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77);
-  
+
   add_sym_1 ("asinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
 	     GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_asinh,
 	     gfc_resolve_asinh, x, BT_REAL, dr, REQUIRED);
@@ -1428,7 +1429,7 @@ add_functions (void)
 	     y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
 
   make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77);
-  
+
   add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
 	     GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_atanh,
 	     gfc_resolve_atanh, x, BT_REAL, dr, REQUIRED);
@@ -1448,7 +1449,7 @@ add_functions (void)
 	     y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED);
 
   make_generic ("atan2", GFC_ISYM_ATAN2, GFC_STD_F77);
-  
+
   /* Bessel and Neumann functions for G77 compatibility.  */
   add_sym_1 ("besj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
 	     gfc_check_fn_r, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
@@ -1613,7 +1614,7 @@ add_functions (void)
 
   make_generic ("cmplx", GFC_ISYM_CMPLX, GFC_STD_F77);
 
-  add_sym_0 ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT, CLASS_INQUIRY, 
+  add_sym_0 ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT, CLASS_INQUIRY,
 	     ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003, NULL, NULL, NULL);
 
   make_generic ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT,
@@ -1639,7 +1640,7 @@ add_functions (void)
 	     z, BT_COMPLEX, dz, REQUIRED);
 
   add_sym_1 ("dconjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
-	     NULL, gfc_simplify_conjg, gfc_resolve_conjg, 
+	     NULL, gfc_simplify_conjg, gfc_resolve_conjg,
 	     z, BT_COMPLEX, dd, REQUIRED);
 
   make_generic ("conjg", GFC_ISYM_CONJG, GFC_STD_F77);
@@ -1657,7 +1658,7 @@ add_functions (void)
 	     x, BT_COMPLEX, dz, REQUIRED);
 
   add_sym_1 ("zcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
-	     NULL, gfc_simplify_cos, gfc_resolve_cos, 
+	     NULL, gfc_simplify_cos, gfc_resolve_cos,
 	     x, BT_COMPLEX, dd, REQUIRED);
 
   make_alias ("cdcos", GFC_STD_GNU);
@@ -1826,7 +1827,7 @@ add_functions (void)
 	     x, BT_COMPLEX, dz, REQUIRED);
 
   add_sym_1 ("zexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd,  GFC_STD_GNU,
-	     NULL, gfc_simplify_exp, gfc_resolve_exp, 
+	     NULL, gfc_simplify_exp, gfc_resolve_exp,
 	     x, BT_COMPLEX, dd, REQUIRED);
 
   make_alias ("cdexp", GFC_STD_GNU);
@@ -1850,8 +1851,8 @@ add_functions (void)
 	     ACTUAL_NO, BT_INTEGER, dd, GFC_STD_F2008_TS,
 	     gfc_check_failed_or_stopped_images,
 	     gfc_simplify_failed_or_stopped_images,
-	     gfc_resolve_failed_images, "team", BT_VOID, di, OPTIONAL,
-	     "kind", BT_INTEGER, di, OPTIONAL);
+	     gfc_resolve_failed_images, team, BT_VOID, di, OPTIONAL,
+	     kind, BT_INTEGER, di, OPTIONAL);
 
   add_sym_0 ("fdate",  GFC_ISYM_FDATE, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER,
 	     dc, GFC_STD_GNU, NULL, NULL, gfc_resolve_fdate);
@@ -1944,6 +1945,11 @@ add_functions (void)
 
   make_generic ("getpid", GFC_ISYM_GETPID, GFC_STD_GNU);
 
+  add_sym_1 ("get_team", GFC_ISYM_GET_TEAM, CLASS_TRANSFORMATIONAL,
+	     ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008_TS,
+	     gfc_check_get_team, NULL, gfc_resolve_get_team,
+	     level, BT_INTEGER, di, OPTIONAL);
+
   add_sym_0 ("getuid", GFC_ISYM_GETUID, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
 	     di, GFC_STD_GNU, NULL, NULL, gfc_resolve_getuid);
 
@@ -2096,8 +2102,8 @@ add_functions (void)
 
   add_sym_2 ("image_status", GFC_ISYM_IMAGE_STATUS, CLASS_ELEMENTAL, ACTUAL_NO,
 	     BT_INTEGER, di, GFC_STD_F2008_TS, gfc_check_image_status,
-	     gfc_simplify_image_status, gfc_resolve_image_status, "image",
-	     BT_INTEGER, di, REQUIRED, "team", BT_VOID, di, OPTIONAL);
+	     gfc_simplify_image_status, gfc_resolve_image_status, image,
+	     BT_INTEGER, di, REQUIRED, team, BT_VOID, di, OPTIONAL);
 
   /* The resolution function for INDEX is called gfc_resolve_index_func
      because the name gfc_resolve_index is already used in resolve.c.  */
@@ -2345,7 +2351,7 @@ add_functions (void)
 	     p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
 
   make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
-  
+
   add_sym_1 ("log", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
 	     gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log,
 	     x, BT_REAL, dr, REQUIRED);
@@ -2543,7 +2549,7 @@ add_functions (void)
 	       ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
 	       msk, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL,
 	       back, BT_LOGICAL, dl, OPTIONAL);
-	       
+
   make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
 
   add_sym_3red ("minval", GFC_ISYM_MINVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
@@ -2747,7 +2753,7 @@ add_functions (void)
 	     p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
 
   make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
-  
+
   add_sym_2 ("repeat", GFC_ISYM_REPEAT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
 	     gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
 	     stg, BT_CHARACTER, dc, REQUIRED, ncopies, BT_INTEGER, di, REQUIRED);
@@ -2957,7 +2963,7 @@ add_functions (void)
 	     x, BT_UNKNOWN, 0, REQUIRED);
   make_from_module();
 
-  /* COMPILER_OPTIONS and COMPILER_VERSION are part of ISO_FORTRAN_ENV.  */  
+  /* COMPILER_OPTIONS and COMPILER_VERSION are part of ISO_FORTRAN_ENV.  */
   add_sym_0 ("compiler_options", GFC_ISYM_COMPILER_OPTIONS, CLASS_INQUIRY,
 	     ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F2008,
 	     NULL, gfc_simplify_compiler_options, NULL);
@@ -3013,8 +3019,8 @@ add_functions (void)
 	     ACTUAL_NO, BT_INTEGER, dd, GFC_STD_F2008_TS,
 	     gfc_check_failed_or_stopped_images,
 	     gfc_simplify_failed_or_stopped_images,
-	     gfc_resolve_stopped_images, "team", BT_VOID, di, OPTIONAL,
-	     "kind", BT_INTEGER, di, OPTIONAL);
+	     gfc_resolve_stopped_images, team, BT_VOID, di, OPTIONAL,
+	     kind, BT_INTEGER, di, OPTIONAL);
 
   add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE, CLASS_INQUIRY, ACTUAL_NO,
 	     BT_INTEGER, di, GFC_STD_F2008,
@@ -3022,7 +3028,7 @@ add_functions (void)
 	     gfc_resolve_storage_size,
 	     a, BT_UNKNOWN, 0, REQUIRED,
 	     kind, BT_INTEGER, di, OPTIONAL);
-  
+
   add_sym_3red ("sum", GFC_ISYM_SUM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
 		gfc_check_product_sum, gfc_simplify_sum, gfc_resolve_sum,
 		ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
@@ -3062,6 +3068,11 @@ add_functions (void)
 
   make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
 
+  add_sym_1 ("team_number", GFC_ISYM_TEAM_NUMBER, CLASS_TRANSFORMATIONAL,
+	     ACTUAL_YES, BT_INTEGER, di, GFC_STD_F2008_TS,
+	     gfc_check_team_number, NULL, gfc_resolve_team_number,
+	     team, BT_DERIVED, di, OPTIONAL);
+
   add_sym_3 ("this_image", GFC_ISYM_THIS_IMAGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
 	     gfc_check_this_image, gfc_simplify_this_image, gfc_resolve_this_image,
 	     ca, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL,
@@ -3158,11 +3169,11 @@ add_functions (void)
 	     bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
 
   make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
-    
+
   add_sym_1 ("loc", GFC_ISYM_LOC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, ii,
 	     GFC_STD_GNU, gfc_check_loc, NULL, gfc_resolve_loc,
 	     x, BT_UNKNOWN, 0, REQUIRED);
-		
+
   make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
 
   if (flag_dec_math)
@@ -4544,11 +4555,11 @@ check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
       first_expr = arg->expr;
 
       for ( ; arg && arg->expr; arg = arg->next, n++)
-	if (!gfc_check_conformance (first_expr, arg->expr, 
+	if (!gfc_check_conformance (first_expr, arg->expr,
 				    "arguments '%s' and '%s' for "
-				    "intrinsic '%s'", 
-				    gfc_current_intrinsic_arg[0]->name, 
-				    gfc_current_intrinsic_arg[n]->name, 
+				    "intrinsic '%s'",
+				    gfc_current_intrinsic_arg[0]->name,
+				    gfc_current_intrinsic_arg[n]->name,
 				    gfc_current_intrinsic))
 	  return false;
     }
@@ -5153,12 +5164,12 @@ gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
   /* Try to find an intrinsic of the same name.  */
   if (func)
     isym = gfc_find_function (sym->name);
-  else  
+  else
     isym = gfc_find_subroutine (sym->name);
 
   /* If no intrinsic was found with this name or it's not included in the
      selected standard, everything's fine.  */
-  if (!isym || !gfc_check_intrinsic_standard (isym, NULL, true, 
+  if (!isym || !gfc_check_intrinsic_standard (isym, NULL, true,
 					      sym->declared_at))
     return;
 
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 7615dd1e611..a483bfa0c7b 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -83,6 +83,7 @@ bool gfc_check_fn_r (gfc_expr *);
 bool gfc_check_fn_rc (gfc_expr *);
 bool gfc_check_fn_rc2008 (gfc_expr *);
 bool gfc_check_fnum (gfc_expr *);
+bool gfc_check_get_team (gfc_expr *);
 bool gfc_check_hostnm (gfc_expr *);
 bool gfc_check_huge (gfc_expr *);
 bool gfc_check_hypot (gfc_expr *, gfc_expr *);
@@ -169,6 +170,7 @@ bool gfc_check_stat (gfc_expr *, gfc_expr *);
 bool gfc_check_storage_size (gfc_expr *, gfc_expr *);
 bool gfc_check_sum (gfc_expr *, gfc_expr *, gfc_expr *);
 bool gfc_check_symlnk (gfc_expr *, gfc_expr *);
+bool gfc_check_team_number (gfc_expr *);
 bool gfc_check_transf_bit_intrins (gfc_actual_arglist *);
 bool gfc_check_transfer (gfc_expr *, gfc_expr *, gfc_expr *);
 bool gfc_check_transpose (gfc_expr *);
@@ -300,6 +302,7 @@ gfc_expr *gfc_simplify_float (gfc_expr *);
 gfc_expr *gfc_simplify_floor (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_fraction (gfc_expr *);
 gfc_expr *gfc_simplify_gamma (gfc_expr *);
+gfc_expr *gfc_simplify_get_team (gfc_expr *);
 gfc_expr *gfc_simplify_huge (gfc_expr *);
 gfc_expr *gfc_simplify_hypot (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_iachar (gfc_expr *, gfc_expr *);
@@ -498,6 +501,7 @@ void gfc_resolve_gamma (gfc_expr *, gfc_expr *);
 void gfc_resolve_getcwd (gfc_expr *, gfc_expr *);
 void gfc_resolve_getgid (gfc_expr *);
 void gfc_resolve_getpid (gfc_expr *);
+void gfc_resolve_get_team (gfc_expr *, gfc_expr *);
 void gfc_resolve_getuid (gfc_expr *);
 void gfc_resolve_hostnm (gfc_expr *, gfc_expr *);
 void gfc_resolve_hypot (gfc_expr *, gfc_expr *, gfc_expr *);
@@ -595,6 +599,7 @@ void gfc_resolve_symlnk (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_system (gfc_expr *, gfc_expr *);
 void gfc_resolve_tan (gfc_expr *, gfc_expr *);
 void gfc_resolve_tanh (gfc_expr *, gfc_expr *);
+void gfc_resolve_team_number (gfc_expr *, gfc_expr *);
 void gfc_resolve_this_image (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_time (gfc_expr *);
 void gfc_resolve_time8 (gfc_expr *);
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 9a4e199d01e..db514b77344 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -23,7 +23,7 @@ along with GCC; see the file COPYING3.  If not see
    first argument to a resolution function is an expression pointer to
    the original function node and the rest are pointers to the
    arguments of the function call.  For subroutines, a pointer to the
-   code node is passed.  The result type and library subroutine name
+   code ndoe is passed.  The result type and library subroutine name
    are generally set according to the function arguments.  */
 
 #include "config.h"
@@ -36,10 +36,10 @@ along with GCC; see the file COPYING3.  If not see
 #include "constructor.h"
 #include "arith.h"
 
-/* Given printf-like arguments, return a stable version of the result string. 
+/* Given printf-like arguments, return a stable version of the result string.
 
    We already have a working, optimized string hashing table in the form of
-   the identifier table.  Reusing this table is likely not to be wasted, 
+   the identifier table.  Reusing this table is likely not to be wasted,
    since if the function name makes it to the gimple output of the frontend,
    we'll have to create the identifier anyway.  */
 
@@ -316,7 +316,7 @@ gfc_resolve_aint (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
 {
   gfc_typespec ts;
   gfc_clear_ts (&ts);
-  
+
   f->ts.type = a->ts.type;
   f->ts.kind = (kind == NULL) ? a->ts.kind : mpz_get_si (kind->value.integer);
 
@@ -363,7 +363,7 @@ gfc_resolve_anint (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
 {
   gfc_typespec ts;
   gfc_clear_ts (&ts);
-  
+
   f->ts.type = a->ts.type;
   f->ts.kind = (kind == NULL) ? a->ts.kind : mpz_get_si (kind->value.integer);
 
@@ -458,7 +458,7 @@ gfc_resolve_besn (gfc_expr *f, gfc_expr *n, gfc_expr *x)
 {
   gfc_typespec ts;
   gfc_clear_ts (&ts);
-  
+
   f->ts = x->ts;
   if (n->ts.kind != gfc_c_int_kind)
     {
@@ -475,7 +475,7 @@ gfc_resolve_bessel_n2 (gfc_expr *f, gfc_expr *n1, gfc_expr *n2, gfc_expr *x)
 {
   gfc_typespec ts;
   gfc_clear_ts (&ts);
-  
+
   f->ts = x->ts;
   f->rank = 1;
   if (n1->expr_type == EXPR_CONSTANT && n2->expr_type == EXPR_CONSTANT)
@@ -811,7 +811,7 @@ gfc_resolve_cshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
   m = gfc_default_integer_kind;
   if (dim != NULL)
     m = m < dim->ts.kind ? dim->ts.kind : m;
-  
+
   /* Convert shift to at least m, so we don't need
       kind=1 and kind=2 versions of the library functions.  */
   if (shift->ts.kind < m)
@@ -822,7 +822,7 @@ gfc_resolve_cshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
       ts.kind = m;
       gfc_convert_type_warn (shift, &ts, 2, 0);
     }
- 
+
   if (dim != NULL)
     {
       if (dim->expr_type != EXPR_CONSTANT && dim->symtree != NULL
@@ -861,7 +861,7 @@ gfc_resolve_ctime (gfc_expr *f, gfc_expr *time)
 {
   gfc_typespec ts;
   gfc_clear_ts (&ts);
-  
+
   f->ts.type = BT_CHARACTER;
   f->ts.kind = gfc_default_character_kind;
 
@@ -976,7 +976,7 @@ gfc_resolve_eoshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
   m = gfc_default_integer_kind;
   if (dim != NULL)
     m = m < dim->ts.kind ? dim->ts.kind : m;
-  
+
   /* Convert shift to at least m, so we don't need
       kind=1 and kind=2 versions of the library functions.  */
   if (shift->ts.kind < m)
@@ -987,7 +987,7 @@ gfc_resolve_eoshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
       ts.kind = m;
       gfc_convert_type_warn (shift, &ts, 2, 0);
     }
- 
+
   if (dim != NULL)
     {
       if (dim->expr_type != EXPR_CONSTANT && dim->symtree != NULL
@@ -1225,7 +1225,7 @@ void
 gfc_resolve_iand (gfc_expr *f, gfc_expr *i, gfc_expr *j)
 {
   /* If the kind of i and j are different, then g77 cross-promoted the
-     kinds to the largest value.  The Fortran 95 standard requires the 
+     kinds to the largest value.  The Fortran 95 standard requires the
      kinds to match.  */
   if (i->ts.kind != j->ts.kind)
     {
@@ -1316,7 +1316,7 @@ void
 gfc_resolve_ieor (gfc_expr *f, gfc_expr *i, gfc_expr *j)
 {
   /* If the kind of i and j are different, then g77 cross-promoted the
-     kinds to the largest value.  The Fortran 95 standard requires the 
+     kinds to the largest value.  The Fortran 95 standard requires the
      kinds to match.  */
   if (i->ts.kind != j->ts.kind)
     {
@@ -1335,7 +1335,7 @@ void
 gfc_resolve_ior (gfc_expr *f, gfc_expr *i, gfc_expr *j)
 {
   /* If the kind of i and j are different, then g77 cross-promoted the
-     kinds to the largest value.  The Fortran 95 standard requires the 
+     kinds to the largest value.  The Fortran 95 standard requires the
      kinds to match.  */
   if (i->ts.kind != j->ts.kind)
     {
@@ -1435,7 +1435,7 @@ gfc_resolve_isatty (gfc_expr *f, gfc_expr *u)
 {
   gfc_typespec ts;
   gfc_clear_ts (&ts);
-  
+
   f->ts.type = BT_LOGICAL;
   f->ts.kind = gfc_default_integer_kind;
   if (u->ts.kind != gfc_c_int_kind)
@@ -1642,7 +1642,7 @@ gfc_resolve_matmul (gfc_expr *f, gfc_expr *a, gfc_expr *b)
 	  mpz_init_set (f->shape[0], b->shape[1]);
 	}
     }
-  else 
+  else
     {
       /* b->rank == 1 and a->rank == 2 here, all other cases have
 	 been caught in check.c.   */
@@ -2961,6 +2961,19 @@ gfc_resolve_image_status (gfc_expr *f, gfc_expr *image ATTRIBUTE_UNUSED,
 }
 
 
+/* Resolve get_team ().  */
+
+void
+gfc_resolve_get_team (gfc_expr *f, gfc_expr *level ATTRIBUTE_UNUSED)
+{
+  static char get_team[] = "_gfortran_caf_get_team";
+  f->rank = 0;
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = get_team;
+}
+
+
 /* Resolve image_index (...).  */
 
 void
@@ -2991,6 +3004,19 @@ gfc_resolve_stopped_images (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED,
 }
 
 
+/* Resolve team_number (team).  */
+
+void
+gfc_resolve_team_number (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED)
+{
+  static char team_number[] = "_gfortran_caf_team_number";
+  f->rank = 0;
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = team_number;
+}
+
+
 void
 gfc_resolve_this_image (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
 			gfc_expr *distance ATTRIBUTE_UNUSED)
@@ -3180,7 +3206,7 @@ gfc_resolve_ttynam (gfc_expr *f, gfc_expr *unit)
 {
   gfc_typespec ts;
   gfc_clear_ts (&ts);
-  
+
   f->ts.type = BT_CHARACTER;
   f->ts.kind = gfc_default_character_kind;
 
@@ -3399,7 +3425,7 @@ gfc_resolve_random_number (gfc_code *c)
     name = gfc_get_string (PREFIX ("random_r%d"), kind);
   else
     name = gfc_get_string (PREFIX ("arandom_r%d"), kind);
-  
+
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
@@ -3444,7 +3470,7 @@ gfc_resolve_kill_sub (gfc_code *c)
   name = gfc_get_string (PREFIX ("kill_i%d_sub"), kind);
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
-    
+
 
 void
 gfc_resolve_link_sub (gfc_code *c)
@@ -3777,7 +3803,7 @@ gfc_resolve_ctime_sub (gfc_code *c)
 {
   gfc_typespec ts;
   gfc_clear_ts (&ts);
-  
+
   /* ctime TIME argument is a INTEGER(KIND=8), says the doc */
   if (c->ext.actual->expr->ts.kind != 8)
     {
@@ -3961,7 +3987,7 @@ gfc_resolve_fput_sub (gfc_code *c)
 }
 
 
-void 
+void
 gfc_resolve_fseek_sub (gfc_code *c)
 {
   gfc_expr *unit;
@@ -4035,7 +4061,7 @@ gfc_resolve_ttynam_sub (gfc_code *c)
 {
   gfc_typespec ts;
   gfc_clear_ts (&ts);
-  
+
   if (c->ext.actual->expr->ts.kind != gfc_c_int_kind)
     {
       ts.type = BT_INTEGER;
diff --git a/gcc/fortran/iso-fortran-env.def b/gcc/fortran/iso-fortran-env.def
index b150e49f222..25f9e0991ba 100644
--- a/gcc/fortran/iso-fortran-env.def
+++ b/gcc/fortran/iso-fortran-env.def
@@ -128,6 +128,11 @@ NAMED_DERIVED_TYPE (ISOFORTRAN_EVENT_TYPE, "event_type", \
 		    ?  get_int_kind_from_node (ptr_type_node)
 		    : gfc_default_integer_kind, GFC_STD_F2008_TS)
 
+NAMED_DERIVED_TYPE (ISOFORTRAN_TEAM_TYPE, "team_type", \
+		    flag_coarray == GFC_FCOARRAY_LIB
+		    ? get_int_kind_from_node (ptr_type_node)
+		    : gfc_default_integer_kind, GFC_STD_F2008_TS)
+
 #undef NAMED_INTCST
 #undef NAMED_KINDARRAY
 #undef NAMED_FUNCTION
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 320a0d8af55..c822f2436e3 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1596,11 +1596,13 @@ gfc_match_if (gfc_statement *if_type)
   match ("assign", gfc_match_assign, ST_LABEL_ASSIGNMENT)
   match ("backspace", gfc_match_backspace, ST_BACKSPACE)
   match ("call", gfc_match_call, ST_CALL)
+  match ("change team", gfc_match_change_team, ST_CHANGE_TEAM)
   match ("close", gfc_match_close, ST_CLOSE)
   match ("continue", gfc_match_continue, ST_CONTINUE)
   match ("cycle", gfc_match_cycle, ST_CYCLE)
   match ("deallocate", gfc_match_deallocate, ST_DEALLOCATE)
   match ("end file", gfc_match_endfile, ST_END_FILE)
+  match ("end team", gfc_match_end_team, ST_END_TEAM)
   match ("error stop", gfc_match_error_stop, ST_ERROR_STOP)
   match ("event post", gfc_match_event_post, ST_EVENT_POST)
   match ("event wait", gfc_match_event_wait, ST_EVENT_WAIT)
@@ -1608,6 +1610,7 @@ gfc_match_if (gfc_statement *if_type)
   match ("fail image", gfc_match_fail_image, ST_FAIL_IMAGE)
   match ("flush", gfc_match_flush, ST_FLUSH)
   match ("forall", match_simple_forall, ST_FORALL)
+  match ("form team", gfc_match_form_team, ST_FORM_TEAM)
   match ("go to", gfc_match_goto, ST_GOTO)
   match ("if", match_arithmetic_if, ST_ARITHMETIC_IF)
   match ("inquire", gfc_match_inquire, ST_INQUIRE)
@@ -1624,6 +1627,7 @@ gfc_match_if (gfc_statement *if_type)
   match ("sync all", gfc_match_sync_all, ST_SYNC_CALL);
   match ("sync images", gfc_match_sync_images, ST_SYNC_IMAGES);
   match ("sync memory", gfc_match_sync_memory, ST_SYNC_MEMORY);
+  match ("sync team", gfc_match_sync_team, ST_SYNC_TEAM)
   match ("unlock", gfc_match_unlock, ST_UNLOCK)
   match ("where", match_simple_where, ST_WHERE)
   match ("write", gfc_match_write, ST_WRITE)
@@ -3348,6 +3352,131 @@ syntax:
   return MATCH_ERROR;
 }
 
+/* Match a FORM TEAM statement.  */
+
+match
+gfc_match_form_team (void)
+{
+  match m;
+  gfc_expr *teamid,*team;
+
+  if (!gfc_notify_std (GFC_STD_F2008_TS, "FORM TEAM statement at %C"))
+    return MATCH_ERROR;
+
+  if (gfc_match_char ('(') == MATCH_NO)
+    goto syntax;
+  
+  new_st.op = EXEC_FORM_TEAM;
+
+  if (gfc_match ("%e", &teamid) != MATCH_YES)
+    goto syntax;
+  m = gfc_match_char (',');
+  if (m == MATCH_ERROR)
+    goto syntax;
+  if (gfc_match ("%e", &team) != MATCH_YES)
+    goto syntax;
+
+  m = gfc_match_char (')');
+  if (m == MATCH_NO)
+    goto syntax;
+
+  new_st.expr1 = teamid;
+  new_st.expr2 = team;
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_FORM_TEAM);
+
+  return MATCH_ERROR;
+}
+
+/* Match a CHANGE TEAM statement.  */
+
+match
+gfc_match_change_team (void)
+{
+  match m;
+  gfc_expr *team;
+
+  if (!gfc_notify_std (GFC_STD_F2008_TS, "CHANGE TEAM statement at %C"))
+    return MATCH_ERROR;
+
+  if (gfc_match_char ('(') == MATCH_NO)
+    goto syntax;
+  
+  new_st.op = EXEC_CHANGE_TEAM;
+
+  if (gfc_match ("%e", &team) != MATCH_YES)
+    goto syntax;
+
+  m = gfc_match_char (')');
+  if (m == MATCH_NO)
+    goto syntax;
+
+  new_st.expr1 = team;
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_CHANGE_TEAM);
+
+  return MATCH_ERROR;
+}
+
+/* Match a END TEAM statement.  */
+
+match
+gfc_match_end_team (void)
+{
+  if (!gfc_notify_std (GFC_STD_F2008_TS, "END TEAM statement at %C"))
+    return MATCH_ERROR;
+
+  if (gfc_match_char ('(') == MATCH_YES)
+    goto syntax;
+  
+  new_st.op = EXEC_END_TEAM;
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_END_TEAM);
+
+  return MATCH_ERROR;
+}
+
+/* Match a SYNC TEAM statement.  */
+
+match
+gfc_match_sync_team (void)
+{
+  match m;
+  gfc_expr *team;
+
+  if (!gfc_notify_std (GFC_STD_F2008_TS, "SYNC TEAM statement at %C"))
+    return MATCH_ERROR;
+
+  if (gfc_match_char ('(') == MATCH_NO)
+    goto syntax;
+  
+  new_st.op = EXEC_SYNC_TEAM;
+
+  if (gfc_match ("%e", &team) != MATCH_YES)
+    goto syntax;
+
+  m = gfc_match_char (')');
+  if (m == MATCH_NO)
+    goto syntax;
+
+  new_st.expr1 = team;
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_SYNC_TEAM);
+
+  return MATCH_ERROR;
+}
 
 /* Match LOCK/UNLOCK statement. Syntax:
      LOCK ( lock-variable [ , lock-stat-list ] )
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 2e04b3e22ac..65c6744a16e 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -74,6 +74,10 @@ match gfc_match_event_post (void);
 match gfc_match_event_wait (void);
 match gfc_match_critical (void);
 match gfc_match_fail_image (void);
+match gfc_match_change_team (void);
+match gfc_match_end_team (void);
+match gfc_match_form_team (void);
+match gfc_match_sync_team (void);
 match gfc_match_block (void);
 match gfc_match_associate (void);
 match gfc_match_do (void);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index d63d7bc989f..a3693a192f0 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -451,6 +451,7 @@ decode_statement (void)
 
     case 'c':
       match ("call", gfc_match_call, ST_CALL);
+      match ("change team", gfc_match_change_team, ST_CHANGE_TEAM);
       match ("close", gfc_match_close, ST_CLOSE);
       match ("continue", gfc_match_continue, ST_CONTINUE);
       match ("contiguous", gfc_match_contiguous, ST_ATTR_DECL);
@@ -470,6 +471,7 @@ decode_statement (void)
 
     case 'e':
       match ("end file", gfc_match_endfile, ST_END_FILE);
+      match ("end team", gfc_match_end_team, ST_END_TEAM);
       match ("exit", gfc_match_exit, ST_EXIT);
       match ("else", gfc_match_else, ST_ELSE);
       match ("else where", gfc_match_elsewhere, ST_ELSEWHERE);
@@ -491,6 +493,7 @@ decode_statement (void)
       match ("fail image", gfc_match_fail_image, ST_FAIL_IMAGE);
       match ("final", gfc_match_final_decl, ST_FINAL);
       match ("flush", gfc_match_flush, ST_FLUSH);
+      match ("form team", gfc_match_form_team, ST_FORM_TEAM);
       match ("format", gfc_match_format, ST_FORMAT);
       break;
 
@@ -558,6 +561,7 @@ decode_statement (void)
       match ("sync all", gfc_match_sync_all, ST_SYNC_ALL);
       match ("sync images", gfc_match_sync_images, ST_SYNC_IMAGES);
       match ("sync memory", gfc_match_sync_memory, ST_SYNC_MEMORY);
+      match ("sync team", gfc_match_sync_team, ST_SYNC_TEAM);
       break;
 
     case 't':
@@ -1503,6 +1507,8 @@ next_statement (void)
   case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: \
   case ST_ERROR_STOP: case ST_SYNC_ALL: \
   case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \
+  case ST_FORM_TEAM: case ST_CHANGE_TEAM: \
+  case ST_END_TEAM: case ST_SYNC_TEAM: \
   case ST_EVENT_POST: case ST_EVENT_WAIT: case ST_FAIL_IMAGE: \
   case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \
   case ST_OACC_ENTER_DATA: case ST_OACC_EXIT_DATA
@@ -1834,6 +1840,18 @@ gfc_ascii_statement (gfc_statement st)
     case ST_FAIL_IMAGE:
       p = "FAIL IMAGE";
       break;
+    case ST_CHANGE_TEAM:
+      p = "CHANGE TEAM";
+      break;
+    case ST_END_TEAM:
+      p = "END TEAM";
+      break;
+    case ST_FORM_TEAM:
+      p = "FORM TEAM";
+      break;
+    case ST_SYNC_TEAM:
+      p = "SYNC TEAM";
+      break;
     case ST_END_ASSOCIATE:
       p = "END ASSOCIATE";
       break;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 1ecfe05ed79..23f92da96ed 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11102,6 +11102,10 @@ start:
 	  break;
 
 	case EXEC_FAIL_IMAGE:
+	case EXEC_FORM_TEAM:
+	case EXEC_CHANGE_TEAM:
+	case EXEC_END_TEAM:
+	case EXEC_SYNC_TEAM:
 	  break;
 
 	case EXEC_ENTRY:
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index b7c6b02081f..6577101874c 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -2890,6 +2890,30 @@ gfc_simplify_failed_or_stopped_images (gfc_expr *team ATTRIBUTE_UNUSED,
 }
 
 
+gfc_expr *
+gfc_simplify_get_team (gfc_expr *level ATTRIBUTE_UNUSED)
+{
+  if (flag_coarray == GFC_FCOARRAY_NONE)
+    {
+      gfc_current_locus = *gfc_current_intrinsic_where;
+      gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to enable");
+      return &gfc_bad_expr;
+    }
+
+  if (flag_coarray == GFC_FCOARRAY_SINGLE)
+    {
+      gfc_expr *result;
+      result = gfc_get_array_expr (BT_INTEGER, gfc_default_integer_kind, &gfc_current_locus);
+      result->rank = 0;
+      return result;
+    }
+
+  /* For fcoarray = lib no simplification is possible, because it is not known
+     what images failed or are stopped at compile time.  */
+  return NULL;
+}
+
+
 gfc_expr *
 gfc_simplify_float (gfc_expr *a)
 {
@@ -3056,7 +3080,7 @@ gfc_simplify_fraction (gfc_expr *x)
 
 #if MPFR_VERSION < MPFR_VERSION_NUM(3,1,0)
 
-  /* MPFR versions before 3.1.0 do not include mpfr_frexp.  
+  /* MPFR versions before 3.1.0 do not include mpfr_frexp.
      TODO: remove the kludge when MPFR 3.1.0 or newer will be required */
 
   if (mpfr_sgn (x->value.real) == 0)
@@ -7333,7 +7357,7 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
 	|| !gfc_is_constant_expr (size))
     return NULL;
 
-  if (!gfc_calculate_transfer_sizes (source, mold, size, &source_size, 
+  if (!gfc_calculate_transfer_sizes (source, mold, size, &source_size,
 				     &result_size, &result_length))
     return NULL;
 
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 1de7de7de5a..7603cbd94ad 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -121,6 +121,10 @@ gfc_free_statement (gfc_code *p)
     case EXEC_EVENT_POST:
     case EXEC_EVENT_WAIT:
     case EXEC_FAIL_IMAGE:
+    case EXEC_CHANGE_TEAM:
+    case EXEC_END_TEAM:
+    case EXEC_FORM_TEAM:
+    case EXEC_SYNC_TEAM:
       break;
 
     case EXEC_BLOCK:
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 144a3447769..9b0b2a14b8d 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -157,6 +157,12 @@ tree gfor_fndecl_caf_fail_image;
 tree gfor_fndecl_caf_failed_images;
 tree gfor_fndecl_caf_image_status;
 tree gfor_fndecl_caf_stopped_images;
+tree gfor_fndecl_caf_form_team;
+tree gfor_fndecl_caf_change_team;
+tree gfor_fndecl_caf_end_team;
+tree gfor_fndecl_caf_sync_team;
+tree gfor_fndecl_caf_get_team;
+tree gfor_fndecl_caf_team_number;
 tree gfor_fndecl_co_broadcast;
 tree gfor_fndecl_co_max;
 tree gfor_fndecl_co_min;
@@ -3363,7 +3369,7 @@ gfc_build_intrinsic_function_decls (void)
 	    jtype = gfc_get_int_type (ikinds[jkind]);
 	    if (itype && jtype)
 	      {
-		sprintf(name, PREFIX("pow_i%d_i%d"), ikinds[ikind],
+		sprintf (name, PREFIX("pow_i%d_i%d"), ikinds[ikind],
 			ikinds[jkind]);
 		gfor_fndecl_math_powi[jkind][ikind].integer =
 		  gfc_build_library_function_decl (get_identifier (name),
@@ -3378,7 +3384,7 @@ gfc_build_intrinsic_function_decls (void)
 	    rtype = gfc_get_real_type (rkinds[rkind]);
 	    if (rtype && itype)
 	      {
-		sprintf(name, PREFIX("pow_r%d_i%d"), rkinds[rkind],
+		sprintf (name, PREFIX("pow_r%d_i%d"), rkinds[rkind],
 			ikinds[ikind]);
 		gfor_fndecl_math_powi[rkind][ikind].real =
 		  gfc_build_library_function_decl (get_identifier (name),
@@ -3390,7 +3396,7 @@ gfc_build_intrinsic_function_decls (void)
 	    ctype = gfc_get_complex_type (rkinds[rkind]);
 	    if (ctype && itype)
 	      {
-		sprintf(name, PREFIX("pow_c%d_i%d"), rkinds[rkind],
+		sprintf (name, PREFIX("pow_c%d_i%d"), rkinds[rkind],
 			ikinds[ikind]);
 		gfor_fndecl_math_powi[rkind][ikind].cmplx =
 		  gfc_build_library_function_decl (get_identifier (name),
@@ -3642,10 +3648,10 @@ gfc_build_builtin_function_decls (void)
 	boolean_type_node, pint_type);
 
       gfor_fndecl_caf_send = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("caf_send")), ".R.RRRRRRW", void_type_node, 10,
+	get_identifier (PREFIX("caf_send")), ".R.RRRRRRWR", void_type_node, 11,
 	pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
 	pvoid_type_node, pvoid_type_node, integer_type_node, integer_type_node,
-	boolean_type_node, pint_type);
+	boolean_type_node, pint_type, pvoid_type_node);
 
       gfor_fndecl_caf_sendget = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_sendget")), ".R.RRRR.RRRRRR",
@@ -3769,6 +3775,38 @@ gfc_build_builtin_function_decls (void)
 	    void_type_node, 3, pvoid_type_node, ppvoid_type_node,
 	    integer_type_node);
 
+      gfor_fndecl_caf_form_team
+	= gfc_build_library_function_decl_with_spec (
+	    get_identifier (PREFIX("caf_form_team")), "RWR",
+	    void_type_node, 3, integer_type_node, ppvoid_type_node,
+	    integer_type_node);
+
+      gfor_fndecl_caf_change_team
+	= gfc_build_library_function_decl_with_spec (
+	    get_identifier (PREFIX("caf_change_team")), "RR",
+	    void_type_node, 2, ppvoid_type_node,
+	    integer_type_node);
+
+      gfor_fndecl_caf_end_team
+	= gfc_build_library_function_decl (
+	    get_identifier (PREFIX("caf_end_team")), void_type_node, 0);
+
+      gfor_fndecl_caf_get_team
+	= gfc_build_library_function_decl_with_spec (
+	    get_identifier (PREFIX("caf_get_team")), "R",
+	    void_type_node, 1, integer_type_node);
+
+      gfor_fndecl_caf_sync_team
+	= gfc_build_library_function_decl_with_spec (
+	    get_identifier (PREFIX("caf_sync_team")), "RR",
+	    void_type_node, 2, ppvoid_type_node,
+	    integer_type_node);
+
+      gfor_fndecl_caf_team_number
+      	= gfc_build_library_function_decl_with_spec (
+      	    get_identifier (PREFIX("caf_team_number")), "R",
+      	    integer_type_node, 1, integer_type_node);
+
       gfor_fndecl_caf_image_status
 	= gfc_build_library_function_decl_with_spec (
 	    get_identifier (PREFIX("caf_image_status")), "RR",
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index f4defb079b4..4d069965505 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1846,11 +1846,11 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
 
 static tree
 conv_caf_send (gfc_code *code) {
-  gfc_expr *lhs_expr, *rhs_expr, *tmp_stat;
+  gfc_expr *lhs_expr, *rhs_expr, *tmp_stat, *tmp_team;
   gfc_se lhs_se, rhs_se;
   stmtblock_t block;
   tree caf_decl, token, offset, image_index, tmp, lhs_kind, rhs_kind;
-  tree may_require_tmp, src_stat, dst_stat;
+  tree may_require_tmp, src_stat, dst_stat, dst_team;
   tree lhs_type = NULL_TREE;
   tree vec = null_pointer_node, rhs_vec = null_pointer_node;
   symbol_attribute lhs_caf_attr, rhs_caf_attr;
@@ -1866,6 +1866,7 @@ conv_caf_send (gfc_code *code) {
   lhs_caf_attr = gfc_caf_attr (lhs_expr);
   rhs_caf_attr = gfc_caf_attr (rhs_expr);
   src_stat = dst_stat = null_pointer_node;
+  dst_team = null_pointer_node;
 
   /* LHS.  */
   gfc_init_se (&lhs_se, NULL);
@@ -2077,6 +2078,18 @@ conv_caf_send (gfc_code *code) {
       gfc_add_block_to_block (&block, &stat_se.post);
     }
 
+  tmp_team = gfc_find_team_co (lhs_expr);
+
+  if (tmp_team)
+    {
+      gfc_se team_se;
+      gfc_init_se (&team_se, NULL);
+      gfc_conv_expr_reference (&team_se, tmp_team);
+      dst_team = team_se.expr;
+      gfc_add_block_to_block (&block, &team_se.pre);
+      gfc_add_block_to_block (&block, &team_se.post);
+    }
+
   if (!gfc_is_coindexed (rhs_expr))
     {
       if (lhs_caf_attr.alloc_comp || lhs_caf_attr.pointer_comp)
@@ -2092,10 +2105,10 @@ conv_caf_send (gfc_code *code) {
 				     may_require_tmp, dst_realloc, src_stat);
 	  }
       else
-	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 10,
+	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 11,
 				   token, offset, image_index, lhs_se.expr, vec,
 				   rhs_se.expr, lhs_kind, rhs_kind,
-				   may_require_tmp, src_stat);
+				   may_require_tmp, src_stat, dst_team);
     }
   else
     {
@@ -2432,6 +2445,48 @@ conv_intrinsic_image_status (gfc_se *se, gfc_expr *expr)
   se->expr = tmp;
 }
 
+static void
+conv_intrinsic_team_number (gfc_se *se, gfc_expr *expr)
+{
+  unsigned int num_args;
+
+  tree *args, tmp;
+
+  num_args = gfc_intrinsic_argument_list_length (expr);
+  args = XALLOCAVEC (tree, num_args);
+  gfc_conv_intrinsic_function_args (se, expr, args, num_args);
+
+  if (flag_coarray ==
+      GFC_FCOARRAY_SINGLE && expr->value.function.actual->expr)
+    {
+      tree arg;
+
+      arg = gfc_evaluate_now (args[0], &se->pre);
+      tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
+      			     fold_convert (integer_type_node, arg),
+      			     integer_one_node);
+      tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node,
+      			     tmp, integer_zero_node,
+      			     build_int_cst (integer_type_node,
+      					    GFC_STAT_STOPPED_IMAGE));
+    }
+  else if (flag_coarray == GFC_FCOARRAY_SINGLE)
+    {
+      // the value -1 represents that no team has been created yet
+      tmp = build_int_cst (integer_type_node, -1);
+    }
+  else if (flag_coarray == GFC_FCOARRAY_LIB && expr->value.function.actual->expr)
+    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_team_number, 1,
+			       args[0], build_int_cst (integer_type_node, -1));
+  else if (flag_coarray == GFC_FCOARRAY_LIB)
+    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_team_number, 1,
+		integer_zero_node, build_int_cst (integer_type_node, -1));
+  else
+    gcc_unreachable ();
+
+  se->expr = tmp;
+}
+
 
 static void
 trans_image_index (gfc_se * se, gfc_expr *expr)
@@ -2553,7 +2608,6 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
 			      build_int_cst (type, 0), tmp);
 }
 
-
 static void
 trans_num_images (gfc_se * se, gfc_expr *expr)
 {
@@ -2581,7 +2635,6 @@ trans_num_images (gfc_se * se, gfc_expr *expr)
     }
   else
     failed = build_int_cst (integer_type_node, -1);
-
   tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images, 2,
 			     distance, failed);
   se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind), tmp);
@@ -2998,7 +3051,6 @@ conv_intrinsic_stride (gfc_se * se, gfc_expr * expr)
   se->expr = gfc_conv_descriptor_stride_get (desc, tmp);
 }
 
-
 static void
 gfc_conv_intrinsic_abs (gfc_se * se, gfc_expr * expr)
 {
@@ -4582,7 +4634,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
 
   /* Special case for character maxloc.  Remove unneeded actual
      arguments, then call a library function.  */
-  
+
   if (arrayexpr->ts.type == BT_CHARACTER)
     {
       gfc_actual_arglist *a, *b;
@@ -6097,7 +6149,6 @@ conv_generic_with_optional_char_arg (gfc_se* se, gfc_expr* expr,
   gfc_free_symbol (sym);
 }
 
-
 /* The length of a character string.  */
 static void
 gfc_conv_intrinsic_len (gfc_se * se, gfc_expr * expr)
@@ -8656,7 +8707,7 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
 	    case GFC_ISYM_MINLOC:
 	      gfc_conv_intrinsic_minmaxloc (se, expr, LT_EXPR);
 	      break;
-	      
+
 	    case GFC_ISYM_MAXLOC:
 	      gfc_conv_intrinsic_minmaxloc (se, expr, GT_EXPR);
 	      break;
@@ -9184,6 +9235,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_arith (se, expr, PLUS_EXPR, false);
       break;
 
+    case GFC_ISYM_TEAM_NUMBER:
+      conv_intrinsic_team_number (se, expr);
+      break;
+
     case GFC_ISYM_TRANSFER:
       if (se->ss && se->ss->info->useflags)
 	/* Access the previously obtained result.  */
@@ -9581,6 +9636,7 @@ gfc_is_intrinsic_libcall (gfc_expr * expr)
 
     case GFC_ISYM_CSHIFT:
     case GFC_ISYM_EOSHIFT:
+    case GFC_ISYM_GET_TEAM:
     case GFC_ISYM_FAILED_IMAGES:
     case GFC_ISYM_STOPPED_IMAGES:
     case GFC_ISYM_PACK:
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index ff6e5914319..0fa69c071a9 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -696,6 +696,110 @@ gfc_trans_fail_image (gfc_code *code ATTRIBUTE_UNUSED)
     }
 }
 
+/* Translate the FORM TEAM statement.  */
+
+tree
+gfc_trans_form_team (gfc_code *code)
+{
+  if (flag_coarray == GFC_FCOARRAY_LIB)
+    {
+      gfc_se argse;
+      tree team_id,team_type;
+      gfc_init_se (&argse, NULL);
+      gfc_conv_expr_val (&argse, code->expr1);
+      team_id = fold_convert (integer_type_node, argse.expr);
+      gfc_init_se (&argse, NULL);
+      gfc_conv_expr_val (&argse, code->expr2);
+      team_type = gfc_build_addr_expr (ppvoid_type_node, argse.expr);
+
+      return build_call_expr_loc (input_location,
+				  gfor_fndecl_caf_form_team, 3,
+				  team_id, team_type,
+				  build_int_cst (integer_type_node, 0));
+    }
+  else
+    {
+      const char *name = gfc_get_string (PREFIX ("exit_i%d"), 4);
+      gfc_symbol *exsym = gfc_get_intrinsic_sub_symbol (name);
+      tree tmp = gfc_get_symbol_decl (exsym);
+      return build_call_expr_loc (input_location, tmp, 1, integer_zero_node);
+    }
+}
+
+/* Translate the CHANGE TEAM statement.  */
+
+tree
+gfc_trans_change_team (gfc_code *code)
+{
+  if (flag_coarray == GFC_FCOARRAY_LIB)
+    {
+      gfc_se argse;
+      tree team_type;
+
+      gfc_init_se (&argse, NULL);
+      gfc_conv_expr_val (&argse, code->expr1);
+      team_type = gfc_build_addr_expr (ppvoid_type_node, argse.expr);
+
+      return build_call_expr_loc (input_location,
+				  gfor_fndecl_caf_change_team, 2, team_type,
+				  build_int_cst (integer_type_node, 0));
+    }
+  else
+    {
+      const char *name = gfc_get_string (PREFIX ("exit_i%d"), 4);
+      gfc_symbol *exsym = gfc_get_intrinsic_sub_symbol (name);
+      tree tmp = gfc_get_symbol_decl (exsym);
+      return build_call_expr_loc (input_location, tmp, 1, integer_zero_node);
+    }
+}
+
+/* Translate the END TEAM statement.  */
+
+tree
+gfc_trans_end_team (gfc_code *code ATTRIBUTE_UNUSED)
+{
+  if (flag_coarray == GFC_FCOARRAY_LIB)
+    {
+      return build_call_expr_loc (input_location,
+				  gfor_fndecl_caf_end_team, 1,
+				  build_int_cst (pchar_type_node, 0));
+    }
+  else
+    {
+      const char *name = gfc_get_string (PREFIX ("exit_i%d"), 4);
+      gfc_symbol *exsym = gfc_get_intrinsic_sub_symbol (name);
+      tree tmp = gfc_get_symbol_decl (exsym);
+      return build_call_expr_loc (input_location, tmp, 1, integer_zero_node);
+    }
+}
+
+/* Translate the SYNC TEAM statement.  */
+
+tree
+gfc_trans_sync_team (gfc_code *code)
+{
+  if (flag_coarray == GFC_FCOARRAY_LIB)
+    {
+      gfc_se argse;
+      tree team_type;
+
+      gfc_init_se (&argse, NULL);
+      gfc_conv_expr_val (&argse, code->expr1);
+      team_type = gfc_build_addr_expr (ppvoid_type_node, argse.expr);
+
+      return build_call_expr_loc (input_location,
+				  gfor_fndecl_caf_sync_team, 2,
+				  team_type,
+				  build_int_cst (integer_type_node, 0));
+    }
+  else
+    {
+      const char *name = gfc_get_string (PREFIX ("exit_i%d"), 4);
+      gfc_symbol *exsym = gfc_get_intrinsic_sub_symbol (name);
+      tree tmp = gfc_get_symbol_decl (exsym);
+      return build_call_expr_loc (input_location, tmp, 1, integer_zero_node);
+    }
+}
 
 tree
 gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op)
diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h
index 130058dd01e..c798c80e7a7 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -58,6 +58,10 @@ tree gfc_trans_lock_unlock (gfc_code *, gfc_exec_op);
 tree gfc_trans_event_post_wait (gfc_code *, gfc_exec_op);
 tree gfc_trans_fail_image (gfc_code *);
 tree gfc_trans_forall (gfc_code *);
+tree gfc_trans_form_team (gfc_code *);
+tree gfc_trans_change_team (gfc_code *);
+tree gfc_trans_end_team (gfc_code *);
+tree gfc_trans_sync_team (gfc_code *);
 tree gfc_trans_where (gfc_code *);
 tree gfc_trans_allocate (gfc_code *);
 tree gfc_trans_deallocate (gfc_code *);
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index abcbf957e5d..e8583d5fd38 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -2501,12 +2501,14 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen)
       || (flag_coarray == GFC_FCOARRAY_LIB
 	  && derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
 	  && (derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE
-	      || derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE)))
+	      || derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE
+	      || derived->intmod_sym_id == ISOFORTRAN_TEAM_TYPE)))
     return ptr_type_node;
 
   if (flag_coarray != GFC_FCOARRAY_LIB
       && derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
-      && derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE)
+      && (derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE
+	  || derived->intmod_sym_id == ISOFORTRAN_TEAM_TYPE))
     return gfc_get_int_type (gfc_default_integer_kind);
 
   if (derived && derived->attr.flavor == FL_PROCEDURE
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 9ce7debb1e4..aa10fbb405a 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1972,6 +1972,22 @@ trans_code (gfc_code * code, tree cond)
 	  res = gfc_trans_forall (code);
 	  break;
 
+	case EXEC_FORM_TEAM:
+	  res = gfc_trans_form_team (code);
+	  break;
+
+	case EXEC_CHANGE_TEAM:
+	  res = gfc_trans_change_team (code);
+	  break;
+
+	case EXEC_END_TEAM:
+	  res = gfc_trans_end_team (code);
+	  break;
+
+	case EXEC_SYNC_TEAM:
+	  res = gfc_trans_sync_team (code);
+	  break;
+
 	case EXEC_WHERE:
 	  res = gfc_trans_where (code);
 	  break;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 31b0930350d..1785936696a 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -837,6 +837,12 @@ extern GTY(()) tree gfor_fndecl_caf_fail_image;
 extern GTY(()) tree gfor_fndecl_caf_failed_images;
 extern GTY(()) tree gfor_fndecl_caf_image_status;
 extern GTY(()) tree gfor_fndecl_caf_stopped_images;
+extern GTY(()) tree gfor_fndecl_caf_form_team;
+extern GTY(()) tree gfor_fndecl_caf_change_team;
+extern GTY(()) tree gfor_fndecl_caf_end_team;
+extern GTY(()) tree gfor_fndecl_caf_get_team;
+extern GTY(()) tree gfor_fndecl_caf_sync_team;
+extern GTY(()) tree gfor_fndecl_caf_team_number;
 extern GTY(()) tree gfor_fndecl_co_broadcast;
 extern GTY(()) tree gfor_fndecl_co_max;
 extern GTY(()) tree gfor_fndecl_co_min;
diff --git a/gcc/testsuite/gfortran.dg/team_change_1.f90 b/gcc/testsuite/gfortran.dg/team_change_1.f90
new file mode 100644
index 00000000000..1dd42082b04
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/team_change_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-fcoarray=single" }
+!
+! Tests if change team worked
+!
+  use iso_fortran_env, only : team_type
+  implicit none
+  type(team_type) team
+  integer new_team
+
+  new_team = mod(this_image(),2)+1
+
+  form team (new_team,team)
+    change team (team)
+    if (team_number()/=new_team) call abort
+  end team
+
+end
diff --git a/gcc/testsuite/gfortran.dg/team_end_1.f90 b/gcc/testsuite/gfortran.dg/team_end_1.f90
new file mode 100644
index 00000000000..5a05b7fc87d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/team_end_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-fcoarray=single" }
+!
+! Tests if team_number intrinsic fucntion works
+!
+  use iso_fortran_env, only : team_type
+  implicit none
+  type(team_type) :: team
+  integer, parameter :: standard_initial_value=-1
+
+  associate(new_team => mod(this_image(),2)+1)
+    form team (new_team,team)
+      change team (team)
+    end team
+  end associate
+
+  if (team_number()/=standard_initial_value) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/team_form_1.f90 b/gcc/testsuite/gfortran.dg/team_form_1.f90
new file mode 100644
index 00000000000..63cabfaf199
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/team_form_1.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! { dg-options "-fcoarray=single" }
+!
+! Tests if form team works
+!
+  use iso_fortran_env, only : team_type
+  implicit none
+  type(team_type) :: team
+
+  form team (mod(this_image(),2)+1,team)
+end
+
+
+
diff --git a/gcc/testsuite/gfortran.dg/team_number_1.f90 b/gcc/testsuite/gfortran.dg/team_number_1.f90
new file mode 100644
index 00000000000..77a18527e0a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/team_number_1.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! { dg-options "-fcoarray=single" }
+!
+! Tests if team_number intrinsic fucntion works
+!
+  use iso_fortran_env, only : team_type
+  implicit none
+  type(team_type) team
+  integer, parameter :: standard_initial_value=-1
+  integer new_team
+
+  if (team_number()/=standard_initial_value) call abort
+
+  new_team = mod(this_image(),2)+1
+  form team (new_team,team)
+    change team (team)
+    if (team_number()/=new_team) call abort
+  end team
+
+  if (team_number()/=standard_initial_value) call abort
+end

Re: [PATCH, fortran] Support Fortran 2018 teams

[Steve Kargl]

index 882fe577b76..b4baf5be554 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -158,6 +158,7 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec
*as, int init,
   bool matched_bracket = false;
   gfc_expr *tmp;
   bool stat_just_seen = false;
+  bool team_just_seen = false;

   memset (ar, '\0', sizeof (*ar));

@@ -230,8 +231,21 @@ coarray:
       if (m == MATCH_ERROR)
        return MATCH_ERROR;

+      team_just_seen = false;
       stat_just_seen = false;
-      if (gfc_match(" , stat = %e",&tmp) == MATCH_YES && ar->stat == NULL)
+      if (gfc_match (" , team = %e", &tmp) == MATCH_YES && ar->stat == NULL)


Is the 2nd ar->stat suppose to be ar->team?

-- 
Steve

Re: [PATCH, fortran] Support Fortran 2018 teams

[Alessandro Fanfarillo]

Yes, definitively ar->team.

On Fri, Jan 19, 2018 at 8:36 AM, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
> index 882fe577b76..b4baf5be554 100644
> --- a/gcc/fortran/array.c
> +++ b/gcc/fortran/array.c
> @@ -158,6 +158,7 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec
> *as, int init,
>    bool matched_bracket = false;
>    gfc_expr *tmp;
>    bool stat_just_seen = false;
> +  bool team_just_seen = false;
>
>    memset (ar, '\0', sizeof (*ar));
>
> @@ -230,8 +231,21 @@ coarray:
>        if (m == MATCH_ERROR)
>         return MATCH_ERROR;
>
> +      team_just_seen = false;
>        stat_just_seen = false;
> -      if (gfc_match(" , stat = %e",&tmp) == MATCH_YES && ar->stat == NULL)
> +      if (gfc_match (" , team = %e", &tmp) == MATCH_YES && ar->stat == NULL)
>
>
> Is the 2nd ar->stat suppose to be ar->team?
>
> --
> Steve



-- 

Alessandro Fanfarillo, Ph.D.
Postdoctoral Researcher
National Center for Atmospheric Research
Mesa Lab, Boulder, CO, USA
303-497-1229

Re: [PATCH, fortran] Support Fortran 2018 teams

[Damian Rouson]

Thanks for catching that, Steve, and for responding, Alessandro.

Anything else?

Damian

On January 19, 2018 at 9:17:03 AM, Alessandro Fanfarillo (elfanfa@ucar.edu) wrote:

Yes, definitively ar->team. 

On Fri, Jan 19, 2018 at 8:36 AM, Steve Kargl 
<sgk@troutmask.apl.washington.edu> wrote: 
> index 882fe577b76..b4baf5be554 100644 
> --- a/gcc/fortran/array.c 
> +++ b/gcc/fortran/array.c 
> @@ -158,6 +158,7 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec 
> *as, int init, 
> bool matched_bracket = false; 
> gfc_expr *tmp; 
> bool stat_just_seen = false; 
> + bool team_just_seen = false; 
> 
> memset (ar, '\0', sizeof (*ar)); 
> 
> @@ -230,8 +231,21 @@ coarray: 
> if (m == MATCH_ERROR) 
> return MATCH_ERROR; 
> 
> + team_just_seen = false; 
> stat_just_seen = false; 
> - if (gfc_match(" , stat = %e",&tmp) == MATCH_YES && ar->stat == NULL) 
> + if (gfc_match (" , team = %e", &tmp) == MATCH_YES && ar->stat == NULL) 
> 
> 
> Is the 2nd ar->stat suppose to be ar->team? 
> 
> -- 
> Steve 



-- 

Alessandro Fanfarillo, Ph.D. 
Postdoctoral Researcher 
National Center for Atmospheric Research 
Mesa Lab, Boulder, CO, USA 
303-497-1229 

Re: [PATCH, fortran] Support Fortran 2018 teams

[Steve Kargl]

On Fri, Jan 19, 2018 at 09:18:14AM -0800, Damian Rouson wrote:
> Thanks for catching that, Steve, and for responding, Alessandro.
> 
> Anything else?
> 

I've only just started to look at the patch.   Unfortunately,
I know zero about teams, so need to read the patch and F2018
standard simultaneously.

-- 
Steve

Re: [PATCH, fortran] Support Fortran 2018 teams

[Alessandro Fanfarillo]

I can confirm that the little change suggested by Steve passes the
regtests (on x86_64-pc-linux-gnu) and the regular tests using
OpenCoarrays.

On Fri, Jan 19, 2018 at 10:33 AM, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
> On Fri, Jan 19, 2018 at 09:18:14AM -0800, Damian Rouson wrote:
>> Thanks for catching that, Steve, and for responding, Alessandro.
>>
>> Anything else?
>>
>
> I've only just started to look at the patch.   Unfortunately,
> I know zero about teams, so need to read the patch and F2018
> standard simultaneously.
>
> --
> Steve



-- 

Alessandro Fanfarillo, Ph.D.
Postdoctoral Researcher
National Center for Atmospheric Research
Mesa Lab, Boulder, CO, USA
303-497-1229

Re: [PATCH, fortran] Support Fortran 2018 teams

[Damian Rouson]

Is Fortran 2018 teams patch ok for trunk?   

Damian

On January 19, 2018 at 2:47:39 PM, Alessandro Fanfarillo (elfanfa@ucar.edu) wrote:

I can confirm that the little change suggested by Steve passes the  
regtests (on x86_64-pc-linux-gnu) and the regular tests using  
OpenCoarrays.  

On Fri, Jan 19, 2018 at 10:33 AM, Steve Kargl  
<sgk@troutmask.apl.washington.edu> wrote:  
> On Fri, Jan 19, 2018 at 09:18:14AM -0800, Damian Rouson wrote:  
>> Thanks for catching that, Steve, and for responding, Alessandro.  
>>  
>> Anything else?  
>>  
>  
> I've only just started to look at the patch. Unfortunately,  
> I know zero about teams, so need to read the patch and F2018  
> standard simultaneously.  
>  
> --  
> Steve  



--  

Alessandro Fanfarillo, Ph.D.  
Postdoctoral Researcher  
National Center for Atmospheric Research  
Mesa Lab, Boulder, CO, USA  
303-497-1229  

Re: [PATCH, fortran] Support Fortran 2018 teams

[Steve Kargl]

I'm heading out of town for a meeting at the end of
week, so gfortran patches/reviews are on hold at the
moment.  If someone else wants to step up to review
the patch, I won't object.

-- 
steve

On Mon, Jan 22, 2018 at 08:29:41PM -0800, Damian Rouson wrote:
> Is Fortran 2018 teams patch ok for trunk?   
> 
> Damian
> 
> On January 19, 2018 at 2:47:39 PM, Alessandro Fanfarillo (elfanfa@ucar.edu) wrote:
> 
> I can confirm that the little change suggested by Steve passes the  
> regtests (on x86_64-pc-linux-gnu) and the regular tests using  
> OpenCoarrays.  
> 
> On Fri, Jan 19, 2018 at 10:33 AM, Steve Kargl  
> <sgk@troutmask.apl.washington.edu> wrote:  
> > On Fri, Jan 19, 2018 at 09:18:14AM -0800, Damian Rouson wrote:  
> >> Thanks for catching that, Steve, and for responding, Alessandro.  
> >>  
> >> Anything else?  
> >>  
> >  
> > I've only just started to look at the patch. Unfortunately,  
> > I know zero about teams, so need to read the patch and F2018  
> > standard simultaneously.  
> >  
> > --  
> > Steve  
> 
> 
> 
> --  
> 
> Alessandro Fanfarillo, Ph.D.  
> Postdoctoral Researcher  
> National Center for Atmospheric Research  
> Mesa Lab, Boulder, CO, USA  
> 303-497-1229  

-- 
Steve
20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4
20161221 https://www.youtube.com/watch?v=IbCHE-hONow

Re: [PATCH, fortran] Support Fortran 2018 teams

[Paul Richard Thomas]

Hi All,

Given the delay relative to the start of stage 3, I thought that I had
better deal with this asap:


+      /* TODO: this works on any derived type when
+         it should only work with team_type.  */
+      if (team->ts.type != BT_DERIVED)
Why don't you give the team_type derived type an attribute 'team_type'
and test that?

-   code node is passed.  The result type and library subroutine name
+   code ndoe is passed.  The result type and library subroutine name
typo

+! Tests if team_number intrinsic fucntion works

It's just as well that there is an 'n' in there, although it gives me
an idea for a new type of fortran procedure that does what it says :-)

Together with the change that Steve identified, this seems to me to be
ready to go.

(Jakub, This is all hidden behind the -fcoarray option. To my mind
this is safe for release.)

OK for trunk.

Many thanks for this patch.

Paul


On 23 January 2018 at 05:45, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
> I'm heading out of town for a meeting at the end of
> week, so gfortran patches/reviews are on hold at the
> moment.  If someone else wants to step up to review
> the patch, I won't object.
>
> --
> steve
>
> On Mon, Jan 22, 2018 at 08:29:41PM -0800, Damian Rouson wrote:
>> Is Fortran 2018 teams patch ok for trunk?
>>
>> Damian
>>
>> On January 19, 2018 at 2:47:39 PM, Alessandro Fanfarillo (elfanfa@ucar.edu) wrote:
>>
>> I can confirm that the little change suggested by Steve passes the
>> regtests (on x86_64-pc-linux-gnu) and the regular tests using
>> OpenCoarrays.
>>
>> On Fri, Jan 19, 2018 at 10:33 AM, Steve Kargl
>> <sgk@troutmask.apl.washington.edu> wrote:
>> > On Fri, Jan 19, 2018 at 09:18:14AM -0800, Damian Rouson wrote:
>> >> Thanks for catching that, Steve, and for responding, Alessandro.
>> >>
>> >> Anything else?
>> >>
>> >
>> > I've only just started to look at the patch. Unfortunately,
>> > I know zero about teams, so need to read the patch and F2018
>> > standard simultaneously.
>> >
>> > --
>> > Steve
>>
>>
>>
>> --
>>
>> Alessandro Fanfarillo, Ph.D.
>> Postdoctoral Researcher
>> National Center for Atmospheric Research
>> Mesa Lab, Boulder, CO, USA
>> 303-497-1229
>
> --
> Steve
> 20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4
> 20161221 https://www.youtube.com/watch?v=IbCHE-hONow



-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein

Re: [PATCH, fortran] Support Fortran 2018 teams

[Damian Rouson]

Thank you, Paul.   I think Alessandro has commit rights.  If so, then I’ll ask him to make the requested edits and commit it.

Damian

On January 24, 2018 at 12:19:58 PM, Paul Richard Thomas (paul.richard.thomas@gmail.com) wrote:

Hi All,  

Given the delay relative to the start of stage 3, I thought that I had  
better deal with this asap:  


+ /* TODO: this works on any derived type when  
+ it should only work with team_type. */  
+ if (team->ts.type != BT_DERIVED)  
Why don't you give the team_type derived type an attribute 'team_type'  
and test that?  

- code node is passed. The result type and library subroutine name  
+ code ndoe is passed. The result type and library subroutine name  
typo  

+! Tests if team_number intrinsic fucntion works  

It's just as well that there is an 'n' in there, although it gives me  
an idea for a new type of fortran procedure that does what it says :-)  

Together with the change that Steve identified, this seems to me to be  
ready to go.  

(Jakub, This is all hidden behind the -fcoarray option. To my mind  
this is safe for release.)  

OK for trunk.  

Many thanks for this patch.  

Paul  


On 23 January 2018 at 05:45, Steve Kargl  
<sgk@troutmask.apl.washington.edu> wrote:  
> I'm heading out of town for a meeting at the end of  
> week, so gfortran patches/reviews are on hold at the  
> moment. If someone else wants to step up to review  
> the patch, I won't object.  
>  
> --  
> steve  
>  
> On Mon, Jan 22, 2018 at 08:29:41PM -0800, Damian Rouson wrote:  
>> Is Fortran 2018 teams patch ok for trunk?  
>>  
>> Damian  
>>  
>> On January 19, 2018 at 2:47:39 PM, Alessandro Fanfarillo (elfanfa@ucar.edu) wrote:  
>>  
>> I can confirm that the little change suggested by Steve passes the  
>> regtests (on x86_64-pc-linux-gnu) and the regular tests using  
>> OpenCoarrays.  
>>  
>> On Fri, Jan 19, 2018 at 10:33 AM, Steve Kargl  
>> <sgk@troutmask.apl.washington.edu> wrote:  
>> > On Fri, Jan 19, 2018 at 09:18:14AM -0800, Damian Rouson wrote:  
>> >> Thanks for catching that, Steve, and for responding, Alessandro.  
>> >>  
>> >> Anything else?  
>> >>  
>> >  
>> > I've only just started to look at the patch. Unfortunately,  
>> > I know zero about teams, so need to read the patch and F2018  
>> > standard simultaneously.  
>> >  
>> > --  
>> > Steve  
>>  
>>  
>>  
>> --  
>>  
>> Alessandro Fanfarillo, Ph.D.  
>> Postdoctoral Researcher  
>> National Center for Atmospheric Research  
>> Mesa Lab, Boulder, CO, USA  
>> 303-497-1229  
>  
> --  
> Steve  
> 20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4  
> 20161221 https://www.youtube.com/watch?v=IbCHE-hONow  



--  
"If you can't explain it simply, you don't understand it well enough"  
- Albert Einstein  

Re: [PATCH, fortran] Support Fortran 2018 teams

[Steve Kargl]

On Wed, Jan 24, 2018 at 01:25:51PM -0800, Damian Rouson wrote:
> Thank you, Paul.  I think Alessandro has commit rights.
> If so, then I’ll ask him to make the requested edits and commit it.
> 
> Damian
> 

Yes, thanks, Paul.  Unfortunately, I've run out of time.
Damian, GCC is in stage 3, we need to wait for approval
from the release manager (aka Jakub) before committing
the patch.

-- 
Steve

Re: [PATCH, fortran] Support Fortran 2018 teams

[Damian Rouson]

On January 24, 2018 at 1:29:12 PM, Steve Kargl (sgk@troutmask.apl.washington.edu) wrote:


Yes, thanks, Paul. Unfortunately, I've run out of time.  
Damian, GCC is in stage 3, we need to wait for approval  
from the release manager (aka Jakub) before committing  
the patch.  


Will do.  

Damian

Re: [PATCH, fortran] Support Fortran 2018 teams

[Jakub Jelinek]

On Wed, Jan 24, 2018 at 08:19:58PM +0000, Paul Richard Thomas wrote:
> (Jakub, This is all hidden behind the -fcoarray option. To my mind
> this is safe for release.)

Ok from RM POV.

	Jakub

Re: [PATCH, fortran] Support Fortran 2018 teams

[Alessandro Fanfarillo]

Committed revision 257105.

Thanks.

On Wed, Jan 24, 2018 at 3:17 PM, Jakub Jelinek <jakub@redhat.com> wrote:
> On Wed, Jan 24, 2018 at 08:19:58PM +0000, Paul Richard Thomas wrote:
>> (Jakub, This is all hidden behind the -fcoarray option. To my mind
>> this is safe for release.)
>
> Ok from RM POV.
>
>         Jakub



-- 

Alessandro Fanfarillo, Ph.D.
Postdoctoral Researcher
National Center for Atmospheric Research
Mesa Lab, Boulder, CO, USA
303-497-1229