re PR fortran/36313 ([F03] {MIN,MAX}{LOC,VAL} should accept character arguments)

2017-11-22  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/36313
	* Makefile.am: Add i_maxloc0s_c, i_maxloc1s_c, i_maxloc2s_c,
	i_minloc0s_c, i_minloc1s_c and i_minloc2s_c.
	* Makefile.in: Regenerated.
        * generated/maxloc0_16_s1.c: New file.
        * generated/maxloc0_16_s4.c: New file.
        * generated/maxloc0_4_s1.c: New file.
        * generated/maxloc0_4_s4.c: New file.
        * generated/maxloc0_8_s1.c: New file.
        * generated/maxloc0_8_s4.c: New file.
        * generated/maxloc1_16_s1.c: New file.
        * generated/maxloc1_16_s4.c: New file.
        * generated/maxloc1_4_s1.c: New file.
        * generated/maxloc1_4_s4.c: New file.
        * generated/maxloc1_8_s1.c: New file.
        * generated/maxloc1_8_s4.c: New file.
        * generated/maxloc2_16_s1.c: New file.
        * generated/maxloc2_16_s4.c: New file.
        * generated/maxloc2_4_s1.c: New file.
        * generated/maxloc2_4_s4.c: New file.
        * generated/maxloc2_8_s1.c: New file.
        * generated/maxloc2_8_s4.c: New file.
        * generated/minloc0_16_s1.c: New file.
        * generated/minloc0_16_s4.c: New file.
        * generated/minloc0_4_s1.c: New file.
        * generated/minloc0_4_s4.c: New file.
        * generated/minloc0_8_s1.c: New file.
        * generated/minloc0_8_s4.c: New file.
        * generated/minloc1_16_s1.c: New file.
        * generated/minloc1_16_s4.c: New file.
        * generated/minloc1_4_s1.c: New file.
        * generated/minloc1_4_s4.c: New file.
        * generated/minloc1_8_s1.c: New file.
        * generated/minloc1_8_s4.c: New file.
        * generated/minloc2_16_s1.c: New file.
        * generated/minloc2_16_s4.c: New file.
        * generated/minloc2_4_s1.c: New file.
        * generated/minloc2_4_s4.c: New file.
        * generated/minloc2_8_s1.c: New file.
        * generated/minloc2_8_s4.c: New file.
        * m4/iforeach-s.m4: New file.
        * m4/ifunction-s.m4: New file.
        * m4/maxloc0s.m4: New file.
        * m4/maxloc1s.m4: New file.
        * m4/maxloc2s.m4: New file.
        * m4/minloc0s.m4: New file.
        * m4/minloc1s.m4: New file.
        * m4/minloc2s.m4: New file.
	* gfortran.map: Add new functions.
	* libgfortran.h: Add gfc_array_s1 and gfc_array_s4.

2017-11-22  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/36313
	* check.c (int_or_real_or_char_check_f2003): New function.
	* iresolve.c (gfc_resolve_maxloc): Add number "2" for
	character arguments and rank-zero return value.
	(gfc_resolve_minloc): Likewise.
	* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Handle case of
	character arguments and rank-zero return value by removing
	unneeded arguments and calling the library function.

2017-11-22  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/36313
	* gfortran.dg/maxloc_string_1.f90: New test.
	* gfortran.dg/minloc_string_1.f90: New test.

From-SVN: r255070

gcc/fortran/ChangeLog

+2017-11-22  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/36313
+	* check.c (int_or_real_or_char_check_f2003): New function.
+	* iresolve.c (gfc_resolve_maxloc): Add number "2" for
+	character arguments and rank-zero return value.
+	(gfc_resolve_minloc): Likewise.
+	* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Handle case of
+	character arguments and rank-zero return value by removing
+	unneeded arguments and calling the library function.
+
 2017-11-22  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/79072

gcc/fortran/check.c

@@ -117,6 +117,37 @@ int_or_real_check (gfc_expr *e, int n)
   return true;
 }
 
+/* Check that an expression is integer or real; allow character for
+   F2003 or later.  */
+
+static bool
+int_or_real_or_char_check_f2003 (gfc_expr *e, int n)
+{
+  if (e->ts.type != BT_INTEGER && e->ts.type != BT_REAL)
+    {
+      if (e->ts.type == BT_CHARACTER)
+	return gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Character for "
+			       "%qs argument of %qs intrinsic at %L",
+			       gfc_current_intrinsic_arg[n]->name,
+			       gfc_current_intrinsic, &e->where);
+      else
+	{
+	  if (gfc_option.allow_std & GFC_STD_F2003)
+	    gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
+		       "or REAL or CHARACTER",
+		       gfc_current_intrinsic_arg[n]->name,
+		       gfc_current_intrinsic, &e->where);
+	  else
+	    gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
+		       "or REAL", gfc_current_intrinsic_arg[n]->name,
+		       gfc_current_intrinsic, &e->where);
+	}
+      return false;
+    }
+
+  return true;
+}
+
 
 /* Check that an expression is real or complex.  */
 
@@ -3189,7 +3220,7 @@ gfc_check_minloc_maxloc (gfc_actual_arglist *ap)
   gfc_expr *a, *m, *d, *k;
 
   a = ap->expr;
-  if (!int_or_real_check (a, 0) || !array_check (a, 0))
+  if (!int_or_real_or_char_check_f2003 (a, 0) || !array_check (a, 0))
     return false;
 
   d = ap->next->expr;

gcc/fortran/iresolve.c

@@ -1702,6 +1702,7 @@ gfc_resolve_maxloc (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
   const char *name;
   int i, j, idim;
   int fkind;
+  int d_num;
 
   f->ts.type = BT_INTEGER;
 
@@ -1752,8 +1753,18 @@ gfc_resolve_maxloc (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
   else
     name = "maxloc";
 
+  if (dim)
+    {
+      if (array->ts.type != BT_CHARACTER || f->rank != 0)
+	d_num = 1;
+      else
+	d_num = 2;
+    }
+  else
+    d_num = 0;
+
   f->value.function.name
-    = gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, dim != NULL, f->ts.kind,
+    = gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, d_num, f->ts.kind,
 		      gfc_type_letter (array->ts.type), array->ts.kind);
 
   if (kind)
@@ -1896,6 +1907,7 @@ gfc_resolve_minloc (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
   const char *name;
   int i, j, idim;
   int fkind;
+  int d_num;
 
   f->ts.type = BT_INTEGER;
 
@@ -1946,8 +1958,18 @@ gfc_resolve_minloc (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
   else
     name = "minloc";
 
+  if (dim)
+    {
+      if (array->ts.type != BT_CHARACTER || f->rank != 0)
+	d_num = 1;
+      else
+	d_num = 2;
+    }
+  else
+    d_num = 0;
+
   f->value.function.name
-    = gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, dim != NULL, f->ts.kind,
+    = gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, d_num, f->ts.kind,
 		      gfc_type_letter (array->ts.type), array->ts.kind);
 
   if (fkind != f->ts.kind)

gcc/fortran/trans-intrinsic.c

@@ -4568,14 +4568,41 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
       return;
     }
 
+  actual = expr->value.function.actual;
+  arrayexpr = actual->expr;
+
+  /* Special case for character maxval.  Remove unneeded actual
+     arguments, then call a library function.  */
+  
+  if (arrayexpr->ts.type == BT_CHARACTER)
+    {
+      gfc_actual_arglist *a2, *a3, *a4;
+      a2 = actual->next;
+      a3 = a2->next;
+      a4 = a3->next;
+      a4->next = NULL;
+      if (a3->expr == NULL)
+	{
+	  actual->next = NULL;
+	  gfc_free_actual_arglist (a2);
+	}
+      else
+	{
+	  actual->next = a3;  /* dim */
+	  a3->next = NULL;
+	  a2->next = a4;
+	  gfc_free_actual_arglist (a4);
+	}
+      gfc_conv_intrinsic_funcall (se, expr);
+      return;
+    }
+
   /* Initialize the result.  */
   pos = gfc_create_var (gfc_array_index_type, "pos");
   offset = gfc_create_var (gfc_array_index_type, "offset");
   type = gfc_typenode_for_spec (&expr->ts);
 
   /* Walk the arguments.  */
-  actual = expr->value.function.actual;
-  arrayexpr = actual->expr;
   arrayss = gfc_walk_expr (arrayexpr);
   gcc_assert (arrayss != gfc_ss_terminator);
 

gcc/testsuite/ChangeLog

+2017-11-22  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/36313
+	* gfortran.dg/maxloc_string_1.f90: New test.
+	* gfortran.dg/minloc_string_1.f90: New test.
+
 2017-11-22  Marc Glisse  <marc.glisse@inria.fr>
 
 	PR tree-optimization/83104

gcc/testsuite/gfortran.dg/maxloc_string_1.f90

+! { dg-do run }
+! Test maxloc for strings for different code paths
+
+program main
+  implicit none
+  integer, parameter :: n=4
+  character(len=4), dimension(n,n) :: c
+  integer, dimension(n,n) :: a
+  integer, dimension(2) :: res1, res2
+  real, dimension(n,n) :: r
+  logical, dimension(n,n) :: amask
+  logical(kind=8) :: smask
+  integer :: i,j
+  integer, dimension(n) :: q1, q2
+  character(len=4,kind=4), dimension(n,n) :: c4
+  character(len=4), dimension(n*n) :: e
+  integer, dimension(n*n) :: f
+  logical, dimension(n*n) :: cmask
+
+  call random_number (r)
+  a = int(r*100)
+  do j=1,n
+     do i=1,n
+        write (unit=c(i,j),fmt='(I4.4)') a(i,j)
+        write (unit=c4(i,j),fmt='(I4.4)') a(i,j)
+     end do
+  end do
+  res1 = maxloc(c)
+  res2 = maxloc(a)
+
+  if (any(res1 /= res2)) call abort
+  res1 = maxloc(c4)
+  if (any(res1 /= res2)) call abort
+
+  amask = a < 50
+  res1 = maxloc(c,mask=amask)
+  res2 = maxloc(a,mask=amask)
+
+ if (any(res1 /= res2)) call abort
+
+ amask = .false.
+ res1 = maxloc(c,mask=amask)
+ if (any(res1 /= 0)) call abort
+
+ amask(2,3) = .true.
+ res1 = maxloc(c,mask=amask)
+ if (any(res1 /= [2,3])) call abort
+
+ res1 = maxloc(c,mask=.false.)
+ if (any(res1 /= 0)) call abort
+
+ res2 = maxloc(a)
+ res1 = maxloc(c,mask=.true.)
+ if (any(res1 /= res2)) call abort
+
+ q1 = maxloc(c, dim=1)
+ q2 = maxloc(a, dim=1)
+ if (any(q1 /= q2)) call abort
+
+ q1 = maxloc(c, dim=2)
+ q2 = maxloc(a, dim=2)
+ if (any(q1 /= q2)) call abort
+
+ q1 = maxloc(c, dim=1, mask=amask)
+ q2 = maxloc(a, dim=1, mask=amask)
+ if (any(q1 /= q2)) call abort
+
+ q1 = maxloc(c, dim=2, mask=amask)
+ q2 = maxloc(a, dim=2, mask=amask)
+ if (any(q1 /= q2)) call abort
+
+  amask = a < 50
+
+ q1 = maxloc(c, dim=1, mask=amask)
+ q2 = maxloc(a, dim=1, mask=amask)
+ if (any(q1 /= q2)) call abort
+
+ q1 = maxloc(c, dim=2, mask=amask)
+ q2 = maxloc(a, dim=2, mask=amask)
+ if (any(q1 /= q2)) call abort
+
+ e = reshape(c, shape(e))
+ f = reshape(a, shape(f))
+ if (maxloc(e,dim=1) /= maxloc(f,dim=1)) call abort
+
+ cmask = .false.
+ if (maxloc(e,dim=1,mask=cmask) /= 0) call abort
+
+ cmask = f > 50
+ if ( maxloc(e, dim=1, mask=cmask) /= maxloc (f, dim=1, mask=cmask)) call abort
+end program main

gcc/testsuite/gfortran.dg/minloc_string_1.f90

+! { dg-do run }
+! Test minloc for strings for different code paths
+
+program main
+  implicit none
+  integer, parameter :: n=4
+  character(len=4), dimension(n,n) :: c
+  integer, dimension(n,n) :: a
+  integer, dimension(2) :: res1, res2
+  real, dimension(n,n) :: r
+  logical, dimension(n,n) :: amask
+  logical(kind=8) :: smask
+  integer :: i,j
+  integer, dimension(n) :: q1, q2
+  character(len=4,kind=4), dimension(n,n) :: c4
+  character(len=4), dimension(n*n) :: e
+  integer, dimension(n*n) :: f
+  logical, dimension(n*n) :: cmask
+
+  call random_number (r)
+  a = int(r*100)
+  do j=1,n
+     do i=1,n
+        write (unit=c(i,j),fmt='(I4.4)') a(i,j)
+        write (unit=c4(i,j),fmt='(I4.4)') a(i,j)
+     end do
+  end do
+  res1 = minloc(c)
+  res2 = minloc(a)
+
+  if (any(res1 /= res2)) call abort
+  res1 = minloc(c4)
+  if (any(res1 /= res2)) call abort
+
+  amask = a < 50
+  res1 = minloc(c,mask=amask)
+  res2 = minloc(a,mask=amask)
+
+ if (any(res1 /= res2)) call abort
+
+ amask = .false.
+ res1 = minloc(c,mask=amask)
+ if (any(res1 /= 0)) call abort
+
+ amask(2,3) = .true.
+ res1 = minloc(c,mask=amask)
+ if (any(res1 /= [2,3])) call abort
+
+ res1 = minloc(c,mask=.false.)
+ if (any(res1 /= 0)) call abort
+
+ res2 = minloc(a)
+ res1 = minloc(c,mask=.true.)
+ if (any(res1 /= res2)) call abort
+
+ q1 = minloc(c, dim=1)
+ q2 = minloc(a, dim=1)
+ if (any(q1 /= q2)) call abort
+
+ q1 = minloc(c, dim=2)
+ q2 = minloc(a, dim=2)
+ if (any(q1 /= q2)) call abort
+
+ q1 = minloc(c, dim=1, mask=amask)
+ q2 = minloc(a, dim=1, mask=amask)
+ if (any(q1 /= q2)) call abort
+
+ q1 = minloc(c, dim=2, mask=amask)
+ q2 = minloc(a, dim=2, mask=amask)
+ if (any(q1 /= q2)) call abort
+
+  amask = a < 50
+
+ q1 = minloc(c, dim=1, mask=amask)
+ q2 = minloc(a, dim=1, mask=amask)
+ if (any(q1 /= q2)) call abort
+
+ q1 = minloc(c, dim=2, mask=amask)
+ q2 = minloc(a, dim=2, mask=amask)
+ if (any(q1 /= q2)) call abort
+
+ e = reshape(c, shape(e))
+ f = reshape(a, shape(f))
+ if (minloc(e,dim=1) /= minloc(f,dim=1)) call abort
+
+ cmask = .false.
+ if (minloc(e,dim=1,mask=cmask) /= 0) call abort
+
+ cmask = f > 50
+ if ( minloc(e, dim=1, mask=cmask) /= minloc (f, dim=1, mask=cmask)) call abort
+end program main

libgfortran/ChangeLog

+2017-11-22  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/36313
+	* Makefile.am: Add i_maxloc0s_c, i_maxloc1s_c, i_maxloc2s_c,
+	i_minloc0s_c, i_minloc1s_c and i_minloc2s_c.
+	* Makefile.in: Regenerated.
+        * generated/maxloc0_16_s1.c: New file.
+        * generated/maxloc0_16_s4.c: New file.
+        * generated/maxloc0_4_s1.c: New file.
+        * generated/maxloc0_4_s4.c: New file.
+        * generated/maxloc0_8_s1.c: New file.
+        * generated/maxloc0_8_s4.c: New file.
+        * generated/maxloc1_16_s1.c: New file.
+        * generated/maxloc1_16_s4.c: New file.
+        * generated/maxloc1_4_s1.c: New file.
+        * generated/maxloc1_4_s4.c: New file.
+        * generated/maxloc1_8_s1.c: New file.
+        * generated/maxloc1_8_s4.c: New file.
+        * generated/maxloc2_16_s1.c: New file.
+        * generated/maxloc2_16_s4.c: New file.
+        * generated/maxloc2_4_s1.c: New file.
+        * generated/maxloc2_4_s4.c: New file.
+        * generated/maxloc2_8_s1.c: New file.
+        * generated/maxloc2_8_s4.c: New file.
+        * generated/minloc0_16_s1.c: New file.
+        * generated/minloc0_16_s4.c: New file.
+        * generated/minloc0_4_s1.c: New file.
+        * generated/minloc0_4_s4.c: New file.
+        * generated/minloc0_8_s1.c: New file.
+        * generated/minloc0_8_s4.c: New file.
+        * generated/minloc1_16_s1.c: New file.
+        * generated/minloc1_16_s4.c: New file.
+        * generated/minloc1_4_s1.c: New file.
+        * generated/minloc1_4_s4.c: New file.
+        * generated/minloc1_8_s1.c: New file.
+        * generated/minloc1_8_s4.c: New file.
+        * generated/minloc2_16_s1.c: New file.
+        * generated/minloc2_16_s4.c: New file.
+        * generated/minloc2_4_s1.c: New file.
+        * generated/minloc2_4_s4.c: New file.
+        * generated/minloc2_8_s1.c: New file.
+        * generated/minloc2_8_s4.c: New file.
+        * m4/iforeach-s.m4: New file.
+        * m4/ifunction-s.m4: New file.
+        * m4/maxloc0s.m4: New file.
+        * m4/maxloc1s.m4: New file.
+        * m4/maxloc2s.m4: New file.
+        * m4/minloc0s.m4: New file.
+        * m4/minloc1s.m4: New file.
+        * m4/minloc2s.m4: New file.
+	* gfortran.map: Add new functions.
+	* libgfortran.h: Add gfc_array_s1 and gfc_array_s4.
+
 2017-11-22  Janne Blomqvist  <jb@gcc.gnu.org>
 
 	PR libfortran/83070

libgfortran/Makefile.am

@@ -293,6 +293,14 @@ $(srcdir)/generated/maxloc0_4_r16.c \
 $(srcdir)/generated/maxloc0_8_r16.c \
 $(srcdir)/generated/maxloc0_16_r16.c
 
+i_maxloc0s_c = \
+$(srcdir)/generated/maxloc0_4_s1.c \
+$(srcdir)/generated/maxloc0_4_s4.c \
+$(srcdir)/generated/maxloc0_8_s1.c \
+$(srcdir)/generated/maxloc0_8_s4.c \
+$(srcdir)/generated/maxloc0_16_s1.c \
+$(srcdir)/generated/maxloc0_16_s4.c
+
 i_maxloc1_c= \
 $(srcdir)/generated/maxloc1_4_i1.c \
 $(srcdir)/generated/maxloc1_8_i1.c \
@@ -322,6 +330,22 @@ $(srcdir)/generated/maxloc1_4_r16.c \
 $(srcdir)/generated/maxloc1_8_r16.c \
 $(srcdir)/generated/maxloc1_16_r16.c
 
+i_maxloc1s_c= \
+$(srcdir)/generated/maxloc1_4_s1.c \
+$(srcdir)/generated/maxloc1_4_s4.c \
+$(srcdir)/generated/maxloc1_8_s1.c \
+$(srcdir)/generated/maxloc1_8_s4.c \
+$(srcdir)/generated/maxloc1_16_s1.c \
+$(srcdir)/generated/maxloc1_16_s4.c
+
+i_maxloc2s_c= \
+$(srcdir)/generated/maxloc2_4_s1.c \
+$(srcdir)/generated/maxloc2_4_s4.c \
+$(srcdir)/generated/maxloc2_8_s1.c \
+$(srcdir)/generated/maxloc2_8_s4.c \
+$(srcdir)/generated/maxloc2_16_s1.c \
+$(srcdir)/generated/maxloc2_16_s4.c
+
 i_maxval_c= \
 $(srcdir)/generated/maxval_i1.c \
 $(srcdir)/generated/maxval_i2.c \
@@ -362,6 +386,14 @@ $(srcdir)/generated/minloc0_4_r16.c \
 $(srcdir)/generated/minloc0_8_r16.c \
 $(srcdir)/generated/minloc0_16_r16.c
 
+i_minloc0s_c = \
+$(srcdir)/generated/minloc0_4_s1.c \
+$(srcdir)/generated/minloc0_4_s4.c \
+$(srcdir)/generated/minloc0_8_s1.c \
+$(srcdir)/generated/minloc0_8_s4.c \
+$(srcdir)/generated/minloc0_16_s1.c \
+$(srcdir)/generated/minloc0_16_s4.c
+
 i_minloc1_c= \
 $(srcdir)/generated/minloc1_4_i1.c \
 $(srcdir)/generated/minloc1_8_i1.c \
@@ -391,6 +423,22 @@ $(srcdir)/generated/minloc1_4_r16.c \
 $(srcdir)/generated/minloc1_8_r16.c \
 $(srcdir)/generated/minloc1_16_r16.c
 
+i_minloc1s_c= \
+$(srcdir)/generated/minloc1_4_s1.c \
+$(srcdir)/generated/minloc1_4_s4.c \
+$(srcdir)/generated/minloc1_8_s1.c \
+$(srcdir)/generated/minloc1_8_s4.c \
+$(srcdir)/generated/minloc1_16_s1.c \
+$(srcdir)/generated/minloc1_16_s4.c
+
+i_minloc2s_c= \
+$(srcdir)/generated/minloc2_4_s1.c \
+$(srcdir)/generated/minloc2_4_s4.c \
+$(srcdir)/generated/minloc2_8_s1.c \
+$(srcdir)/generated/minloc2_8_s4.c \
+$(srcdir)/generated/minloc2_16_s1.c \
+$(srcdir)/generated/minloc2_16_s4.c
+
 i_minval_c= \
 $(srcdir)/generated/minval_i1.c \
 $(srcdir)/generated/minval_i2.c \
@@ -688,7 +736,7 @@ m4_files= m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
     m4/pow.m4 \
     m4/misc_specifics.m4 m4/pack.m4 \
     m4/unpack.m4 m4/spread.m4 m4/bessel.m4 m4/norm2.m4 m4/parity.m4 \
-    m4/iall.m4 m4/iany.m4 m4/iparity.m4
+    m4/iall.m4 m4/iany.m4 m4/iparity.m4 m4/iforeach-s.m4
 
 gfor_built_src= $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
     $(i_maxloc1_c) $(i_maxval_c) $(i_minloc0_c) $(i_minloc1_c) $(i_minval_c) \
@@ -699,7 +747,8 @@ gfor_built_src= $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
     $(i_pow_c) $(i_pack_c) $(i_unpack_c) $(i_matmulavx128_c) \
     $(i_spread_c) selected_int_kind.inc selected_real_kind.inc kinds.h \
     $(i_cshift0_c) kinds.inc c99_protos.inc fpu-target.h fpu-target.inc \
-    $(i_cshift1a_c)
+    $(i_cshift1a_c) $(i_maxloc0s_c) $(i_minloc0s_c) $(i_maxloc1s_c) \
+    $(i_minloc1s_c) $(i_maxloc2s_c) $(i_minloc2s_c)
 
 # Machine generated specifics
 gfor_built_specific_src= \
@@ -922,6 +971,8 @@ I_M4_DEPS=m4/iparm.m4
 I_M4_DEPS0=$(I_M4_DEPS) m4/iforeach.m4
 I_M4_DEPS1=$(I_M4_DEPS) m4/ifunction.m4
 I_M4_DEPS2=$(I_M4_DEPS) m4/ifunction_logical.m4
+I_M4_DEPS3=$(I_M4_DEPS) m4/iforeach-s.m4
+I_M4_DEPS4=$(I_M4_DEPS) m4/ifunction-s.m4
 
 kinds.h: $(srcdir)/mk-kinds-h.sh
 	$(SHELL) $(srcdir)/mk-kinds-h.sh '$(FCCOMPILE)' > $@ || rm $@
@@ -973,18 +1024,36 @@ $(i_iparity_c): m4/iparity.m4 $(I_M4_DEPS1)
 $(i_maxloc0_c): m4/maxloc0.m4 $(I_M4_DEPS0)
 	$(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc0.m4 > $@
 
+$(i_maxloc0s_c) : m4/maxloc0s.m4 $(I_M4_DEPS3)
+	$(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc0s.m4 > $@
+
 $(i_maxloc1_c): m4/maxloc1.m4 $(I_M4_DEPS1)
 	$(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc1.m4 > $@
 
+$(i_maxloc1s_c): m4/maxloc1s.m4 $(I_M4_DEPS4)
+	$(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc1s.m4 > $@
+
+$(i_maxloc2s_c): m4/maxloc2s.m4 $(I_M4_DEPS)
+	$(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc2s.m4 > $@
+
 $(i_maxval_c): m4/maxval.m4 $(I_M4_DEPS1)
 	$(M4) -Dfile=$@ -I$(srcdir)/m4 maxval.m4 > $@
 
 $(i_minloc0_c): m4/minloc0.m4 $(I_M4_DEPS0)
 	$(M4) -Dfile=$@ -I$(srcdir)/m4 minloc0.m4 > $@
 
+$(i_minloc0s_c) : m4/minloc0s.m4 $(I_M4_DEPS3)
+	$(M4) -Dfile=$@ -I$(srcdir)/m4 minloc0s.m4 > $@
+
 $(i_minloc1_c): m4/minloc1.m4 $(I_M4_DEPS1)
 	$(M4) -Dfile=$@ -I$(srcdir)/m4 minloc1.m4 > $@
 
+$(i_minloc1s_c): m4/minloc1s.m4 $(I_M4_DEPS4)
+	$(M4) -Dfile=$@ -I$(srcdir)/m4 minloc1s.m4 > $@
+
+$(i_minloc2s_c): m4/minloc2s.m4 $(I_M4_DEPS)
+	$(M4) -Dfile=$@ -I$(srcdir)/m4 minloc2s.m4 > $@
+
 $(i_minval_c): m4/minval.m4 $(I_M4_DEPS1)
 	$(M4) -Dfile=$@ -I$(srcdir)/m4 minval.m4 > $@
 

libgfortran/generated/maxloc0_16_s1.c

+/* Implementation of the MAXLOC intrinsic
+   Copyright 2017 Free Software Foundation, Inc.
+   Contributed by Thomas Koenig
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include <limits.h>
+
+
+#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_16)
+
+static inline int
+compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+{
+  if (sizeof (GFC_INTEGER_1) == 1)
+    return memcmp (a, b, n);
+  else
+    return memcmp_char4 (a, b, n);
+
+}
+
+extern void maxloc0_16_s1 (gfc_array_i16 * const restrict retarray, 
+	gfc_array_s1 * const restrict array, gfc_charlen_type len);
+export_proto(maxloc0_16_s1);
+
+void
+maxloc0_16_s1 (gfc_array_i16 * const restrict retarray, 
+	gfc_array_s1 * const restrict array, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  const GFC_INTEGER_1 *base;
+  GFC_INTEGER_16 * restrict dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				"MAXLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  const GFC_INTEGER_1 *maxval;
+   maxval = base;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (compare_fcn (base, maxval, len) > 0)
+    {
+      maxval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void mmaxloc0_16_s1 (gfc_array_i16 * const restrict, 
+	gfc_array_s1 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
+export_proto(mmaxloc0_16_s1);
+
+void
+mmaxloc0_16_s1 (gfc_array_i16 * const restrict retarray, 
+	gfc_array_s1 * const restrict array,
+	gfc_array_l1 * const restrict mask, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_INTEGER_16 *dest;
+  const GFC_INTEGER_1 *base;
+  GFC_LOGICAL_1 *mbase;
+  int rank;
+  index_type n;
+  int mask_kind;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	{
+
+	  bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				  "MAXLOC");
+	  bounds_equal_extents ((array_t *) mask, (array_t *) array,
+				  "MASK argument", "MAXLOC");
+	}
+    }
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  mbase = mask->base_addr;
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 0;
+  {
+
+  const GFC_INTEGER_1 *maxval;
+
+  maxval = NULL;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (*mbase && (maxval == NULL || compare_fcn (base, maxval, len) > 0))
+    {
+      maxval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	  mbase += mstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  mbase -= mstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	      mbase += mstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void smaxloc0_16_s1 (gfc_array_i16 * const restrict, 
+	gfc_array_s1 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
+export_proto(smaxloc0_16_s1);
+
+void
+smaxloc0_16_s1 (gfc_array_i16 * const restrict retarray, 
+	gfc_array_s1 * const restrict array,
+	GFC_LOGICAL_4 * mask, gfc_charlen_type len)
+{
+  index_type rank;
+  index_type dstride;
+  index_type n;
+  GFC_INTEGER_16 *dest;
+
+  if (*mask)
+    {
+      maxloc0_16_s1 (retarray, array, len);
+      return;
+    }
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
+    }
+  else if (unlikely (compile_options.bounds_check))
+    {
+       bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+			       "MAXLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n<rank; n++)
+    dest[n * dstride] = 0 ;
+}
+#endif

libgfortran/generated/maxloc0_16_s4.c

+/* Implementation of the MAXLOC intrinsic
+   Copyright 2017 Free Software Foundation, Inc.
+   Contributed by Thomas Koenig
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include <limits.h>
+
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
+
+static inline int
+compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+{
+  if (sizeof (GFC_INTEGER_4) == 1)
+    return memcmp (a, b, n);
+  else
+    return memcmp_char4 (a, b, n);
+
+}
+
+extern void maxloc0_16_s4 (gfc_array_i16 * const restrict retarray, 
+	gfc_array_s4 * const restrict array, gfc_charlen_type len);
+export_proto(maxloc0_16_s4);
+
+void
+maxloc0_16_s4 (gfc_array_i16 * const restrict retarray, 
+	gfc_array_s4 * const restrict array, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  const GFC_INTEGER_4 *base;
+  GFC_INTEGER_16 * restrict dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				"MAXLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  const GFC_INTEGER_4 *maxval;
+   maxval = base;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (compare_fcn (base, maxval, len) > 0)
+    {
+      maxval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void mmaxloc0_16_s4 (gfc_array_i16 * const restrict, 
+	gfc_array_s4 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
+export_proto(mmaxloc0_16_s4);
+
+void
+mmaxloc0_16_s4 (gfc_array_i16 * const restrict retarray, 
+	gfc_array_s4 * const restrict array,
+	gfc_array_l1 * const restrict mask, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_INTEGER_16 *dest;
+  const GFC_INTEGER_4 *base;
+  GFC_LOGICAL_1 *mbase;
+  int rank;
+  index_type n;
+  int mask_kind;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	{
+
+	  bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				  "MAXLOC");
+	  bounds_equal_extents ((array_t *) mask, (array_t *) array,
+				  "MASK argument", "MAXLOC");
+	}
+    }
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  mbase = mask->base_addr;
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 0;
+  {
+
+  const GFC_INTEGER_4 *maxval;
+
+  maxval = NULL;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (*mbase && (maxval == NULL || compare_fcn (base, maxval, len) > 0))
+    {
+      maxval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	  mbase += mstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  mbase -= mstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	      mbase += mstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void smaxloc0_16_s4 (gfc_array_i16 * const restrict, 
+	gfc_array_s4 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
+export_proto(smaxloc0_16_s4);
+
+void
+smaxloc0_16_s4 (gfc_array_i16 * const restrict retarray, 
+	gfc_array_s4 * const restrict array,
+	GFC_LOGICAL_4 * mask, gfc_charlen_type len)
+{
+  index_type rank;
+  index_type dstride;
+  index_type n;
+  GFC_INTEGER_16 *dest;
+
+  if (*mask)
+    {
+      maxloc0_16_s4 (retarray, array, len);
+      return;
+    }
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
+    }
+  else if (unlikely (compile_options.bounds_check))
+    {
+       bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+			       "MAXLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n<rank; n++)
+    dest[n * dstride] = 0 ;
+}
+#endif

libgfortran/generated/maxloc0_4_s1.c

+/* Implementation of the MAXLOC intrinsic
+   Copyright 2017 Free Software Foundation, Inc.
+   Contributed by Thomas Koenig
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include <limits.h>
+
+
+#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4)
+
+static inline int
+compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+{
+  if (sizeof (GFC_INTEGER_1) == 1)
+    return memcmp (a, b, n);
+  else
+    return memcmp_char4 (a, b, n);
+
+}
+
+extern void maxloc0_4_s1 (gfc_array_i4 * const restrict retarray, 
+	gfc_array_s1 * const restrict array, gfc_charlen_type len);
+export_proto(maxloc0_4_s1);
+
+void
+maxloc0_4_s1 (gfc_array_i4 * const restrict retarray, 
+	gfc_array_s1 * const restrict array, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  const GFC_INTEGER_1 *base;
+  GFC_INTEGER_4 * restrict dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				"MAXLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  const GFC_INTEGER_1 *maxval;
+   maxval = base;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (compare_fcn (base, maxval, len) > 0)
+    {
+      maxval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void mmaxloc0_4_s1 (gfc_array_i4 * const restrict, 
+	gfc_array_s1 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
+export_proto(mmaxloc0_4_s1);
+
+void
+mmaxloc0_4_s1 (gfc_array_i4 * const restrict retarray, 
+	gfc_array_s1 * const restrict array,
+	gfc_array_l1 * const restrict mask, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_INTEGER_4 *dest;
+  const GFC_INTEGER_1 *base;
+  GFC_LOGICAL_1 *mbase;
+  int rank;
+  index_type n;
+  int mask_kind;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	{
+
+	  bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				  "MAXLOC");
+	  bounds_equal_extents ((array_t *) mask, (array_t *) array,
+				  "MASK argument", "MAXLOC");
+	}
+    }
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  mbase = mask->base_addr;
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 0;
+  {
+
+  const GFC_INTEGER_1 *maxval;
+
+  maxval = NULL;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (*mbase && (maxval == NULL || compare_fcn (base, maxval, len) > 0))
+    {
+      maxval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	  mbase += mstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  mbase -= mstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	      mbase += mstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void smaxloc0_4_s1 (gfc_array_i4 * const restrict, 
+	gfc_array_s1 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
+export_proto(smaxloc0_4_s1);
+
+void
+smaxloc0_4_s1 (gfc_array_i4 * const restrict retarray, 
+	gfc_array_s1 * const restrict array,
+	GFC_LOGICAL_4 * mask, gfc_charlen_type len)
+{
+  index_type rank;
+  index_type dstride;
+  index_type n;
+  GFC_INTEGER_4 *dest;
+
+  if (*mask)
+    {
+      maxloc0_4_s1 (retarray, array, len);
+      return;
+    }
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+    }
+  else if (unlikely (compile_options.bounds_check))
+    {
+       bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+			       "MAXLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n<rank; n++)
+    dest[n * dstride] = 0 ;
+}
+#endif

libgfortran/generated/maxloc0_4_s4.c

+/* Implementation of the MAXLOC intrinsic
+   Copyright 2017 Free Software Foundation, Inc.
+   Contributed by Thomas Koenig
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include <limits.h>
+
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
+static inline int
+compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+{
+  if (sizeof (GFC_INTEGER_4) == 1)
+    return memcmp (a, b, n);
+  else
+    return memcmp_char4 (a, b, n);
+
+}
+
+extern void maxloc0_4_s4 (gfc_array_i4 * const restrict retarray, 
+	gfc_array_s4 * const restrict array, gfc_charlen_type len);
+export_proto(maxloc0_4_s4);
+
+void
+maxloc0_4_s4 (gfc_array_i4 * const restrict retarray, 
+	gfc_array_s4 * const restrict array, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  const GFC_INTEGER_4 *base;
+  GFC_INTEGER_4 * restrict dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				"MAXLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  const GFC_INTEGER_4 *maxval;
+   maxval = base;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (compare_fcn (base, maxval, len) > 0)
+    {
+      maxval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void mmaxloc0_4_s4 (gfc_array_i4 * const restrict, 
+	gfc_array_s4 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
+export_proto(mmaxloc0_4_s4);
+
+void
+mmaxloc0_4_s4 (gfc_array_i4 * const restrict retarray, 
+	gfc_array_s4 * const restrict array,
+	gfc_array_l1 * const restrict mask, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_INTEGER_4 *dest;
+  const GFC_INTEGER_4 *base;
+  GFC_LOGICAL_1 *mbase;
+  int rank;
+  index_type n;
+  int mask_kind;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	{
+
+	  bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				  "MAXLOC");
+	  bounds_equal_extents ((array_t *) mask, (array_t *) array,
+				  "MASK argument", "MAXLOC");
+	}
+    }
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  mbase = mask->base_addr;
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 0;
+  {
+
+  const GFC_INTEGER_4 *maxval;
+
+  maxval = NULL;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (*mbase && (maxval == NULL || compare_fcn (base, maxval, len) > 0))
+    {
+      maxval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	  mbase += mstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  mbase -= mstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	      mbase += mstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void smaxloc0_4_s4 (gfc_array_i4 * const restrict, 
+	gfc_array_s4 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
+export_proto(smaxloc0_4_s4);
+
+void
+smaxloc0_4_s4 (gfc_array_i4 * const restrict retarray, 
+	gfc_array_s4 * const restrict array,
+	GFC_LOGICAL_4 * mask, gfc_charlen_type len)
+{
+  index_type rank;
+  index_type dstride;
+  index_type n;
+  GFC_INTEGER_4 *dest;
+
+  if (*mask)
+    {
+      maxloc0_4_s4 (retarray, array, len);
+      return;
+    }
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+    }
+  else if (unlikely (compile_options.bounds_check))
+    {
+       bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+			       "MAXLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n<rank; n++)
+    dest[n * dstride] = 0 ;
+}
+#endif

libgfortran/generated/maxloc0_8_s1.c

+/* Implementation of the MAXLOC intrinsic
+   Copyright 2017 Free Software Foundation, Inc.
+   Contributed by Thomas Koenig
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include <limits.h>
+
+
+#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_8)
+
+static inline int
+compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+{
+  if (sizeof (GFC_INTEGER_1) == 1)
+    return memcmp (a, b, n);
+  else
+    return memcmp_char4 (a, b, n);
+
+}
+
+extern void maxloc0_8_s1 (gfc_array_i8 * const restrict retarray, 
+	gfc_array_s1 * const restrict array, gfc_charlen_type len);
+export_proto(maxloc0_8_s1);
+
+void
+maxloc0_8_s1 (gfc_array_i8 * const restrict retarray, 
+	gfc_array_s1 * const restrict array, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  const GFC_INTEGER_1 *base;
+  GFC_INTEGER_8 * restrict dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				"MAXLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  const GFC_INTEGER_1 *maxval;
+   maxval = base;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (compare_fcn (base, maxval, len) > 0)
+    {
+      maxval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void mmaxloc0_8_s1 (gfc_array_i8 * const restrict, 
+	gfc_array_s1 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
+export_proto(mmaxloc0_8_s1);
+
+void
+mmaxloc0_8_s1 (gfc_array_i8 * const restrict retarray, 
+	gfc_array_s1 * const restrict array,
+	gfc_array_l1 * const restrict mask, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_INTEGER_8 *dest;
+  const GFC_INTEGER_1 *base;
+  GFC_LOGICAL_1 *mbase;
+  int rank;
+  index_type n;
+  int mask_kind;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	{
+
+	  bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				  "MAXLOC");
+	  bounds_equal_extents ((array_t *) mask, (array_t *) array,
+				  "MASK argument", "MAXLOC");
+	}
+    }
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  mbase = mask->base_addr;
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 0;
+  {
+
+  const GFC_INTEGER_1 *maxval;
+
+  maxval = NULL;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (*mbase && (maxval == NULL || compare_fcn (base, maxval, len) > 0))
+    {
+      maxval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	  mbase += mstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  mbase -= mstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	      mbase += mstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void smaxloc0_8_s1 (gfc_array_i8 * const restrict, 
+	gfc_array_s1 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
+export_proto(smaxloc0_8_s1);
+
+void
+smaxloc0_8_s1 (gfc_array_i8 * const restrict retarray, 
+	gfc_array_s1 * const restrict array,
+	GFC_LOGICAL_4 * mask, gfc_charlen_type len)
+{
+  index_type rank;
+  index_type dstride;
+  index_type n;
+  GFC_INTEGER_8 *dest;
+
+  if (*mask)
+    {
+      maxloc0_8_s1 (retarray, array, len);
+      return;
+    }
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
+    }
+  else if (unlikely (compile_options.bounds_check))
+    {
+       bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+			       "MAXLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n<rank; n++)
+    dest[n * dstride] = 0 ;
+}
+#endif

libgfortran/generated/maxloc0_8_s4.c

+/* Implementation of the MAXLOC intrinsic
+   Copyright 2017 Free Software Foundation, Inc.
+   Contributed by Thomas Koenig
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include <limits.h>
+
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
+
+static inline int
+compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+{
+  if (sizeof (GFC_INTEGER_4) == 1)
+    return memcmp (a, b, n);
+  else
+    return memcmp_char4 (a, b, n);
+
+}
+
+extern void maxloc0_8_s4 (gfc_array_i8 * const restrict retarray, 
+	gfc_array_s4 * const restrict array, gfc_charlen_type len);
+export_proto(maxloc0_8_s4);
+
+void
+maxloc0_8_s4 (gfc_array_i8 * const restrict retarray, 
+	gfc_array_s4 * const restrict array, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  const GFC_INTEGER_4 *base;
+  GFC_INTEGER_8 * restrict dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				"MAXLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  const GFC_INTEGER_4 *maxval;
+   maxval = base;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (compare_fcn (base, maxval, len) > 0)
+    {
+      maxval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void mmaxloc0_8_s4 (gfc_array_i8 * const restrict, 
+	gfc_array_s4 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
+export_proto(mmaxloc0_8_s4);
+
+void
+mmaxloc0_8_s4 (gfc_array_i8 * const restrict retarray, 
+	gfc_array_s4 * const restrict array,
+	gfc_array_l1 * const restrict mask, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_INTEGER_8 *dest;
+  const GFC_INTEGER_4 *base;
+  GFC_LOGICAL_1 *mbase;
+  int rank;
+  index_type n;
+  int mask_kind;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	{
+
+	  bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				  "MAXLOC");
+	  bounds_equal_extents ((array_t *) mask, (array_t *) array,
+				  "MASK argument", "MAXLOC");
+	}
+    }
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  mbase = mask->base_addr;
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 0;
+  {
+
+  const GFC_INTEGER_4 *maxval;
+
+  maxval = NULL;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (*mbase && (maxval == NULL || compare_fcn (base, maxval, len) > 0))
+    {
+      maxval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	  mbase += mstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  mbase -= mstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	      mbase += mstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void smaxloc0_8_s4 (gfc_array_i8 * const restrict, 
+	gfc_array_s4 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
+export_proto(smaxloc0_8_s4);
+
+void
+smaxloc0_8_s4 (gfc_array_i8 * const restrict retarray, 
+	gfc_array_s4 * const restrict array,
+	GFC_LOGICAL_4 * mask, gfc_charlen_type len)
+{
+  index_type rank;
+  index_type dstride;
+  index_type n;
+  GFC_INTEGER_8 *dest;
+
+  if (*mask)
+    {
+      maxloc0_8_s4 (retarray, array, len);
+      return;
+    }
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
+    }
+  else if (unlikely (compile_options.bounds_check))
+    {
+       bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+			       "MAXLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n<rank; n++)
+    dest[n * dstride] = 0 ;
+}
+#endif

libgfortran/generated/maxloc2_16_s1.c

+/* Implementation of the MAXLOC intrinsic
+   Copyright 2017 Free Software Foundation, Inc.
+   Contributed by Thomas Koenig
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <string.h>
+
+#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_16)
+
+static inline int
+compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, int n)
+{
+  if (sizeof (GFC_INTEGER_1) == 1)
+    return memcmp (a, b, n);
+  else
+    return memcmp_char4 (a, b, n);
+}
+
+extern GFC_INTEGER_16 maxloc2_16_s1 (gfc_array_s1 * const restrict, int);
+export_proto(maxloc2_16_s1);
+
+GFC_INTEGER_16
+maxloc2_16_s1 (gfc_array_s1 * const restrict array, gfc_charlen_type len)
+{
+  index_type ret;
+  index_type sstride;
+  index_type extent;
+  const GFC_INTEGER_1 *src;
+  const GFC_INTEGER_1 *maxval;
+  index_type i;
+
+  extent = GFC_DESCRIPTOR_EXTENT(array,0);
+  if (extent <= 0)
+    return 0;
+
+  sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
+
+  ret = 1;
+  src = array->base_addr;
+  maxval = src;
+  for (i=2; i<=extent; i++)
+    {
+      src += sstride;
+      if (compare_fcn (src, maxval, len) > 0)
+      {
+	 ret = i;
+	 maxval = src;
+      }
+    }
+  return ret;
+}
+
+extern GFC_INTEGER_16 mmaxloc2_16_s1 (gfc_array_s1 * const restrict,
+       		    	gfc_array_l1 *const restrict mask, gfc_charlen_type);
+export_proto(mmaxloc2_16_s1);
+
+GFC_INTEGER_16
+mmaxloc2_16_s1 (gfc_array_s1 * const restrict array,
+				 gfc_array_l1 * const restrict mask,
+				 gfc_charlen_type len)
+{
+  index_type ret;
+  index_type sstride;
+  index_type extent;
+  const GFC_INTEGER_1 *src;
+  const GFC_INTEGER_1 *maxval;
+  index_type i, j;
+  GFC_LOGICAL_1 *mbase;
+  int mask_kind;
+  index_type mstride;
+
+  extent = GFC_DESCRIPTOR_EXTENT(array,0);
+  if (extent <= 0)
+    return 0;
+
+  sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+  mbase = mask->base_addr;
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    internal_error (NULL, "Funny sized logical array");
+
+  mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
+
+  /* Search for the first occurrence of a true element in mask. */
+  for (j=0; j<extent; j++)
+    {
+      if (*mbase)
+        break;
+      mbase += mstride;
+    }
+
+  if (j == extent)
+    return 0;
+
+  ret = j + 1;
+  src = array->base_addr + j * sstride;
+  maxval = src;
+
+  for (i=j+1; i<=extent; i++)
+    {
+      if (*mbase && compare_fcn (src, maxval, len) > 0)
+      {
+	 ret = i;
+	 maxval = src;
+      }
+      src += sstride;
+      mbase += mstride;
+    }
+  return ret;
+}
+
+extern GFC_INTEGER_16 smaxloc2_16_s1 (gfc_array_s1 * const restrict,
+       		    	GFC_LOGICAL_4 *mask, int);
+export_proto(smaxloc2_16_s1);
+
+GFC_INTEGER_16
+smaxloc2_16_s1 (gfc_array_s1 * const restrict array,
+				 GFC_LOGICAL_4 *mask, gfc_charlen_type len)
+{
+  if (mask)
+    return maxloc2_16_s1 (array, len);
+  else
+    return 0;
+}
+
+#endif

libgfortran/generated/maxloc2_16_s4.c

+/* Implementation of the MAXLOC intrinsic
+   Copyright 2017 Free Software Foundation, Inc.
+   Contributed by Thomas Koenig
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <string.h>
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
+
+static inline int
+compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, int n)
+{
+  if (sizeof (GFC_INTEGER_4) == 1)
+    return memcmp (a, b, n);
+  else
+    return memcmp_char4 (a, b, n);
+}
+
+extern GFC_INTEGER_16 maxloc2_16_s4 (gfc_array_s4 * const restrict, int);
+export_proto(maxloc2_16_s4);
+
+GFC_INTEGER_16
+maxloc2_16_s4 (gfc_array_s4 * const restrict array, gfc_charlen_type len)
+{
+  index_type ret;
+  index_type sstride;
+  index_type extent;
+  const GFC_INTEGER_4 *src;
+  const GFC_INTEGER_4 *maxval;
+  index_type i;
+
+  extent = GFC_DESCRIPTOR_EXTENT(array,0);
+  if (extent <= 0)
+    return 0;
+
+  sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
+
+  ret = 1;
+  src = array->base_addr;
+  maxval = src;
+  for (i=2; i<=extent; i++)
+    {
+      src += sstride;
+      if (compare_fcn (src, maxval, len) > 0)
+      {
+	 ret = i;
+	 maxval = src;
+      }
+    }
+  return ret;
+}
+
+extern GFC_INTEGER_16 mmaxloc2_16_s4 (gfc_array_s4 * const restrict,
+       		    	gfc_array_l1 *const restrict mask, gfc_charlen_type);
+export_proto(mmaxloc2_16_s4);
+
+GFC_INTEGER_16
+mmaxloc2_16_s4 (gfc_array_s4 * const restrict array,
+				 gfc_array_l1 * const restrict mask,
+				 gfc_charlen_type len)
+{
+  index_type ret;
+  index_type sstride;
+  index_type extent;
+  const GFC_INTEGER_4 *src;
+  const GFC_INTEGER_4 *maxval;
+  index_type i, j;
+  GFC_LOGICAL_1 *mbase;
+  int mask_kind;
+  index_type mstride;
+
+  extent = GFC_DESCRIPTOR_EXTENT(array,0);
+  if (extent <= 0)
+    return 0;
+
+  sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+  mbase = mask->base_addr;
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    internal_error (NULL, "Funny sized logical array");
+
+  mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
+
+  /* Search for the first occurrence of a true element in mask. */
+  for (j=0; j<extent; j++)
+    {
+      if (*mbase)
+        break;
+      mbase += mstride;
+    }
+
+  if (j == extent)
+    return 0;
+
+  ret = j + 1;
+  src = array->base_addr + j * sstride;
+  maxval = src;
+
+  for (i=j+1; i<=extent; i++)
+    {
+      if (*mbase && compare_fcn (src, maxval, len) > 0)
+      {
+	 ret = i;
+	 maxval = src;
+      }
+      src += sstride;
+      mbase += mstride;
+    }
+  return ret;
+}
+
+extern GFC_INTEGER_16 smaxloc2_16_s4 (gfc_array_s4 * const restrict,
+       		    	GFC_LOGICAL_4 *mask, int);
+export_proto(smaxloc2_16_s4);
+
+GFC_INTEGER_16
+smaxloc2_16_s4 (gfc_array_s4 * const restrict array,
+				 GFC_LOGICAL_4 *mask, gfc_charlen_type len)
+{
+  if (mask)
+    return maxloc2_16_s4 (array, len);
+  else
+    return 0;
+}
+
+#endif

libgfortran/generated/maxloc2_4_s1.c

+/* Implementation of the MAXLOC intrinsic
+   Copyright 2017 Free Software Foundation, Inc.
+   Contributed by Thomas Koenig
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <string.h>
+
+#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4)
+
+static inline int
+compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, int n)
+{
+  if (sizeof (GFC_INTEGER_1) == 1)
+    return memcmp (a, b, n);
+  else
+    return memcmp_char4 (a, b, n);
+}
+
+extern GFC_INTEGER_4 maxloc2_4_s1 (gfc_array_s1 * const restrict, int);
+export_proto(maxloc2_4_s1);
+
+GFC_INTEGER_4
+maxloc2_4_s1 (gfc_array_s1 * const restrict array, gfc_charlen_type len)
+{
+  index_type ret;
+  index_type sstride;
+  index_type extent;
+  const GFC_INTEGER_1 *src;
+  const GFC_INTEGER_1 *maxval;
+  index_type i;
+
+  extent = GFC_DESCRIPTOR_EXTENT(array,0);
+  if (extent <= 0)
+    return 0;
+
+  sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
+
+  ret = 1;
+  src = array->base_addr;
+  maxval = src;
+  for (i=2; i<=extent; i++)
+    {
+      src += sstride;
+      if (compare_fcn (src, maxval, len) > 0)
+      {
+	 ret = i;
+	 maxval = src;
+      }
+    }
+  return ret;
+}
+
+extern GFC_INTEGER_4 mmaxloc2_4_s1 (gfc_array_s1 * const restrict,
+       		    	gfc_array_l1 *const restrict mask, gfc_charlen_type);
+export_proto(mmaxloc2_4_s1);
+
+GFC_INTEGER_4
+mmaxloc2_4_s1 (gfc_array_s1 * const restrict array,
+				 gfc_array_l1 * const restrict mask,
+				 gfc_charlen_type len)
+{
+  index_type ret;
+  index_type sstride;
+  index_type extent;
+  const GFC_INTEGER_1 *src;
+  const GFC_INTEGER_1 *maxval;
+  index_type i, j;
+  GFC_LOGICAL_1 *mbase;
+  int mask_kind;
+  index_type mstride;
+
+  extent = GFC_DESCRIPTOR_EXTENT(array,0);
+  if (extent <= 0)
+    return 0;
+
+  sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+  mbase = mask->base_addr;
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    internal_error (NULL, "Funny sized logical array");
+
+  mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
+
+  /* Search for the first occurrence of a true element in mask. */
+  for (j=0; j<extent; j++)
+    {
+      if (*mbase)
+        break;
+      mbase += mstride;
+    }
+
+  if (j == extent)
+    return 0;
+
+  ret = j + 1;
+  src = array->base_addr + j * sstride;
+  maxval = src;
+
+  for (i=j+1; i<=extent; i++)
+    {
+      if (*mbase && compare_fcn (src, maxval, len) > 0)
+      {
+	 ret = i;
+	 maxval = src;
+      }
+      src += sstride;
+      mbase += mstride;
+    }
+  return ret;
+}
+
+extern GFC_INTEGER_4 smaxloc2_4_s1 (gfc_array_s1 * const restrict,
+       		    	GFC_LOGICAL_4 *mask, int);
+export_proto(smaxloc2_4_s1);
+
+GFC_INTEGER_4
+smaxloc2_4_s1 (gfc_array_s1 * const restrict array,
+				 GFC_LOGICAL_4 *mask, gfc_charlen_type len)
+{
+  if (mask)
+    return maxloc2_4_s1 (array, len);
+  else
+    return 0;
+}
+
+#endif

libgfortran/generated/maxloc2_4_s4.c

+/* Implementation of the MAXLOC intrinsic
+   Copyright 2017 Free Software Foundation, Inc.
+   Contributed by Thomas Koenig
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <string.h>
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
+static inline int
+compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, int n)
+{
+  if (sizeof (GFC_INTEGER_4) == 1)
+    return memcmp (a, b, n);
+  else
+    return memcmp_char4 (a, b, n);
+}
+
+extern GFC_INTEGER_4 maxloc2_4_s4 (gfc_array_s4 * const restrict, int);
+export_proto(maxloc2_4_s4);
+
+GFC_INTEGER_4
+maxloc2_4_s4 (gfc_array_s4 * const restrict array, gfc_charlen_type len)
+{
+  index_type ret;
+  index_type sstride;
+  index_type extent;
+  const GFC_INTEGER_4 *src;
+  const GFC_INTEGER_4 *maxval;
+  index_type i;
+
+  extent = GFC_DESCRIPTOR_EXTENT(array,0);
+  if (extent <= 0)
+    return 0;
+
+  sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
+
+  ret = 1;
+  src = array->base_addr;
+  maxval = src;
+  for (i=2; i<=extent; i++)
+    {
+      src += sstride;
+      if (compare_fcn (src, maxval, len) > 0)
+      {
+	 ret = i;
+	 maxval = src;
+      }
+    }
+  return ret;
+}
+
+extern GFC_INTEGER_4 mmaxloc2_4_s4 (gfc_array_s4 * const restrict,
+       		    	gfc_array_l1 *const restrict mask, gfc_charlen_type);
+export_proto(mmaxloc2_4_s4);
+
+GFC_INTEGER_4
+mmaxloc2_4_s4 (gfc_array_s4 * const restrict array,
+				 gfc_array_l1 * const restrict mask,
+				 gfc_charlen_type len)
+{
+  index_type ret;
+  index_type sstride;
+  index_type extent;
+  const GFC_INTEGER_4 *src;
+  const GFC_INTEGER_4 *maxval;
+  index_type i, j;
+  GFC_LOGICAL_1 *mbase;
+  int mask_kind;
+  index_type mstride;
+
+  extent = GFC_DESCRIPTOR_EXTENT(array,0);
+  if (extent <= 0)
+    return 0;
+
+  sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+  mbase = mask->base_addr;
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    internal_error (NULL, "Funny sized logical array");
+
+  mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
+
+  /* Search for the first occurrence of a true element in mask. */
+  for (j=0; j<extent; j++)
+    {
+      if (*mbase)
+        break;
+      mbase += mstride;
+    }
+
+  if (j == extent)
+    return 0;
+
+  ret = j + 1;
+  src = array->base_addr + j * sstride;
+  maxval = src;
+
+  for (i=j+1; i<=extent; i++)
+    {
+      if (*mbase && compare_fcn (src, maxval, len) > 0)
+      {
+	 ret = i;
+	 maxval = src;
+      }
+      src += sstride;
+      mbase += mstride;
+    }
+  return ret;
+}
+
+extern GFC_INTEGER_4 smaxloc2_4_s4 (gfc_array_s4 * const restrict,
+       		    	GFC_LOGICAL_4 *mask, int);
+export_proto(smaxloc2_4_s4);
+
+GFC_INTEGER_4
+smaxloc2_4_s4 (gfc_array_s4 * const restrict array,
+				 GFC_LOGICAL_4 *mask, gfc_charlen_type len)
+{
+  if (mask)
+    return maxloc2_4_s4 (array, len);
+  else
+    return 0;
+}
+
+#endif

libgfortran/generated/maxloc2_8_s1.c

+/* Implementation of the MAXLOC intrinsic
+   Copyright 2017 Free Software Foundation, Inc.
+   Contributed by Thomas Koenig
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <string.h>
+
+#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_8)
+
+static inline int
+compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, int n)
+{
+  if (sizeof (GFC_INTEGER_1) == 1)
+    return memcmp (a, b, n);
+  else
+    return memcmp_char4 (a, b, n);
+}
+
+extern GFC_INTEGER_8 maxloc2_8_s1 (gfc_array_s1 * const restrict, int);
+export_proto(maxloc2_8_s1);
+
+GFC_INTEGER_8
+maxloc2_8_s1 (gfc_array_s1 * const restrict array, gfc_charlen_type len)
+{
+  index_type ret;
+  index_type sstride;
+  index_type extent;
+  const GFC_INTEGER_1 *src;
+  const GFC_INTEGER_1 *maxval;
+  index_type i;
+
+  extent = GFC_DESCRIPTOR_EXTENT(array,0);
+  if (extent <= 0)
+    return 0;
+
+  sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
+
+  ret = 1;
+  src = array->base_addr;
+  maxval = src;
+  for (i=2; i<=extent; i++)
+    {
+      src += sstride;
+      if (compare_fcn (src, maxval, len) > 0)
+      {
+	 ret = i;
+	 maxval = src;
+      }
+    }
+  return ret;
+}
+
+extern GFC_INTEGER_8 mmaxloc2_8_s1 (gfc_array_s1 * const restrict,
+       		    	gfc_array_l1 *const restrict mask, gfc_charlen_type);
+export_proto(mmaxloc2_8_s1);
+
+GFC_INTEGER_8
+mmaxloc2_8_s1 (gfc_array_s1 * const restrict array,
+				 gfc_array_l1 * const restrict mask,
+				 gfc_charlen_type len)
+{
+  index_type ret;
+  index_type sstride;
+  index_type extent;
+  const GFC_INTEGER_1 *src;
+  const GFC_INTEGER_1 *maxval;
+  index_type i, j;
+  GFC_LOGICAL_1 *mbase;
+  int mask_kind;
+  index_type mstride;
+
+  extent = GFC_DESCRIPTOR_EXTENT(array,0);
+  if (extent <= 0)
+    return 0;
+
+  sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+  mbase = mask->base_addr;
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    internal_error (NULL, "Funny sized logical array");
+
+  mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
+
+  /* Search for the first occurrence of a true element in mask. */
+  for (j=0; j<extent; j++)
+    {
+      if (*mbase)
+        break;
+      mbase += mstride;
+    }
+
+  if (j == extent)
+    return 0;
+
+  ret = j + 1;
+  src = array->base_addr + j * sstride;
+  maxval = src;
+
+  for (i=j+1; i<=extent; i++)
+    {
+      if (*mbase && compare_fcn (src, maxval, len) > 0)
+      {
+	 ret = i;
+	 maxval = src;
+      }
+      src += sstride;
+      mbase += mstride;
+    }
+  return ret;
+}
+
+extern GFC_INTEGER_8 smaxloc2_8_s1 (gfc_array_s1 * const restrict,
+       		    	GFC_LOGICAL_4 *mask, int);
+export_proto(smaxloc2_8_s1);
+
+GFC_INTEGER_8
+smaxloc2_8_s1 (gfc_array_s1 * const restrict array,
+				 GFC_LOGICAL_4 *mask, gfc_charlen_type len)
+{
+  if (mask)
+    return maxloc2_8_s1 (array, len);
+  else
+    return 0;
+}
+
+#endif

libgfortran/generated/maxloc2_8_s4.c

+/* Implementation of the MAXLOC intrinsic
+   Copyright 2017 Free Software Foundation, Inc.
+   Contributed by Thomas Koenig
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <string.h>
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
+
+static inline int
+compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, int n)
+{
+  if (sizeof (GFC_INTEGER_4) == 1)
+    return memcmp (a, b, n);
+  else
+    return memcmp_char4 (a, b, n);
+}
+
+extern GFC_INTEGER_8 maxloc2_8_s4 (gfc_array_s4 * const restrict, int);
+export_proto(maxloc2_8_s4);
+
+GFC_INTEGER_8
+maxloc2_8_s4 (gfc_array_s4 * const restrict array, gfc_charlen_type len)
+{
+  index_type ret;
+  index_type sstride;
+  index_type extent;
+  const GFC_INTEGER_4 *src;
+  const GFC_INTEGER_4 *maxval;
+  index_type i;
+
+  extent = GFC_DESCRIPTOR_EXTENT(array,0);
+  if (extent <= 0)
+    return 0;
+
+  sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
+
+  ret = 1;
+  src = array->base_addr;
+  maxval = src;
+  for (i=2; i<=extent; i++)
+    {
+      src += sstride;
+      if (compare_fcn (src, maxval, len) > 0)
+      {
+	 ret = i;
+	 maxval = src;
+      }
+    }
+  return ret;
+}
+
+extern GFC_INTEGER_8 mmaxloc2_8_s4 (gfc_array_s4 * const restrict,
+       		    	gfc_array_l1 *const restrict mask, gfc_charlen_type);
+export_proto(mmaxloc2_8_s4);
+
+GFC_INTEGER_8
+mmaxloc2_8_s4 (gfc_array_s4 * const restrict array,
+				 gfc_array_l1 * const restrict mask,
+				 gfc_charlen_type len)
+{
+  index_type ret;
+  index_type sstride;
+  index_type extent;
+  const GFC_INTEGER_4 *src;
+  const GFC_INTEGER_4 *maxval;
+  index_type i, j;
+  GFC_LOGICAL_1 *mbase;
+  int mask_kind;
+  index_type mstride;
+
+  extent = GFC_DESCRIPTOR_EXTENT(array,0);
+  if (extent <= 0)
+    return 0;
+
+  sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len;
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+  mbase = mask->base_addr;
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    internal_error (NULL, "Funny sized logical array");
+
+  mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
+
+  /* Search for the first occurrence of a true element in mask. */
+  for (j=0; j<extent; j++)
+    {
+      if (*mbase)
+        break;
+      mbase += mstride;
+    }
+
+  if (j == extent)
+    return 0;
+
+  ret = j + 1;
+  src = array->base_addr + j * sstride;
+  maxval = src;
+
+  for (i=j+1; i<=extent; i++)
+    {
+      if (*mbase && compare_fcn (src, maxval, len) > 0)
+      {
+	 ret = i;
+	 maxval = src;
+      }
+      src += sstride;
+      mbase += mstride;
+    }
+  return ret;
+}
+
+extern GFC_INTEGER_8 smaxloc2_8_s4 (gfc_array_s4 * const restrict,
+       		    	GFC_LOGICAL_4 *mask, int);
+export_proto(smaxloc2_8_s4);
+
+GFC_INTEGER_8
+smaxloc2_8_s4 (gfc_array_s4 * const restrict array,
+				 GFC_LOGICAL_4 *mask, gfc_charlen_type len)
+{
+  if (mask)
+    return maxloc2_8_s4 (array, len);
+  else
+    return 0;
+}
+
+#endif

libgfortran/generated/minloc0_16_s1.c

+/* Implementation of the MINLOC intrinsic
+   Copyright 2017 Free Software Foundation, Inc.
+   Contributed by Thomas Koenig
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include <limits.h>
+
+
+#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_16)
+
+static inline int
+compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+{
+  if (sizeof (GFC_INTEGER_1) == 1)
+    return memcmp (a, b, n);
+  else
+    return memcmp_char4 (a, b, n);
+
+}
+
+extern void minloc0_16_s1 (gfc_array_i16 * const restrict retarray, 
+	gfc_array_s1 * const restrict array, gfc_charlen_type len);
+export_proto(minloc0_16_s1);
+
+void
+minloc0_16_s1 (gfc_array_i16 * const restrict retarray, 
+	gfc_array_s1 * const restrict array, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  const GFC_INTEGER_1 *base;
+  GFC_INTEGER_16 * restrict dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				"MINLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  const GFC_INTEGER_1 *minval;
+   minval = base;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (compare_fcn (base, minval, len) < 0)
+    {
+      minval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void mminloc0_16_s1 (gfc_array_i16 * const restrict, 
+	gfc_array_s1 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
+export_proto(mminloc0_16_s1);
+
+void
+mminloc0_16_s1 (gfc_array_i16 * const restrict retarray, 
+	gfc_array_s1 * const restrict array,
+	gfc_array_l1 * const restrict mask, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_INTEGER_16 *dest;
+  const GFC_INTEGER_1 *base;
+  GFC_LOGICAL_1 *mbase;
+  int rank;
+  index_type n;
+  int mask_kind;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	{
+
+	  bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				  "MINLOC");
+	  bounds_equal_extents ((array_t *) mask, (array_t *) array,
+				  "MASK argument", "MINLOC");
+	}
+    }
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  mbase = mask->base_addr;
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 0;
+  {
+
+  const GFC_INTEGER_1 *minval;
+
+  minval = NULL;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (*mbase && (minval == NULL || compare_fcn (base, minval, len) < 0))
+    {
+      minval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	  mbase += mstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  mbase -= mstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	      mbase += mstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void sminloc0_16_s1 (gfc_array_i16 * const restrict, 
+	gfc_array_s1 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
+export_proto(sminloc0_16_s1);
+
+void
+sminloc0_16_s1 (gfc_array_i16 * const restrict retarray, 
+	gfc_array_s1 * const restrict array,
+	GFC_LOGICAL_4 * mask, gfc_charlen_type len)
+{
+  index_type rank;
+  index_type dstride;
+  index_type n;
+  GFC_INTEGER_16 *dest;
+
+  if (*mask)
+    {
+      minloc0_16_s1 (retarray, array, len);
+      return;
+    }
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
+    }
+  else if (unlikely (compile_options.bounds_check))
+    {
+       bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+			       "MINLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n<rank; n++)
+    dest[n * dstride] = 0 ;
+}
+#endif

libgfortran/generated/minloc0_16_s4.c

+/* Implementation of the MINLOC intrinsic
+   Copyright 2017 Free Software Foundation, Inc.
+   Contributed by Thomas Koenig
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include <limits.h>
+
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
+
+static inline int
+compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+{
+  if (sizeof (GFC_INTEGER_4) == 1)
+    return memcmp (a, b, n);
+  else
+    return memcmp_char4 (a, b, n);
+
+}
+
+extern void minloc0_16_s4 (gfc_array_i16 * const restrict retarray, 
+	gfc_array_s4 * const restrict array, gfc_charlen_type len);
+export_proto(minloc0_16_s4);
+
+void
+minloc0_16_s4 (gfc_array_i16 * const restrict retarray, 
+	gfc_array_s4 * const restrict array, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  const GFC_INTEGER_4 *base;
+  GFC_INTEGER_16 * restrict dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				"MINLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  const GFC_INTEGER_4 *minval;
+   minval = base;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (compare_fcn (base, minval, len) < 0)
+    {
+      minval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void mminloc0_16_s4 (gfc_array_i16 * const restrict, 
+	gfc_array_s4 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
+export_proto(mminloc0_16_s4);
+
+void
+mminloc0_16_s4 (gfc_array_i16 * const restrict retarray, 
+	gfc_array_s4 * const restrict array,
+	gfc_array_l1 * const restrict mask, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_INTEGER_16 *dest;
+  const GFC_INTEGER_4 *base;
+  GFC_LOGICAL_1 *mbase;
+  int rank;
+  index_type n;
+  int mask_kind;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	{
+
+	  bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				  "MINLOC");
+	  bounds_equal_extents ((array_t *) mask, (array_t *) array,
+				  "MASK argument", "MINLOC");
+	}
+    }
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  mbase = mask->base_addr;
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 0;
+  {
+
+  const GFC_INTEGER_4 *minval;
+
+  minval = NULL;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (*mbase && (minval == NULL || compare_fcn (base, minval, len) < 0))
+    {
+      minval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	  mbase += mstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  mbase -= mstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	      mbase += mstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void sminloc0_16_s4 (gfc_array_i16 * const restrict, 
+	gfc_array_s4 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
+export_proto(sminloc0_16_s4);
+
+void
+sminloc0_16_s4 (gfc_array_i16 * const restrict retarray, 
+	gfc_array_s4 * const restrict array,
+	GFC_LOGICAL_4 * mask, gfc_charlen_type len)
+{
+  index_type rank;
+  index_type dstride;
+  index_type n;
+  GFC_INTEGER_16 *dest;
+
+  if (*mask)
+    {
+      minloc0_16_s4 (retarray, array, len);
+      return;
+    }
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
+    }
+  else if (unlikely (compile_options.bounds_check))
+    {
+       bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+			       "MINLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n<rank; n++)
+    dest[n * dstride] = 0 ;
+}
+#endif

libgfortran/generated/minloc0_4_s1.c

+/* Implementation of the MINLOC intrinsic
+   Copyright 2017 Free Software Foundation, Inc.
+   Contributed by Thomas Koenig
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include <limits.h>
+
+
+#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4)
+
+static inline int
+compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+{
+  if (sizeof (GFC_INTEGER_1) == 1)
+    return memcmp (a, b, n);
+  else
+    return memcmp_char4 (a, b, n);
+
+}
+
+extern void minloc0_4_s1 (gfc_array_i4 * const restrict retarray, 
+	gfc_array_s1 * const restrict array, gfc_charlen_type len);
+export_proto(minloc0_4_s1);
+
+void
+minloc0_4_s1 (gfc_array_i4 * const restrict retarray, 
+	gfc_array_s1 * const restrict array, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  const GFC_INTEGER_1 *base;
+  GFC_INTEGER_4 * restrict dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				"MINLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  const GFC_INTEGER_1 *minval;
+   minval = base;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (compare_fcn (base, minval, len) < 0)
+    {
+      minval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void mminloc0_4_s1 (gfc_array_i4 * const restrict, 
+	gfc_array_s1 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
+export_proto(mminloc0_4_s1);
+
+void
+mminloc0_4_s1 (gfc_array_i4 * const restrict retarray, 
+	gfc_array_s1 * const restrict array,
+	gfc_array_l1 * const restrict mask, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_INTEGER_4 *dest;
+  const GFC_INTEGER_1 *base;
+  GFC_LOGICAL_1 *mbase;
+  int rank;
+  index_type n;
+  int mask_kind;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	{
+
+	  bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				  "MINLOC");
+	  bounds_equal_extents ((array_t *) mask, (array_t *) array,
+				  "MASK argument", "MINLOC");
+	}
+    }
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  mbase = mask->base_addr;
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 0;
+  {
+
+  const GFC_INTEGER_1 *minval;
+
+  minval = NULL;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (*mbase && (minval == NULL || compare_fcn (base, minval, len) < 0))
+    {
+      minval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	  mbase += mstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  mbase -= mstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	      mbase += mstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void sminloc0_4_s1 (gfc_array_i4 * const restrict, 
+	gfc_array_s1 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
+export_proto(sminloc0_4_s1);
+
+void
+sminloc0_4_s1 (gfc_array_i4 * const restrict retarray, 
+	gfc_array_s1 * const restrict array,
+	GFC_LOGICAL_4 * mask, gfc_charlen_type len)
+{
+  index_type rank;
+  index_type dstride;
+  index_type n;
+  GFC_INTEGER_4 *dest;
+
+  if (*mask)
+    {
+      minloc0_4_s1 (retarray, array, len);
+      return;
+    }
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+    }
+  else if (unlikely (compile_options.bounds_check))
+    {
+       bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+			       "MINLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n<rank; n++)
+    dest[n * dstride] = 0 ;
+}
+#endif

libgfortran/generated/minloc0_4_s4.c

+/* Implementation of the MINLOC intrinsic
+   Copyright 2017 Free Software Foundation, Inc.
+   Contributed by Thomas Koenig
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include <limits.h>
+
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
+static inline int
+compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+{
+  if (sizeof (GFC_INTEGER_4) == 1)
+    return memcmp (a, b, n);
+  else
+    return memcmp_char4 (a, b, n);
+
+}
+
+extern void minloc0_4_s4 (gfc_array_i4 * const restrict retarray, 
+	gfc_array_s4 * const restrict array, gfc_charlen_type len);
+export_proto(minloc0_4_s4);
+
+void
+minloc0_4_s4 (gfc_array_i4 * const restrict retarray, 
+	gfc_array_s4 * const restrict array, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  const GFC_INTEGER_4 *base;
+  GFC_INTEGER_4 * restrict dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				"MINLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  const GFC_INTEGER_4 *minval;
+   minval = base;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (compare_fcn (base, minval, len) < 0)
+    {
+      minval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void mminloc0_4_s4 (gfc_array_i4 * const restrict, 
+	gfc_array_s4 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
+export_proto(mminloc0_4_s4);
+
+void
+mminloc0_4_s4 (gfc_array_i4 * const restrict retarray, 
+	gfc_array_s4 * const restrict array,
+	gfc_array_l1 * const restrict mask, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_INTEGER_4 *dest;
+  const GFC_INTEGER_4 *base;
+  GFC_LOGICAL_1 *mbase;
+  int rank;
+  index_type n;
+  int mask_kind;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	{
+
+	  bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				  "MINLOC");
+	  bounds_equal_extents ((array_t *) mask, (array_t *) array,
+				  "MASK argument", "MINLOC");
+	}
+    }
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  mbase = mask->base_addr;
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 0;
+  {
+
+  const GFC_INTEGER_4 *minval;
+
+  minval = NULL;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (*mbase && (minval == NULL || compare_fcn (base, minval, len) < 0))
+    {
+      minval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	  mbase += mstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  mbase -= mstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	      mbase += mstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void sminloc0_4_s4 (gfc_array_i4 * const restrict, 
+	gfc_array_s4 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
+export_proto(sminloc0_4_s4);
+
+void
+sminloc0_4_s4 (gfc_array_i4 * const restrict retarray, 
+	gfc_array_s4 * const restrict array,
+	GFC_LOGICAL_4 * mask, gfc_charlen_type len)
+{
+  index_type rank;
+  index_type dstride;
+  index_type n;
+  GFC_INTEGER_4 *dest;
+
+  if (*mask)
+    {
+      minloc0_4_s4 (retarray, array, len);
+      return;
+    }
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+    }
+  else if (unlikely (compile_options.bounds_check))
+    {
+       bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+			       "MINLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n<rank; n++)
+    dest[n * dstride] = 0 ;
+}
+#endif

libgfortran/generated/minloc0_8_s1.c

+/* Implementation of the MINLOC intrinsic
+   Copyright 2017 Free Software Foundation, Inc.
+   Contributed by Thomas Koenig
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include <limits.h>
+
+
+#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_8)
+
+static inline int
+compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+{
+  if (sizeof (GFC_INTEGER_1) == 1)
+    return memcmp (a, b, n);
+  else
+    return memcmp_char4 (a, b, n);
+
+}
+
+extern void minloc0_8_s1 (gfc_array_i8 * const restrict retarray, 
+	gfc_array_s1 * const restrict array, gfc_charlen_type len);
+export_proto(minloc0_8_s1);
+
+void
+minloc0_8_s1 (gfc_array_i8 * const restrict retarray, 
+	gfc_array_s1 * const restrict array, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  const GFC_INTEGER_1 *base;
+  GFC_INTEGER_8 * restrict dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				"MINLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  const GFC_INTEGER_1 *minval;
+   minval = base;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (compare_fcn (base, minval, len) < 0)
+    {
+      minval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void mminloc0_8_s1 (gfc_array_i8 * const restrict, 
+	gfc_array_s1 * const restrict, gfc_array_l1 * const restrict, gfc_charlen_type len);
+export_proto(mminloc0_8_s1);
+
+void
+mminloc0_8_s1 (gfc_array_i8 * const restrict retarray, 
+	gfc_array_s1 * const restrict array,
+	gfc_array_l1 * const restrict mask, gfc_charlen_type len)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_INTEGER_8 *dest;
+  const GFC_INTEGER_1 *base;
+  GFC_LOGICAL_1 *mbase;
+  int rank;
+  index_type n;
+  int mask_kind;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
+    }
+  else
+    {
+      if (unlikely (compile_options.bounds_check))
+	{
+
+	  bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				  "MINLOC");
+	  bounds_equal_extents ((array_t *) mask, (array_t *) array,
+				  "MASK argument", "MINLOC");
+	}
+    }
+
+  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+  mbase = mask->base_addr;
+
+  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+      || mask_kind == 16
+#endif
+      )
+    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+  else
+    runtime_error ("Funny sized logical array");
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n) * len;
+      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+      count[n] = 0;
+      if (extent[n] <= 0)
+	{
+	  /* Set the return value.  */
+	  for (n = 0; n < rank; n++)
+	    dest[n * dstride] = 0;
+	  return;
+	}
+    }
+
+  base = array->base_addr;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 0;
+  {
+
+  const GFC_INTEGER_1 *minval;
+
+  minval = NULL;
+
+  while (base)
+    {
+      do
+	{
+	  /* Implementation start.  */
+
+  if (*mbase && (minval == NULL || compare_fcn (base, minval, len) < 0))
+    {
+      minval = base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+	  /* Implementation end.  */
+	  /* Advance to the next element.  */
+	  base += sstride[0];
+	  mbase += mstride[0];
+	}
+      while (++count[0] != extent[0]);
+      n = 0;
+      do
+	{
+	  /* When we get to the end of a dimension, reset it and increment
+	     the next dimension.  */
+	  count[n] = 0;
+	  /* We could precalculate these products, but this is a less
+	     frequently used path so probably not worth it.  */
+	  base -= sstride[n] * extent[n];
+	  mbase -= mstride[n] * extent[n];
+	  n++;
+	  if (n >= rank)
+	    {
+	      /* Break out of the loop.  */
+	      base = NULL;
+	      break;
+	    }
+	  else
+	    {
+	      count[n]++;
+	      base += sstride[n];
+	      mbase += mstride[n];
+	    }
+	}
+      while (count[n] == extent[n]);
+    }
+  }
+}
+
+
+extern void sminloc0_8_s1 (gfc_array_i8 * const restrict, 
+	gfc_array_s1 * const restrict, GFC_LOGICAL_4 *, gfc_charlen_type len);
+export_proto(sminloc0_8_s1);
+
+void
+sminloc0_8_s1 (gfc_array_i8 * const restrict retarray, 
+	gfc_array_s1 * const restrict array,
+	GFC_LOGICAL_4 * mask, gfc_charlen_type len)
+{
+  index_type rank;
+  index_type dstride;
+  index_type n;
+  GFC_INTEGER_8 *dest;
+
+  if (*mask)
+    {
+      minloc0_8_s1 (retarray, array, len);
+      return;
+    }
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->base_addr == NULL)
+    {
+      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
+    }
+  else if (unlikely (compile_options.bounds_check))
+    {
+       bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+			       "MINLOC");
+    }
+
+  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+  dest = retarray->base_addr;
+  for (n = 0; n<rank; n++)
+    dest[n * dstride] = 0 ;
+}
+#endif