From: Damian Rouson <damian@sourceryinstitute.org>
Date: Fri, 26 Jan 2018 20:14:09 +0000 (+0000)
Subject: Partial Failed Images patch
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=f8862a1b2afad9d107ad505de2bf554705ebdb38;p=gcc.git

Partial Failed Images patch

Co-Authored-By: Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>
Co-Authored-By: Soren Rasmussen <s.c.rasmussen@gmail.com>

From-SVN: r257105
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 659e8acfcc1..9a2cc320991 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,49 @@
+2018-01-26  Damian Rouson  <damian@sourceryinstitute.org>
+	Alessandro Fanfarillo  <fanfarillo.gcc@gmail.com>
+	Soren Rasmussen  <s.c.rasmussen@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-26  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/83998
diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index caa0b7fe656..22a5ddc59de 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));
 
@@ -235,8 +236,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->team == 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 f1c6695044a..dbb1aa02111 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)
+    {
+      if (team->ts.type != BT_DERIVED
+	  || team->ts.u.derived->from_intmod != INTMOD_ISO_FORTRAN_ENV
+	  || team->ts.u.derived->intmod_sym_id != ISOFORTRAN_TEAM_TYPE)
+	 {
+	   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 2a5f8eca7d5..40f20c96ea5 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -5060,7 +5060,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..21344321709 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -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..cf44fabb239 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 6f12b13a1c8..418542bd5a6 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 a2b892aa65a..8078005d976 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11101,6 +11101,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 1e5e4233a6d..2458956055b 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -2892,6 +2892,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)
 {
@@ -3058,7 +3082,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)
@@ -7348,7 +7372,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 af647c42668..9cc4f338947 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);
@@ -3000,7 +3053,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)
 {
@@ -4584,7 +4636,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;
@@ -6099,7 +6151,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)
@@ -8662,7 +8713,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;
@@ -9190,6 +9241,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.  */
@@ -9587,6 +9642,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 df83a2b6647..573fd4818d4 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 fd25ce57c7f..b15a4b25952 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -2545,12 +2545,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 35e1bd28379..2ada8057735 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/ChangeLog b/gcc/testsuite/ChangeLog
index 317be5e9fae..730b1488508 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,14 @@
+2018-01-26  Damian Rouson  <damian@sourceryinstitute.org>
+	Alessandro Fanfarillo  <fanfarillo.gcc@gmail.com>
+	Soren Rasmussen  <s.c.rasmussen@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.
+
 2018-01-26  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/83998
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..fd492f6ed84
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/team_form_1.f90
@@ -0,0 +1,12 @@
+! { 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..242ea507088
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/team_number_1.f90
@@ -0,0 +1,22 @@
+! { 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