check.c (check_co_minmaxsum, [...]): New.

gcc/fortran/
2014-05-08  Tobias Burnus  <burnus@net-b.de>

        * check.c (check_co_minmaxsum, gfc_check_co_minmax,
        gfc_check_co_sum): New.
        * error.c (gfc_notify_std): Update -std=f2008ts.
        * gfortran.h (gfc_isym_id): Add GFC_ISYM_CO_MAX,
        GFC_ISYM_CO_MIN, GFC_ISYM_CO_SUM.
        * intrinsic.h (gfc_check_co_minmax,
        gfc_check_co_sum): Declare.
        * intrinsic.c (add_subroutines): Add co_min, co_max
        and co_sum.
        (gfc_check_intrinsic_standard): Update text for
        -std=f2008ts.
        * intrinsic.texi (CO_MIN, CO_MAX, CO_SUM): Document
        them.
        * invoke.texi (-std=f2008ts): Update wording.
        * trans.h (gfor_fndecl_co_max,
        gfor_fndecl_co_min, gfor_fndecl_co_sum): Define.
        * trans-decl.c (gfor_fndecl_co_max,
        gfor_fndecl_co_min, gfor_fndecl_co_sum): Define.
        (gfc_build_builtin_function_decls): Assign to it.
        * trans-intrinsic.c (conv_co_minmaxsum): New.
        (gfc_conv_intrinsic_subroutine): Call it.

libgfortran/
2014-05-08  Tobias Burnus  <burnus@net-b.de>

        * caf/libcaf.h (caf_vector_t, _gfortran_caf_co_sum,
        _gfortran_caf_co_min, _gfortran_caf_co_max): Declare
        * caf/single.c

gcc/testsuite/
2014-05-08  Tobias Burnus  <burnus@net-b.de>

        * gfortran.dg/coarray_collectives_1.f90: New.
        * gfortran.dg/coarray_collectives_2.f90: New.
        * gfortran.dg/coarray_collectives_3.f90: New.
        * gfortran.dg/coarray_collectives_4.f90: New.
        * gfortran.dg/coarray_collectives_5.f90: New.
        * gfortran.dg/coarray_collectives_6.f90: New.
        * gfortran.dg/coarray/collectives_1.f90: New.
        * gfortran.dg/assumed_rank_5.f90: Update dg-error.
        * gfortran.dg/assumed_type_4.f90: Update dg-error.
        * gfortran.dg/bind_c_array_params.f03: Update dg-error.
        * gfortran.dg/bind_c_usage_28.f90: Update dg-error.
        * gfortran.dg/c_funloc_tests_5.f03: Update dg-error.
        * gfortran.dg/c_funloc_tests_6.f90: Update dg-error.
        * gfortran.dg/c_loc_tests_11.f03: Update dg-error.

From-SVN: r210223

11 files changed, 456 insertions, 7 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5e39b13..07a84d4 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,27 @@
+2014-05-08  Tobias Burnus  <burnus@net-b.de>
+
+	* check.c (check_co_minmaxsum, gfc_check_co_minmax,
+	gfc_check_co_sum): New.
+	* error.c (gfc_notify_std): Update -std=f2008ts.
+	* gfortran.h (gfc_isym_id): Add GFC_ISYM_CO_MAX,
+	GFC_ISYM_CO_MIN, GFC_ISYM_CO_SUM.
+	* intrinsic.h (gfc_check_co_minmax,
+	gfc_check_co_sum): Declare.
+	* intrinsic.c (add_subroutines): Add co_min, co_max
+	and co_sum.
+	(gfc_check_intrinsic_standard): Update text for
+	-std=f2008ts.
+	* intrinsic.texi (CO_MIN, CO_MAX, CO_SUM): Document
+	them.
+	* invoke.texi (-std=f2008ts): Update wording.
+	* trans.h (gfor_fndecl_co_max,
+	gfor_fndecl_co_min, gfor_fndecl_co_sum): Define.
+	* trans-decl.c (gfor_fndecl_co_max,
+	gfor_fndecl_co_min, gfor_fndecl_co_sum): Define.
+	(gfc_build_builtin_function_decls): Assign to it.
+	* trans-intrinsic.c (conv_co_minmaxsum): New.
+	(gfc_conv_intrinsic_subroutine): Call it.
+
 2014-05-06  Kenneth Zadeck  <zadeck@naturalbridge.com>
 	    Mike Stump  <mikestump@comcast.net>
 	    Richard Sandiford  <rdsandiford@googlemail.com>
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index b83d9da..90ba0c9 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1290,6 +1290,91 @@ gfc_check_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *kind)
 }
 
 
+static bool
+check_co_minmaxsum (gfc_expr *a, gfc_expr *result_image, gfc_expr *stat,
+		    gfc_expr *errmsg)
+{
+  if (!variable_check (a, 0, false))
+    return false;
+
+  if (result_image != NULL)
+    {
+      if (!type_check (result_image, 1, BT_INTEGER))
+	return false;
+      if (!scalar_check (result_image, 1))
+	return false;
+    }
+
+  if (stat != NULL)
+    {
+      if (!type_check (stat, 2, BT_INTEGER))
+	return false;
+      if (!scalar_check (stat, 2))
+	return false;
+      if (!variable_check (stat, 2, false))
+	return false;
+      if (stat->ts.kind != 4)
+	{
+	  gfc_error ("The stat= argument at %L must be a kind=4 integer "
+		     "variable", &stat->where);
+	  return false;
+	}
+    }
+
+  if (errmsg != NULL)
+    {
+      if (!type_check (errmsg, 3, BT_CHARACTER))
+	return false;
+      if (!scalar_check (errmsg, 3))
+	return false;
+      if (!variable_check (errmsg, 3, false))
+	return false;
+      if (errmsg->ts.kind != 1)
+	{
+	  gfc_error ("The errmsg= argument at %L must be a default-kind "
+		     "character variable", &errmsg->where);
+	  return false;
+	}
+    }
+
+  if (gfc_option.coarray == GFC_FCOARRAY_NONE)
+    {
+      gfc_fatal_error ("Coarrays disabled at %L, use -fcoarray= to enable",
+		       &a->where);
+      return false;
+    }
+
+  return true;
+}
+
+
+bool
+gfc_check_co_minmax (gfc_expr *a, gfc_expr *result_image, gfc_expr *stat,
+		     gfc_expr *errmsg)
+{
+  if (a->ts.type != BT_INTEGER && a->ts.type != BT_REAL
+      && a->ts.type != BT_CHARACTER)
+    {
+       gfc_error ("'%s' argument of '%s' intrinsic at %L shall be of type "
+		  "integer, real or character",
+		  gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
+		  &a->where);
+       return false;
+    }
+  return check_co_minmaxsum (a, result_image, stat, errmsg);
+}
+
+
+bool
+gfc_check_co_sum (gfc_expr *a, gfc_expr *result_image, gfc_expr *stat,
+		  gfc_expr *errmsg)
+{
+  if (!numeric_check (a, 0))
+    return false;
+  return check_co_minmaxsum (a, result_image, stat, errmsg);
+}
+
+
 bool
 gfc_check_complex (gfc_expr *x, gfc_expr *y)
 {
diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
index e843fa5..6ae44e8 100644
--- a/gcc/fortran/error.c
+++ b/gcc/fortran/error.c
@@ -878,7 +878,7 @@ gfc_notify_std (int std, const char *gmsgid, ...)
   switch (std)
   {
     case GFC_STD_F2008_TS:
-      msg2 = "TS 29113:";
+      msg2 = "TS 29113/TS 18508:";
       break;
     case GFC_STD_F2008_OBS:
       msg2 = _("Fortran 2008 obsolescent feature:");
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 0707b58..63be8af 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -323,6 +323,9 @@ enum gfc_isym_id
   GFC_ISYM_CHDIR,
   GFC_ISYM_CHMOD,
   GFC_ISYM_CMPLX,
+  GFC_ISYM_CO_MAX,
+  GFC_ISYM_CO_MIN,
+  GFC_ISYM_CO_SUM,
   GFC_ISYM_COMMAND_ARGUMENT_COUNT,
   GFC_ISYM_COMPILER_OPTIONS,
   GFC_ISYM_COMPILER_VERSION,
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 19d4620..852ae92 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -3004,7 +3004,7 @@ add_subroutines (void)
 {
   /* Argument names as in the standard (to be used as argument keywords).  */
   const char
-    *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
+    *a = "a", *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
     *c = "count", *tm = "time", *tp = "topos", *gt = "get",
     *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
     *f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
@@ -3013,7 +3013,8 @@ add_subroutines (void)
     *trim_name = "trim_name", *ut = "unit", *han = "handler",
     *sec = "seconds", *res = "result", *of = "offset", *md = "mode",
     *whence = "whence", *pos = "pos", *ptr = "ptr", *p1 = "path1",
-    *p2 = "path2", *msk = "mask", *old = "old";
+    *p2 = "path2", *msk = "mask", *old = "old", *result_image = "result_image",
+    *stat = "stat", *errmsg = "errmsg";
 
   int di, dr, dc, dl, ii;
 
@@ -3209,6 +3210,31 @@ add_subroutines (void)
 	      "fptr", BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
   make_from_module();
 
+  /* Coarray collectives.  */
+  add_sym_4s ("co_max", GFC_ISYM_CO_MAX, CLASS_IMPURE,
+	      BT_UNKNOWN, 0, GFC_STD_F2008_TS,
+	      gfc_check_co_minmax, NULL, NULL,
+	      a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
+	      result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
+	      stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
+	      errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT);
+
+  add_sym_4s ("co_min", GFC_ISYM_CO_MIN, CLASS_IMPURE,
+	      BT_UNKNOWN, 0, GFC_STD_F2008_TS,
+	      gfc_check_co_minmax, NULL, NULL,
+	      a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
+	      result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
+	      stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
+	      errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT);
+
+  add_sym_4s ("co_sum", GFC_ISYM_CO_SUM, CLASS_IMPURE,
+	      BT_UNKNOWN, 0, GFC_STD_F2008_TS,
+	      gfc_check_co_sum, NULL, NULL,
+	      a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
+	      result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
+	      stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
+	      errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT);
+
   /* More G77 compatibility garbage.  */
   add_sym_3s ("alarm", GFC_ISYM_ALARM, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
 	      gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
@@ -4160,7 +4186,7 @@ gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
       break;
 
     case GFC_STD_F2008_TS:
-      symstd_msg = "new in TS 29113";
+      symstd_msg = "new in TS 29113/TS 18508";
       break;
 
     case GFC_STD_GNU:
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index d7f7954..162fa71 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -49,6 +49,8 @@ bool gfc_check_chdir (gfc_expr *);
 bool gfc_check_chmod (gfc_expr *, gfc_expr *);
 bool gfc_check_cmplx (gfc_expr *, gfc_expr *, gfc_expr *);
 bool gfc_check_complex (gfc_expr *, gfc_expr *);
+bool gfc_check_co_minmax (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+bool gfc_check_co_sum (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 bool gfc_check_count (gfc_expr *, gfc_expr *, gfc_expr *);
 bool gfc_check_cshift (gfc_expr *, gfc_expr *, gfc_expr *);
 bool gfc_check_ctime (gfc_expr *);
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 926ffe9..b091ee4 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -86,6 +86,9 @@ Some basic guidelines for editing this document:
 * @code{CHDIR}:         CHDIR,     Change working directory
 * @code{CHMOD}:         CHMOD,     Change access permissions of files
 * @code{CMPLX}:         CMPLX,     Complex conversion function
+* @code{CO_MAX}:        CO_MAX,    Maximal value on the current set of images
+* @code{CO_MIN}:        CO_MIN,    Minimal value on the current set of images
+* @code{CO_SUM}:        CO_SUM,    Sum of values on the current set of images
 * @code{COMMAND_ARGUMENT_COUNT}: COMMAND_ARGUMENT_COUNT, Get number of command line arguments
 * @code{COMPILER_OPTIONS}: COMPILER_OPTIONS, Options passed to the compiler
 * @code{COMPILER_VERSION}: COMPILER_VERSION, Compiler version string
@@ -2811,6 +2814,168 @@ end program test_cmplx
 
 
 
+@node CO_MAX
+@section @code{CO_MAX} --- Maximal value on the current set of images
+@fnindex CO_MAX
+@cindex Collectives, maximal value
+
+@table @asis
+@item @emph{Description}:
+@code{CO_MAX} determines element-wise the maximal value of @var{A} on all
+images of the current team.  If @var{RESULT_IMAGE} is present, the maximum
+values are returned on in @var{A} on the specified image only and the value
+of @var{A} on the other images become undefined.  If @var{RESULT_IMAGE} is
+not present, the value is returned on all images.  If the execution was
+successful and @var{STAT} is present, it is assigned the value zero.  If the
+execution failed, @var{STAT} gets assigned a nonzero value and, if present,
+@var{ERRMSG} gets assigned a value describing the occurred error.
+
+@item @emph{Standard}:
+Technical Specification (TS) 18508 or later
+
+@item @emph{Class}:
+Collective subroutine
+
+@item @emph{Syntax}:
+@code{CALL CO_MAX(A [, RESULT_IMAGE, STAT, ERRMSG])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A}            @tab shall be an integer, real or character variable,
+which has the same type and type parameters on all images of the team.
+@item @var{RESULT_IMAGE} @tab (optional) a scalar integer expression; if
+present, it shall have the same the same value on all images and refer to an
+image of the current team.
+@item @var{STAT}         @tab (optional) a scalar integer variable
+@item @var{ERRMSG}       @tab (optional) a scalar character variable
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+program test
+  integer :: val
+  val = this_image ()
+  call co_max (val, result_image=1)
+  if (this_image() == 1) then
+    write(*,*) "Maximal value", val  ! prints num_images()
+  end if
+end program test
+@end smallexample
+
+@item @emph{See also}:
+@ref{CO_MIN}, @ref{CO_SUM}
+@end table
+
+
+
+@node CO_MIN
+@section @code{CO_MIN} --- Minimal value on the current set of images
+@fnindex CO_MIN
+@cindex Collectives, minimal value
+
+@table @asis
+@item @emph{Description}:
+@code{CO_MIN} determines element-wise the minimal value of @var{A} on all
+images of the current team.  If @var{RESULT_IMAGE} is present, the minimal
+values are returned on in @var{A} on the specified image only and the value
+of @var{A} on the other images become undefined.  If @var{RESULT_IMAGE} is
+not present, the value is returned on all images.  If the execution was
+successful and @var{STAT} is present, it is assigned the value zero.  If the
+execution failed, @var{STAT} gets assigned a nonzero value and, if present,
+@var{ERRMSG} gets assigned a value describing the occurred error.
+
+@item @emph{Standard}:
+Technical Specification (TS) 18508 or later
+
+@item @emph{Class}:
+Collective subroutine
+
+@item @emph{Syntax}:
+@code{CALL CO_MIN(A [, RESULT_IMAGE, STAT, ERRMSG])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A}            @tab shall be an integer, real or character variable,
+which has the same type and type parameters on all images of the team.
+@item @var{RESULT_IMAGE} @tab (optional) a scalar integer expression; if
+present, it shall have the same the same value on all images and refer to an
+image of the current team.
+@item @var{STAT}         @tab (optional) a scalar integer variable
+@item @var{ERRMSG}       @tab (optional) a scalar character variable
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+program test
+  integer :: val
+  val = this_image ()
+  call co_min (val, result_image=1)
+  if (this_image() == 1) then
+    write(*,*) "Minimal value", val  ! prints 1
+  end if
+end program test
+@end smallexample
+
+@item @emph{See also}:
+@ref{CO_MAX}, @ref{CO_SUM}
+@end table
+
+
+
+@node CO_SUM
+@section @code{CO_SUM} --- Sum of values on the current set of images
+@fnindex CO_SUM
+@cindex Collectives, sum of values
+
+@table @asis
+@item @emph{Description}:
+@code{CO_SUM} sums up the values of each element of @var{A} on all
+images of the current team.  If @var{RESULT_IMAGE} is present, the summed-up
+values are returned on in @var{A} on the specified image only and the value
+of @var{A} on the other images become undefined.  If @var{RESULT_IMAGE} is
+not present, the value is returned on all images.  If the execution was
+successful and @var{STAT} is present, it is assigned the value zero.  If the
+execution failed, @var{STAT} gets assigned a nonzero value and, if present,
+@var{ERRMSG} gets assigned a value describing the occurred error.
+
+@item @emph{Standard}:
+Technical Specification (TS) 18508 or later
+
+@item @emph{Class}:
+Collective subroutine
+
+@item @emph{Syntax}:
+@code{CALL CO_MIN(A [, RESULT_IMAGE, STAT, ERRMSG])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A}            @tab shall be an integer, real or complex variable,
+which has the same type and type parameters on all images of the team.
+@item @var{RESULT_IMAGE} @tab (optional) a scalar integer expression; if
+present, it shall have the same the same value on all images and refer to an
+image of the current team.
+@item @var{STAT}         @tab (optional) a scalar integer variable
+@item @var{ERRMSG}       @tab (optional) a scalar character variable
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+program test
+  integer :: val
+  val = this_image ()
+  call co_sum (val, result_image=1)
+  if (this_image() == 1) then
+    write(*,*) "The sum is ", val ! prints (n**2 + n)/2, with n = num_images()
+  end if
+end program test
+@end smallexample
+
+@item @emph{See also}:
+@ref{CO_MAX}, @ref{CO_MIN}
+@end table
+
+
+
 @node COMMAND_ARGUMENT_COUNT
 @section @code{COMMAND_ARGUMENT_COUNT} --- Get number of command line arguments
 @fnindex COMMAND_ARGUMENT_COUNT
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index b92abfc..4c7d4a3 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -402,7 +402,7 @@ language standard, and warnings are given for the Fortran 77 features
 that are permitted but obsolescent in later standards. @samp{-std=f2008ts}
 allows the Fortran 2008 standard including the additions of the 
 Technical Specification (TS) 29113 on Further Interoperability of Fortran
-with C.
+with C and TS 18508 on Additional Parallel Features in Fortran.
 
 @end table
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index bd1ebab..5dd5d2a 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -131,6 +131,9 @@ tree gfor_fndecl_caf_sync_all;
 tree gfor_fndecl_caf_sync_images;
 tree gfor_fndecl_caf_error_stop;
 tree gfor_fndecl_caf_error_stop_str;
+tree gfor_fndecl_co_max;
+tree gfor_fndecl_co_min;
+tree gfor_fndecl_co_sum;
 
 
 /* Math functions.  Many other math functions are handled in
@@ -3280,12 +3283,12 @@ gfc_build_builtin_function_decls (void)
 
       gfor_fndecl_caf_sync_all = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_sync_all")), ".WW", void_type_node,
-	3, pint_type, build_pointer_type (pchar_type_node), integer_type_node);
+	3, pint_type, pchar_type_node, integer_type_node);
 
       gfor_fndecl_caf_sync_images = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_sync_images")), ".RRWW", void_type_node,
 	5, integer_type_node, pint_type, pint_type,
-	build_pointer_type (pchar_type_node), integer_type_node);
+	pchar_type_node, integer_type_node);
 
       gfor_fndecl_caf_error_stop = gfc_build_library_function_decl (
 	get_identifier (PREFIX("caf_error_stop")),
@@ -3298,6 +3301,21 @@ gfc_build_builtin_function_decls (void)
 	void_type_node, 2, pchar_type_node, gfc_int4_type_node);
       /* CAF's ERROR STOP doesn't return.  */
       TREE_THIS_VOLATILE (gfor_fndecl_caf_error_stop_str) = 1;
+
+      gfor_fndecl_co_max = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("caf_co_max")), "WR.WW",
+	void_type_node, 7, pvoid_type_node, pvoid_type_node, integer_type_node,
+	pint_type, pchar_type_node, integer_type_node, integer_type_node);
+
+      gfor_fndecl_co_min = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("caf_co_min")), "WR.WW",
+	void_type_node, 7, pvoid_type_node, pvoid_type_node, integer_type_node,
+	pint_type, pchar_type_node, integer_type_node, integer_type_node);
+
+      gfor_fndecl_co_sum = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("caf_co_sum")), "WR.WW",
+	void_type_node, 6, pvoid_type_node, pvoid_type_node, integer_type_node,
+	pint_type, pchar_type_node, integer_type_node);
     }
 
   gfc_build_intrinsic_function_decls ();
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index c166c4f..755d3d4 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -7509,6 +7509,124 @@ gfc_walk_intrinsic_function (gfc_ss * ss, gfc_expr * expr,
 
 
 static tree
+conv_co_minmaxsum (gfc_code *code)
+{
+  gfc_se argse;
+  stmtblock_t block, post_block;
+  tree fndecl, array, vec, strlen, image_index, stat, errmsg, errmsg_len;
+
+  gfc_start_block (&block);
+  gfc_init_block (&post_block);
+
+  /* stat.  */
+  if (code->ext.actual->next->next->expr)
+    {
+      gfc_init_se (&argse, NULL);
+      gfc_conv_expr (&argse, code->ext.actual->next->next->expr);
+      gfc_add_block_to_block (&block, &argse.pre);
+      gfc_add_block_to_block (&post_block, &argse.post);
+      stat = argse.expr;
+      if (gfc_option.coarray != GFC_FCOARRAY_SINGLE)
+	stat = gfc_build_addr_expr (NULL_TREE, stat);
+    }
+  else if (gfc_option.coarray == GFC_FCOARRAY_SINGLE)
+    stat = NULL_TREE;
+  else
+    stat = null_pointer_node;
+
+  /* Early exit for GFC_FCOARRAY_SINGLE.  */
+  if (gfc_option.coarray == GFC_FCOARRAY_SINGLE)
+    {
+      if (stat != NULL_TREE)
+	gfc_add_modify (&block, stat,
+			fold_convert (TREE_TYPE (stat), integer_zero_node));
+      return gfc_finish_block (&block);
+    }
+
+  /* Handle the array.  */
+  gfc_init_se (&argse, NULL);
+  if (code->ext.actual->expr->rank == 0)
+    {
+      symbol_attribute attr;
+      gfc_clear_attr (&attr);
+      gfc_init_se (&argse, NULL);
+      gfc_conv_expr (&argse, code->ext.actual->expr);
+      gfc_add_block_to_block (&block, &argse.pre);
+      gfc_add_block_to_block (&post_block, &argse.post);
+      array = gfc_conv_scalar_to_descriptor (&argse, argse.expr, attr);
+      array = gfc_build_addr_expr (NULL_TREE, array);
+    }
+  else
+    {
+      argse.want_pointer = 1;
+      gfc_conv_expr_descriptor (&argse, code->ext.actual->expr);
+      array = argse.expr;
+    }
+  gfc_add_block_to_block (&block, &argse.pre);
+  gfc_add_block_to_block (&post_block, &argse.post);
+
+  if (code->ext.actual->expr->ts.type == BT_CHARACTER)
+    strlen = argse.string_length;
+  else
+    strlen = integer_zero_node;
+
+  vec = null_pointer_node;
+
+  /* image_index.  */
+  if (code->ext.actual->next->expr)
+    {
+      gfc_init_se (&argse, NULL);
+      gfc_conv_expr (&argse, code->ext.actual->next->expr);
+      gfc_add_block_to_block (&block, &argse.pre);
+      gfc_add_block_to_block (&post_block, &argse.post);
+      image_index = fold_convert (integer_type_node, argse.expr);
+    }
+  else
+    image_index = integer_zero_node;
+
+  /* errmsg.  */
+  if (code->ext.actual->next->next->next->expr)
+    {
+      gfc_init_se (&argse, NULL);
+      gfc_conv_expr (&argse, code->ext.actual->next->next->next->expr);
+      gfc_add_block_to_block (&block, &argse.pre);
+      gfc_add_block_to_block (&post_block, &argse.post);
+      errmsg = argse.expr;
+      errmsg_len = fold_convert (integer_type_node, argse.string_length);
+    }
+  else
+    {
+      errmsg = null_pointer_node;
+      errmsg_len = integer_zero_node;
+    }
+
+  /* Generate the function call.  */
+  if (code->resolved_isym->id == GFC_ISYM_CO_MAX)
+    fndecl = gfor_fndecl_co_max;
+  else if (code->resolved_isym->id == GFC_ISYM_CO_MIN)
+    fndecl = gfor_fndecl_co_min;
+  else
+    {
+      gcc_assert (code->resolved_isym->id == GFC_ISYM_CO_SUM);
+      fndecl = gfor_fndecl_co_sum;
+    }
+
+  if (code->resolved_isym->id == GFC_ISYM_CO_SUM)
+    fndecl = build_call_expr_loc (input_location, fndecl, 6, array, vec,
+				  image_index, stat, errmsg, errmsg_len);
+  else
+    fndecl = build_call_expr_loc (input_location, fndecl, 7, array, vec,
+				  image_index, stat, errmsg, strlen,
+				  errmsg_len);
+  gfc_add_expr_to_block (&block, fndecl);
+  gfc_add_block_to_block (&block, &post_block);
+
+  /* Add CALL to CO_SUM/MIN/MAX: array descriptor, vector descriptor, stat, errmsg, strlen, errmsglen */
+  return gfc_finish_block (&block);
+}
+
+
+static tree
 conv_intrinsic_atomic_def (gfc_code *code)
 {
   gfc_se atom, value;
@@ -7803,6 +7921,11 @@ gfc_conv_intrinsic_subroutine (gfc_code *code)
       res = conv_isocbinding_subroutine (code);
       break;
 
+    case GFC_ISYM_CO_MIN:
+    case GFC_ISYM_CO_MAX:
+    case GFC_ISYM_CO_SUM:
+      res = conv_co_minmaxsum (code);
+      break;
 
     default:
       res = NULL_TREE;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 13b0a00..baae780 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -709,6 +709,9 @@ extern GTY(()) tree gfor_fndecl_caf_sync_all;
 extern GTY(()) tree gfor_fndecl_caf_sync_images;
 extern GTY(()) tree gfor_fndecl_caf_error_stop;
 extern GTY(()) tree gfor_fndecl_caf_error_stop_str;
+extern GTY(()) tree gfor_fndecl_co_max;
+extern GTY(()) tree gfor_fndecl_co_min;
+extern GTY(()) tree gfor_fndecl_co_sum;
 
 
 /* Math functions.  Many other math functions are handled in