re PR fortran/54613 ([F08] Add FINDLOC plus support MAXLOC/MINLOC with KIND=/BACK=)

2018-05-08  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/54613
	* check.c (gfc_check_minmaxloc): Remove error for BACK not being
	implemented.  Use gfc_logical_4_kind for BACK.
	* simplify.c (min_max_choose): Add optional argument back_val.
	Handle it.
	(simplify_minmaxloc_to_scalar): Add argument back_val. Pass
	back_val to min_max_choose.
	(simplify_minmaxloc_to_nodim): Likewise.
	(simplify_minmaxloc_to_array): Likewise.
	(gfc_simplify_minmaxloc): Add argument back, handle it.
	Pass back_val to specific simplification functions.
	(gfc_simplify_minloc): Remove ATTRIBUTE_UNUSED from argument back,
	pass it on to gfc_simplify_minmaxloc.
	(gfc_simplify_maxloc): Likewise.
	* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Adjust
	comment. If BACK is true, use greater or equal (or lesser or
	equal) insteal of greater (or lesser). Mark the condition of
	having found a value which exceeds the limit as unlikely.

2018-05-08  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/54613
	* m4/iforeach-s.m4: Remove assertion that back is zero.
	* m4/iforeach.m4: Likewise.  Remove leading 'do'
	before implementation start.
	* m4/ifunction-s.m4: Remove assertion that back is zero.
	* m4/ifunction.m4: Likewise.  Remove for loop if HAVE_BACK_ARG
	is defined.
	* m4/maxloc0.m4: Reorganize loops. Split loops between >= and =,
	depending if back is true.  Mark the condition of having
	found a value which exceeds the limit as unlikely.
	* m4/minloc0.m4: Likewise.
	* m4/maxloc1.m4: Likewise.
	* m4/minloc1.m4: Likewise.
	* m4/maxloc1s.m4: Handle back argument.
	* m4/minloc1s.m4: Likewise.
	* m4/maxloc2s.m4: Remove assertion that back is zero.
	Remove special handling of loop start. Handle back argument.
	* m4/minloc2s.m4: Likewise.
	* generated/iall_i1.c: Regenerated.
	* generated/iall_i16.c: Regenerated.
	* generated/iall_i2.c: Regenerated.
	* generated/iall_i4.c: Regenerated.
	* generated/iall_i8.c: Regenerated.
	* generated/iany_i1.c: Regenerated.
	* generated/iany_i16.c: Regenerated.
	* generated/iany_i2.c: Regenerated.
	* generated/iany_i4.c: Regenerated.
	* generated/iany_i8.c: Regenerated.
	* generated/iparity_i1.c: Regenerated.
	* generated/iparity_i16.c: Regenerated.
	* generated/iparity_i2.c: Regenerated.
	* generated/iparity_i4.c: Regenerated.
	* generated/iparity_i8.c: Regenerated.
	* generated/maxloc0_16_i1.c: Regenerated.
	* generated/maxloc0_16_i16.c: Regenerated.
	* generated/maxloc0_16_i2.c: Regenerated.
	* generated/maxloc0_16_i4.c: Regenerated.
	* generated/maxloc0_16_i8.c: Regenerated.
	* generated/maxloc0_16_r10.c: Regenerated.
	* generated/maxloc0_16_r16.c: Regenerated.
	* generated/maxloc0_16_r4.c: Regenerated.
	* generated/maxloc0_16_r8.c: Regenerated.
	* generated/maxloc0_16_s1.c: Regenerated.
	* generated/maxloc0_16_s4.c: Regenerated.
	* generated/maxloc0_4_i1.c: Regenerated.
	* generated/maxloc0_4_i16.c: Regenerated.
	* generated/maxloc0_4_i2.c: Regenerated.
	* generated/maxloc0_4_i4.c: Regenerated.
	* generated/maxloc0_4_i8.c: Regenerated.
	* generated/maxloc0_4_r10.c: Regenerated.
	* generated/maxloc0_4_r16.c: Regenerated.
	* generated/maxloc0_4_r4.c: Regenerated.
	* generated/maxloc0_4_r8.c: Regenerated.
	* generated/maxloc0_4_s1.c: Regenerated.
	* generated/maxloc0_4_s4.c: Regenerated.
	* generated/maxloc0_8_i1.c: Regenerated.
	* generated/maxloc0_8_i16.c: Regenerated.
	* generated/maxloc0_8_i2.c: Regenerated.
	* generated/maxloc0_8_i4.c: Regenerated.
	* generated/maxloc0_8_i8.c: Regenerated.
	* generated/maxloc0_8_r10.c: Regenerated.
	* generated/maxloc0_8_r16.c: Regenerated.
	* generated/maxloc0_8_r4.c: Regenerated.
	* generated/maxloc0_8_r8.c: Regenerated.
	* generated/maxloc0_8_s1.c: Regenerated.
	* generated/maxloc0_8_s4.c: Regenerated.
	* generated/maxloc1_16_i1.c: Regenerated.
	* generated/maxloc1_16_i16.c: Regenerated.
	* generated/maxloc1_16_i2.c: Regenerated.
	* generated/maxloc1_16_i4.c: Regenerated.
	* generated/maxloc1_16_i8.c: Regenerated.
	* generated/maxloc1_16_r10.c: Regenerated.
	* generated/maxloc1_16_r16.c: Regenerated.
	* generated/maxloc1_16_r4.c: Regenerated.
	* generated/maxloc1_16_r8.c: Regenerated.
	* generated/maxloc1_16_s1.c: Regenerated.
	* generated/maxloc1_16_s4.c: Regenerated.
	* generated/maxloc1_4_i1.c: Regenerated.
	* generated/maxloc1_4_i16.c: Regenerated.
	* generated/maxloc1_4_i2.c: Regenerated.
	* generated/maxloc1_4_i4.c: Regenerated.
	* generated/maxloc1_4_i8.c: Regenerated.
	* generated/maxloc1_4_r10.c: Regenerated.
	* generated/maxloc1_4_r16.c: Regenerated.
	* generated/maxloc1_4_r4.c: Regenerated.
	* generated/maxloc1_4_r8.c: Regenerated.
	* generated/maxloc1_4_s1.c: Regenerated.
	* generated/maxloc1_4_s4.c: Regenerated.
	* generated/maxloc1_8_i1.c: Regenerated.
	* generated/maxloc1_8_i16.c: Regenerated.
	* generated/maxloc1_8_i2.c: Regenerated.
	* generated/maxloc1_8_i4.c: Regenerated.
	* generated/maxloc1_8_i8.c: Regenerated.
	* generated/maxloc1_8_r10.c: Regenerated.
	* generated/maxloc1_8_r16.c: Regenerated.
	* generated/maxloc1_8_r4.c: Regenerated.
	* generated/maxloc1_8_r8.c: Regenerated.
	* generated/maxloc1_8_s1.c: Regenerated.
	* generated/maxloc1_8_s4.c: Regenerated.
	* generated/maxloc2_16_s1.c: Regenerated.
	* generated/maxloc2_16_s4.c: Regenerated.
	* generated/maxloc2_4_s1.c: Regenerated.
	* generated/maxloc2_4_s4.c: Regenerated.
	* generated/maxloc2_8_s1.c: Regenerated.
	* generated/maxloc2_8_s4.c: Regenerated.
	* generated/maxval_i1.c: Regenerated.
	* generated/maxval_i16.c: Regenerated.
	* generated/maxval_i2.c: Regenerated.
	* generated/maxval_i4.c: Regenerated.
	* generated/maxval_i8.c: Regenerated.
	* generated/maxval_r10.c: Regenerated.
	* generated/maxval_r16.c: Regenerated.
	* generated/maxval_r4.c: Regenerated.
	* generated/maxval_r8.c: Regenerated.
	* generated/minloc0_16_i1.c: Regenerated.
	* generated/minloc0_16_i16.c: Regenerated.
	* generated/minloc0_16_i2.c: Regenerated.
	* generated/minloc0_16_i4.c: Regenerated.
	* generated/minloc0_16_i8.c: Regenerated.
	* generated/minloc0_16_r10.c: Regenerated.
	* generated/minloc0_16_r16.c: Regenerated.
	* generated/minloc0_16_r4.c: Regenerated.
	* generated/minloc0_16_r8.c: Regenerated.
	* generated/minloc0_16_s1.c: Regenerated.
	* generated/minloc0_16_s4.c: Regenerated.
	* generated/minloc0_4_i1.c: Regenerated.
	* generated/minloc0_4_i16.c: Regenerated.
	* generated/minloc0_4_i2.c: Regenerated.
	* generated/minloc0_4_i4.c: Regenerated.
	* generated/minloc0_4_i8.c: Regenerated.
	* generated/minloc0_4_r10.c: Regenerated.
	* generated/minloc0_4_r16.c: Regenerated.
	* generated/minloc0_4_r4.c: Regenerated.
	* generated/minloc0_4_r8.c: Regenerated.
	* generated/minloc0_4_s1.c: Regenerated.
	* generated/minloc0_4_s4.c: Regenerated.
	* generated/minloc0_8_i1.c: Regenerated.
	* generated/minloc0_8_i16.c: Regenerated.
	* generated/minloc0_8_i2.c: Regenerated.
	* generated/minloc0_8_i4.c: Regenerated.
	* generated/minloc0_8_i8.c: Regenerated.
	* generated/minloc0_8_r10.c: Regenerated.
	* generated/minloc0_8_r16.c: Regenerated.
	* generated/minloc0_8_r4.c: Regenerated.
	* generated/minloc0_8_r8.c: Regenerated.
	* generated/minloc0_8_s1.c: Regenerated.
	* generated/minloc0_8_s4.c: Regenerated.
	* generated/minloc1_16_i1.c: Regenerated.
	* generated/minloc1_16_i16.c: Regenerated.
	* generated/minloc1_16_i2.c: Regenerated.
	* generated/minloc1_16_i4.c: Regenerated.
	* generated/minloc1_16_i8.c: Regenerated.
	* generated/minloc1_16_r10.c: Regenerated.
	* generated/minloc1_16_r16.c: Regenerated.
	* generated/minloc1_16_r4.c: Regenerated.
	* generated/minloc1_16_r8.c: Regenerated.
	* generated/minloc1_16_s1.c: Regenerated.
	* generated/minloc1_16_s4.c: Regenerated.
	* generated/minloc1_4_i1.c: Regenerated.
	* generated/minloc1_4_i16.c: Regenerated.
	* generated/minloc1_4_i2.c: Regenerated.
	* generated/minloc1_4_i4.c: Regenerated.
	* generated/minloc1_4_i8.c: Regenerated.
	* generated/minloc1_4_r10.c: Regenerated.
	* generated/minloc1_4_r16.c: Regenerated.
	* generated/minloc1_4_r4.c: Regenerated.
	* generated/minloc1_4_r8.c: Regenerated.
	* generated/minloc1_4_s1.c: Regenerated.
	* generated/minloc1_4_s4.c: Regenerated.
	* generated/minloc1_8_i1.c: Regenerated.
	* generated/minloc1_8_i16.c: Regenerated.
	* generated/minloc1_8_i2.c: Regenerated.
	* generated/minloc1_8_i4.c: Regenerated.
	* generated/minloc1_8_i8.c: Regenerated.
	* generated/minloc1_8_r10.c: Regenerated.
	* generated/minloc1_8_r16.c: Regenerated.
	* generated/minloc1_8_r4.c: Regenerated.
	* generated/minloc1_8_r8.c: Regenerated.
	* generated/minloc1_8_s1.c: Regenerated.
	* generated/minloc1_8_s4.c: Regenerated.
	* generated/minloc2_16_s1.c: Regenerated.
	* generated/minloc2_16_s4.c: Regenerated.
	* generated/minloc2_4_s1.c: Regenerated.
	* generated/minloc2_4_s4.c: Regenerated.
	* generated/minloc2_8_s1.c: Regenerated.
	* generated/minloc2_8_s4.c: Regenerated.
	* generated/minval_i1.c: Regenerated.
	* generated/minval_i16.c: Regenerated.
	* generated/minval_i2.c: Regenerated.
	* generated/minval_i4.c: Regenerated.
	* generated/minval_i8.c: Regenerated.
	* generated/minval_r10.c: Regenerated.
	* generated/minval_r16.c: Regenerated.
	* generated/minval_r4.c: Regenerated.
	* generated/minval_r8.c: Regenerated.
	* generated/norm2_r10.c: Regenerated.
	* generated/norm2_r16.c: Regenerated.
	* generated/norm2_r4.c: Regenerated.
	* generated/norm2_r8.c: Regenerated.
	* generated/parity_l1.c: Regenerated.
	* generated/parity_l16.c: Regenerated.
	* generated/parity_l2.c: Regenerated.
	* generated/parity_l4.c: Regenerated.
	* generated/parity_l8.c: Regenerated.
	* generated/product_c10.c: Regenerated.
	* generated/product_c16.c: Regenerated.
	* generated/product_c4.c: Regenerated.
	* generated/product_c8.c: Regenerated.
	* generated/product_i1.c: Regenerated.
	* generated/product_i16.c: Regenerated.
	* generated/product_i2.c: Regenerated.
	* generated/product_i4.c: Regenerated.
	* generated/product_i8.c: Regenerated.
	* generated/product_r10.c: Regenerated.
	* generated/product_r16.c: Regenerated.
	* generated/product_r4.c: Regenerated.
	* generated/product_r8.c: Regenerated.
	* generated/sum_c10.c: Regenerated.
	* generated/sum_c16.c: Regenerated.
	* generated/sum_c4.c: Regenerated.
	* generated/sum_c8.c: Regenerated.
	* generated/sum_i1.c: Regenerated.
	* generated/sum_i16.c: Regenerated.
	* generated/sum_i2.c: Regenerated.
	* generated/sum_i4.c: Regenerated.
	* generated/sum_i8.c: Regenerated.
	* generated/sum_r10.c: Regenerated.
	* generated/sum_r16.c: Regenerated.
	* generated/sum_r4.c: Regenerated.
	* generated/sum_r8.c: Regenerated.

2018-05-08  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/54613
	* gfortran.dg/minmaxloc_12.f90: New test case.
	* gfortran.dg/minmaxloc_13.f90: New test case.

From-SVN: r260023

14 files changed, 186 insertions, 115 deletions

diff --git a/libgfortran/m4/iforeach-s.m4 b/libgfortran/m4/iforeach-s.m4
index 9711925ed99..494d0626aac 100644
--- a/libgfortran/m4/iforeach-s.m4
+++ b/libgfortran/m4/iforeach-s.m4
@@ -30,10 +30,6 @@ name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray,
   index_type rank;
   index_type n;
 
-#ifdef HAVE_BACK_ARG
-  assert (back == 0);
-#endif
-
   rank = GFC_DESCRIPTOR_RANK (array);
   if (rank <= 0)
     runtime_error ("Rank of array needs to be > 0");
@@ -139,9 +135,6 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray,
   index_type n;
   int mask_kind;
 
-#ifdef HAVE_BACK_ARG
-  assert (back == 0);
-#endif
   rank = GFC_DESCRIPTOR_RANK (array);
   if (rank <= 0)
     runtime_error ("Rank of array needs to be > 0");
diff --git a/libgfortran/m4/iforeach.m4 b/libgfortran/m4/iforeach.m4
index e6365ccc3ef..db063bf655e 100644
--- a/libgfortran/m4/iforeach.m4
+++ b/libgfortran/m4/iforeach.m4
@@ -21,7 +21,6 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
   index_type rank;
   index_type n;
 
-  assert(back == 0);
   rank = GFC_DESCRIPTOR_RANK (array);
   if (rank <= 0)
     runtime_error ("Rank of array needs to be > 0");
@@ -66,8 +65,6 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
 define(START_FOREACH_BLOCK,
 `  while (base)
     {
-      do
-	{
 	  /* Implementation start.  */
 ')dnl
 define(FINISH_FOREACH_FUNCTION,
@@ -126,7 +123,6 @@ void
   index_type n;
   int mask_kind;
 
-  assert(back == 0);
   rank = GFC_DESCRIPTOR_RANK (array);
   if (rank <= 0)
     runtime_error ("Rank of array needs to be > 0");
diff --git a/libgfortran/m4/ifunction-s.m4 b/libgfortran/m4/ifunction-s.m4
index 9b4d96ab622..a5767f58885 100644
--- a/libgfortran/m4/ifunction-s.m4
+++ b/libgfortran/m4/ifunction-s.m4
@@ -54,10 +54,6 @@ void
   index_type dim;
   int continue_loop;
 
-#ifdef HAVE_BACK_ARG
-  assert(back == 0);
-#endif
-
   /* Make dim zero based to avoid confusion.  */
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
   dim = (*pdim) - 1;
@@ -226,9 +222,6 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray,
   index_type mdelta;
   int mask_kind;
 
-#ifdef HAVE_BACK_ARG
-  assert (back == 0);
-#endif
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
 
diff --git a/libgfortran/m4/ifunction.m4 b/libgfortran/m4/ifunction.m4
index 8df072da033..27bad4ece92 100644
--- a/libgfortran/m4/ifunction.m4
+++ b/libgfortran/m4/ifunction.m4
@@ -41,10 +41,6 @@ name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray,
   index_type dim;
   int continue_loop;
 
-#ifdef HAVE_BACK_ARG
-  assert(back == 0);
-#endif
-
   /* Make dim zero based to avoid confusion.  */
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
   dim = (*pdim) - 1;
@@ -144,8 +140,10 @@ define(START_ARRAY_BLOCK,
 	  *dest = '$1`;
 	else
 	  {
+#if ! defined HAVE_BACK_ARG
 	    for (n = 0; n < len; n++, src += delta)
 	      {
+#endif
 ')dnl
 define(FINISH_ARRAY_FUNCTION,
 `	      }
@@ -212,9 +210,6 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const restrict retarray,
   index_type mdelta;
   int mask_kind;
 
-#ifdef HAVE_BACK_ARG
-  assert (back == 0);
-#endif
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
 
diff --git a/libgfortran/m4/maxloc0.m4 b/libgfortran/m4/maxloc0.m4
index 98d898f86a7..ad19885ff90 100644
--- a/libgfortran/m4/maxloc0.m4
+++ b/libgfortran/m4/maxloc0.m4
@@ -43,8 +43,6 @@ FOREACH_FUNCTION(
     maxval = atype_min;
 #endif',
 `#if defined('atype_nan`)
-	}
-      while (0);
       if (unlikely (!fast))
 	{
 	  do
@@ -63,16 +61,29 @@ FOREACH_FUNCTION(
 	  if (likely (fast))
 	    continue;
 	}
-      else do
-	{
+      else
 #endif
-	  if (*base > maxval)
-	    {
-	      maxval = *base;
-	      for (n = 0; n < rank; n++)
-		dest[n * dstride] = count[n] + 1;
-	    }')
-
+        if (back)
+      	  do
+            {
+	      if (unlikely (*base >= maxval))
+	       {
+	         maxval = *base;
+	      	 for (n = 0; n < rank; n++)
+		   dest[n * dstride] = count[n] + 1;
+	       }
+	     base += sstride[0];
+	   }
+         while (++count[0] != extent[0]);
+       else
+         do
+	   {
+	     if (unlikely (*base > maxval))
+	       {
+	         maxval = *base;
+		 for (n = 0; n < rank; n++)
+		   dest[n * dstride] = count[n] + 1;
+	       }')
 MASKED_FOREACH_FUNCTION(
 `  atype_name maxval;
    int fast = 0;
@@ -82,9 +93,7 @@ MASKED_FOREACH_FUNCTION(
 #else
     maxval = atype_min;
 #endif',
-`	}
-      while (0);
-      if (unlikely (!fast))
+`      if (unlikely (!fast))
 	{
 	  do
 	    {
@@ -111,14 +120,28 @@ MASKED_FOREACH_FUNCTION(
 	  if (likely (fast))
 	    continue;
 	}
-      else do
-	{
-	  if (*mbase && *base > maxval)
+      else
+        if (back)
+	  do
 	    {
-	      maxval = *base;
-	      for (n = 0; n < rank; n++)
-		dest[n * dstride] = count[n] + 1;
-	    }')
+	      if (*mbase && *base >= maxval)
+	        {
+	          maxval = *base;
+	          for (n = 0; n < rank; n++)
+		    dest[n * dstride] = count[n] + 1;
+		}
+	      base += sstride[0];
+	    }
+	  while (++count[0] != extent[0]);
+	else
+	  do
+	    {
+	      if (*mbase && unlikely (*base > maxval))
+	        {
+		  maxval = *base;
+		  for (n = 0; n < rank; n++)
+		    dest[n * dstride] = count[n] + 1;
+	        }')
 
 SCALAR_FOREACH_FUNCTION(`0')
 #endif
diff --git a/libgfortran/m4/maxloc0s.m4 b/libgfortran/m4/maxloc0s.m4
index 3c30a666feb..b20233534f8 100644
--- a/libgfortran/m4/maxloc0s.m4
+++ b/libgfortran/m4/maxloc0s.m4
@@ -38,9 +38,10 @@ include(iforeach-s.m4)dnl
 
 FOREACH_FUNCTION(
 `  const atype_name *maxval;
-   maxval = base;'
+   maxval = NULL;'
 ,
-`  if (compare_fcn (base, maxval, len) > 0)
+`    if (maxval == NULL || (back ? compare_fcn (base, maxval, len) >= 0 :
+     		   	   	   compare_fcn (base, maxval, len) > 0))
     {
       maxval = base;
       for (n = 0; n < rank; n++)
@@ -52,7 +53,9 @@ MASKED_FOREACH_FUNCTION(
 
   maxval = NULL;'
 ,
-`  if (*mbase && (maxval == NULL || compare_fcn (base, maxval, len) > 0))
+`  if (*mbase &&
+        (maxval == NULL || (back ? compare_fcn (base, maxval, len) >= 0:
+		   	   	   compare_fcn (base, maxval, len) > 0)))
     {
       maxval = base;
       for (n = 0; n < rank; n++)
diff --git a/libgfortran/m4/maxloc1.m4 b/libgfortran/m4/maxloc1.m4
index 324a699c0bb..811f7fdb80d 100644
--- a/libgfortran/m4/maxloc1.m4
+++ b/libgfortran/m4/maxloc1.m4
@@ -42,6 +42,8 @@ ARRAY_FUNCTION(0,
 #endif
 	result = 1;',
 `#if defined ('atype_nan`)
+     	     for (n = 0; n < len; n++, src += delta)
+	       {
 		if (*src >= maxval)
 		  {
 		    maxval = *src;
@@ -49,10 +51,12 @@ ARRAY_FUNCTION(0,
 		    break;
 		  }
 	      }
+#else
+	    n = 0;
+#endif
 	    for (; n < len; n++, src += delta)
 	      {
-#endif
-		if (*src > maxval)
+		if (back ? *src >= maxval : *src > maxval)
 		  {
 		    maxval = *src;
 		    result = (rtype_name)n + 1;
@@ -88,13 +92,23 @@ MASKED_ARRAY_FUNCTION(0,
 	      result = result2;
 	    else
 #endif
-	    for (; n < len; n++, src += delta, msrc += mdelta)
-	      {
-		if (*msrc && *src > maxval)
-		  {
-		    maxval = *src;
-		    result = (rtype_name)n + 1;
-		  }')
+	    if (back)
+	      for (; n < len; n++, src += delta, msrc += mdelta)
+	      	{
+		  if (*msrc && unlikely (*src >= maxval))
+		    {
+		      maxval = *src;
+		      result = (rtype_name)n + 1;
+		    }
+		}
+	    else
+	      for (; n < len; n++, src += delta, msrc += mdelta)
+	        {
+		  if (*msrc && unlikely (*src > maxval))
+		    {
+		      maxval = *src;
+		      result = (rtype_name)n + 1;
+		    }')
 
 SCALAR_ARRAY_FUNCTION(0)
 
diff --git a/libgfortran/m4/maxloc1s.m4 b/libgfortran/m4/maxloc1s.m4
index 23da4abf068..8b933398370 100644
--- a/libgfortran/m4/maxloc1s.m4
+++ b/libgfortran/m4/maxloc1s.m4
@@ -34,9 +34,10 @@ include(ifunction-s.m4)dnl
 
 ARRAY_FUNCTION(0,
 `	const atype_name *maxval;
-	maxval = base;
-	result = 1;',
-`		if (compare_fcn (src, maxval, string_len) > 0)
+	maxval = NULL;
+	result = 0;',
+`		if (maxval == NULL || (back ? compare_fcn (src, maxval, string_len) >= 0 :
+		   	      	      	      compare_fcn (src, maxval, string_len) > 0))
 		  {
 		    maxval = src;
 		    result = (rtype_name)n + 1;
@@ -55,7 +56,8 @@ MASKED_ARRAY_FUNCTION(0,
 	    }
 	    for (; n < len; n++, src += delta, msrc += mdelta)
 	      {
-		if (*msrc && compare_fcn (src, maxval, string_len) > 0)
+		if (*msrc && (back ? compare_fcn (src, maxval, string_len) >= 0 :
+		   	     	     compare_fcn (src, maxval, string_len) > 0))
 		  {
 		    maxval = src;
 		    result = (rtype_name)n + 1;
diff --git a/libgfortran/m4/maxloc2s.m4 b/libgfortran/m4/maxloc2s.m4
index 5138f696ec3..b30e257bfc3 100644
--- a/libgfortran/m4/maxloc2s.m4
+++ b/libgfortran/m4/maxloc2s.m4
@@ -54,7 +54,6 @@ export_proto('name`'rtype_qual`_'atype_code`);
   const 'atype_name` *maxval;
   index_type i;
 
-  assert(back == 0);
   extent = GFC_DESCRIPTOR_EXTENT(array,0);
   if (extent <= 0)
     return 0;
@@ -63,15 +62,16 @@ export_proto('name`'rtype_qual`_'atype_code`);
 
   ret = 1;
   src = array->base_addr;
-  maxval = src;
-  for (i=2; i<=extent; i++)
+  maxval = NULL;
+  for (i=1; i<=extent; i++)
     {
-      src += sstride;
-      if (compare_fcn (src, maxval, len) > 0)
+      if (maxval == NULL || (back ? compare_fcn (src, maxval, len) >= 0 :
+      	 	    	    	    compare_fcn (src, maxval, len) > 0))
       {
 	 ret = i;
 	 maxval = src;
       }
+      src += sstride;
     }
   return ret;
 }
@@ -96,7 +96,6 @@ m'name`'rtype_qual`_'atype_code` ('atype` * const restrict array,
   int mask_kind;
   index_type mstride;
 
-  assert(back == 0);
   extent = GFC_DESCRIPTOR_EXTENT(array,0);
   if (extent <= 0)
     return 0;
@@ -134,7 +133,8 @@ m'name`'rtype_qual`_'atype_code` ('atype` * const restrict array,
 
   for (i=j+1; i<=extent; i++)
     {
-      if (*mbase && compare_fcn (src, maxval, len) > 0)
+      if (*mbase && (back ? compare_fcn (src, maxval, len) >= 0 :
+      	 	    	   compare_fcn (src, maxval, len) > 0))
       {
 	 ret = i;
 	 maxval = src;
diff --git a/libgfortran/m4/minloc0.m4 b/libgfortran/m4/minloc0.m4
index 78c60d979ee..44174cf03fd 100644
--- a/libgfortran/m4/minloc0.m4
+++ b/libgfortran/m4/minloc0.m4
@@ -43,8 +43,6 @@ FOREACH_FUNCTION(
     minval = atype_max;
 #endif',
 `#if defined('atype_nan`)
-	}
-      while (0);
       if (unlikely (!fast))
 	{
 	  do
@@ -63,16 +61,29 @@ FOREACH_FUNCTION(
 	  if (likely (fast))
 	    continue;
 	}
-      else do
-	{
+      else
 #endif
-	  if (*base < minval)
+    if (back)
+      do
+	{
+	  if (unlikely (*base <= minval))
 	    {
 	      minval = *base;
 	      for (n = 0; n < rank; n++)
 		dest[n * dstride] = count[n] + 1;
+	    }
+	  base += sstride[0];
+	}
+      while (++count[0] != extent[0]);
+    else
+      do
+        {
+	  if (unlikely (*base < minval))
+	    {
+	      minval = *base;
+	      for (n = 0; n < rank; n++)
+	        dest[n * dstride] = count[n] + 1;
 	    }')
-
 MASKED_FOREACH_FUNCTION(
 `  atype_name minval;
    int fast = 0;
@@ -82,9 +93,7 @@ MASKED_FOREACH_FUNCTION(
 #else
     minval = atype_max;
 #endif',
-`	}
-      while (0);
-      if (unlikely (!fast))
+`      if (unlikely (!fast))
 	{
 	  do
 	    {
@@ -111,14 +120,27 @@ MASKED_FOREACH_FUNCTION(
 	  if (likely (fast))
 	    continue;
 	}
-      else do
-	{
-	  if (*mbase && *base < minval)
+        else
+        if (back)
+	  do
 	    {
-	      minval = *base;
-	      for (n = 0; n < rank; n++)
-		dest[n * dstride] = count[n] + 1;
-	    }')
-
+	      if (unlikely (*mbase && (*base <= minval)))
+	        {
+	      	  minval = *base;
+	      	  for (n = 0; n < rank; n++)
+		    dest[n * dstride] = count[n] + 1;
+	    	}
+		base += sstride[0];
+	    }
+	    while (++count[0] != extent[0]);
+	else
+	  do
+	    {
+	      if (unlikely (*mbase && (*base < minval)))
+		{
+		  minval = *base;
+		  for (n = 0; n < rank; n++)
+		    dest[n * dstride] = count[n] + 1;
+		}')
 SCALAR_FOREACH_FUNCTION(`0')
 #endif
diff --git a/libgfortran/m4/minloc0s.m4 b/libgfortran/m4/minloc0s.m4
index c4b9f461ac8..65d11ef62a1 100644
--- a/libgfortran/m4/minloc0s.m4
+++ b/libgfortran/m4/minloc0s.m4
@@ -38,9 +38,10 @@ include(iforeach-s.m4)dnl
 
 FOREACH_FUNCTION(
 `  const atype_name *minval;
-   minval = base;'
+   minval = NULL;'
 ,
-`  if (compare_fcn (base, minval, len) < 0)
+`    if (minval == NULL || (back ? compare_fcn (base, minval, len) <= 0 :
+       	 	    	    	   compare_fcn (base, minval, len) < 0))
     {
       minval = base;
       for (n = 0; n < rank; n++)
@@ -52,7 +53,9 @@ MASKED_FOREACH_FUNCTION(
 
   minval = NULL;'
 ,
-`  if (*mbase && (minval == NULL || compare_fcn (base, minval, len) < 0))
+`  if (*mbase &&
+      (minval == NULL || (back ? compare_fcn (base, minval, len) <= 0 :
+       	 	    	    	 compare_fcn (base, minval, len) < 0)))
     {
       minval = base;
       for (n = 0; n < rank; n++)
diff --git a/libgfortran/m4/minloc1.m4 b/libgfortran/m4/minloc1.m4
index ebf52f09d5f..a83156eaa53 100644
--- a/libgfortran/m4/minloc1.m4
+++ b/libgfortran/m4/minloc1.m4
@@ -42,6 +42,8 @@ ARRAY_FUNCTION(0,
 #endif
 	result = 1;',
 `#if defined ('atype_nan`)
+     	   for (n = 0; n < len; n++, src += delta)
+	     {
 		if (*src <= minval)
 		  {
 		    minval = *src;
@@ -49,14 +51,26 @@ ARRAY_FUNCTION(0,
 		    break;
 		  }
 	      }
-	    for (; n < len; n++, src += delta)
-	      {
+#else
+	    n = 0;
 #endif
-		if (*src < minval)
-		  {
-		    minval = *src;
-		    result = (rtype_name)n + 1;
-		  }')
+	    if (back)
+	      for (; n < len; n++, src += delta)
+	        {
+		  if (unlikely (*src <= minval))
+		    {
+		      minval = *src;
+		      result = (rtype_name)n + 1;
+		    }
+		}
+	    else
+	      for (; n < len; n++, src += delta)
+	        {
+		  if (unlikely (*src < minval))
+		    {
+		      minval = *src;
+		      result = (rtype_name) n + 1;
+		    }')
 
 MASKED_ARRAY_FUNCTION(0,
 `	atype_name minval;
@@ -88,13 +102,23 @@ MASKED_ARRAY_FUNCTION(0,
 	      result = result2;
 	    else
 #endif
-	    for (; n < len; n++, src += delta, msrc += mdelta)
-	      {
-		if (*msrc && *src < minval)
+	    if (back)
+	      for (; n < len; n++, src += delta, msrc += mdelta)
+	      	{
+		  if (*msrc && unlikely (*src <= minval))
+		    {
+		      minval = *src;
+		      result = (rtype_name)n + 1;
+		    }
+		}
+	      else
+	        for (; n < len; n++, src += delta, msrc += mdelta)
 		  {
-		    minval = *src;
-		    result = (rtype_name)n + 1;
-		  }', `')
+		    if (*msrc && unlikely (*src < minval))
+		      {
+		        minval = *src;
+			result = (rtype_name) n + 1;
+		      }')
 
 SCALAR_ARRAY_FUNCTION(0)
 
diff --git a/libgfortran/m4/minloc1s.m4 b/libgfortran/m4/minloc1s.m4
index 6e46631ab8b..e74e2781a50 100644
--- a/libgfortran/m4/minloc1s.m4
+++ b/libgfortran/m4/minloc1s.m4
@@ -34,9 +34,10 @@ include(ifunction-s.m4)dnl
 
 ARRAY_FUNCTION(0,
 `	const atype_name *minval;
-	minval = base;
-	result = 1;',
-`		if (compare_fcn (src, minval, string_len) < 0)
+	minval = NULL;
+	result = 0;',
+`		if (minval == NULL || (back ? compare_fcn (src, minval, string_len) <= 0 :
+		   	      	      	      compare_fcn (src, minval, string_len) < 0))
 		  {
 		    minval = src;
 		    result = (rtype_name)n + 1;
@@ -55,7 +56,8 @@ MASKED_ARRAY_FUNCTION(0,
             }
 	    for (; n < len; n++, src += delta, msrc += mdelta)
 	      {
-		if (*msrc && compare_fcn (src, minval, string_len) < 0)
+		if (*msrc && (back ? compare_fcn (src, minval, string_len) <= 0 :
+		   	     	     compare_fcn (src, minval, string_len) < 0))
 		  {
 		    minval = src;
 		    result = (rtype_name)n + 1;
diff --git a/libgfortran/m4/minloc2s.m4 b/libgfortran/m4/minloc2s.m4
index 2df71bb34b9..0cdb2a55089 100644
--- a/libgfortran/m4/minloc2s.m4
+++ b/libgfortran/m4/minloc2s.m4
@@ -52,10 +52,9 @@ export_proto('name`'rtype_qual`_'atype_code`);
   index_type sstride;
   index_type extent;
   const 'atype_name` *src;
-  const 'atype_name` *maxval;
+  const 'atype_name` *minval;
   index_type i;
 
-  assert(back == 0);
   extent = GFC_DESCRIPTOR_EXTENT(array,0);
   if (extent <= 0)
     return 0;
@@ -64,15 +63,16 @@ export_proto('name`'rtype_qual`_'atype_code`);
 
   ret = 1;
   src = array->base_addr;
-  maxval = src;
-  for (i=2; i<=extent; i++)
+  minval = NULL;
+  for (i=1; i<=extent; i++)
     {
-      src += sstride;
-      if (compare_fcn (src, maxval, len) < 0)
+      if (minval == NULL || (back ? compare_fcn (src, minval, len) <= 0 :
+      	 	    	    	    compare_fcn (src, minval, len) < 0))
       {
 	 ret = i;
-	 maxval = src;
+	 minval = src;
       }
+      src += sstride;
     }
   return ret;
 }
@@ -97,7 +97,6 @@ m'name`'rtype_qual`_'atype_code` ('atype` * const restrict array,
   int mask_kind;
   index_type mstride;
 
-  assert (back == 0);
   extent = GFC_DESCRIPTOR_EXTENT(array,0);
   if (extent <= 0)
     return 0;
@@ -135,7 +134,9 @@ m'name`'rtype_qual`_'atype_code` ('atype` * const restrict array,
 
   for (i=j+1; i<=extent; i++)
     {
-      if (*mbase && compare_fcn (src, maxval, len) < 0)
+
+      if (*mbase && (back ? compare_fcn (src, maxval, len) <= 0 :
+      	 	    	    compare_fcn (src, maxval, len) < 0))
       {
 	 ret = i;
 	 maxval = src;