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

7 files changed, 304 insertions, 30 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 3735dc6..91a84fe 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,24 @@
+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-07  Jeff Law  <law@redhat.comg>
 
 	* scanner.c (preprocessor_line): Call linemap_add after a line
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 83bd004..61b72c1 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -3306,18 +3306,10 @@ gfc_check_minloc_maxloc (gfc_actual_arglist *ap)
     {
       if (!type_check (b, 4, BT_LOGICAL) || !scalar_check (b,4))
 	return false;
-
-      /* TODO: Remove this once BACK is actually implemented.  */
-      if (b->expr_type != EXPR_CONSTANT || b->value.logical != 0)
-	{
-	  gfc_error ("BACK argument to %qs intrinsic not yet "
-		     "implemented", gfc_current_intrinsic);
-	  return false;
-	}
     }
   else
     {
-      b = gfc_get_logical_expr (gfc_default_logical_kind, NULL, 0);
+      b = gfc_get_logical_expr (gfc_logical_4_kind, NULL, 0);
       ap->next->next->next->next->expr = b;
     }
 
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index a970e01..fdd85ed 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -32,7 +32,7 @@ along with GCC; see the file COPYING3.  If not see
 
 /* Prototypes.  */
 
-static int min_max_choose (gfc_expr *, gfc_expr *, int);
+static int min_max_choose (gfc_expr *, gfc_expr *, int, bool back_val = false);
 
 gfc_expr gfc_bad_expr;
 
@@ -4877,7 +4877,7 @@ gfc_simplify_merge_bits (gfc_expr *i, gfc_expr *j, gfc_expr *mask_expr)
 /* Selects between current value and extremum for simplify_min_max
    and simplify_minval_maxval.  */
 static int
-min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign)
+min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign, bool back_val)
 {
   int ret;
 
@@ -4940,6 +4940,9 @@ min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign)
       default:
 	gfc_internal_error ("simplify_min_max(): Bad type in arglist");
     }
+  if (back_val && ret == 0)
+    ret = 1;
+
   return ret;
 }
 
@@ -5059,7 +5062,7 @@ gfc_simplify_maxval (gfc_expr *array, gfc_expr* dim, gfc_expr *mask)
 
 static gfc_expr *
 simplify_minmaxloc_to_scalar (gfc_expr *result, gfc_expr *array, gfc_expr *mask,
-			      gfc_expr *extremum, int sign)
+			      gfc_expr *extremum, int sign, bool back_val)
 {
   gfc_expr *a, *m;
   gfc_constructor *array_ctor, *mask_ctor;
@@ -5094,7 +5097,7 @@ simplify_minmaxloc_to_scalar (gfc_expr *result, gfc_expr *array, gfc_expr *mask,
 	  if (!m->value.logical)
 	    continue;
 	}
-      if (min_max_choose (a, extremum, sign) > 0)
+      if (min_max_choose (a, extremum, sign, back_val) > 0)
 	mpz_set (result->value.integer, count);
     }
   mpz_clear (count);
@@ -5106,7 +5109,8 @@ simplify_minmaxloc_to_scalar (gfc_expr *result, gfc_expr *array, gfc_expr *mask,
 
 static gfc_expr *
 simplify_minmaxloc_nodim (gfc_expr *result, gfc_expr *extremum,
-			  gfc_expr *array, gfc_expr *mask, int sign)
+			  gfc_expr *array, gfc_expr *mask, int sign,
+			  bool back_val)
 {
   ssize_t res[GFC_MAX_DIMENSIONS];
   int i, n;
@@ -5158,7 +5162,7 @@ simplify_minmaxloc_nodim (gfc_expr *result, gfc_expr *extremum,
 	  else
 	    ma = true;
 
-	  if (ma && min_max_choose (a, extremum, sign) > 0)
+	  if (ma && min_max_choose (a, extremum, sign, back_val) > 0)
 	    {
 	      for (i = 0; i<array->rank; i++)
 		res[i] = count[i];
@@ -5225,7 +5229,7 @@ new_array (bt type, int kind, int n, locus *where)
 static gfc_expr *
 simplify_minmaxloc_to_array (gfc_expr *result, gfc_expr *array,
 			     gfc_expr *dim, gfc_expr *mask,
-			     gfc_expr *extremum, int sign)
+			     gfc_expr *extremum, int sign, bool back_val)
 {
   mpz_t size;
   int done, i, n, arraysize, resultsize, dim_index, dim_extent, dim_stride;
@@ -5313,7 +5317,7 @@ simplify_minmaxloc_to_array (gfc_expr *result, gfc_expr *array,
       ex = gfc_copy_expr (extremum);
       for (src = base, n = 0; n < dim_extent; src += dim_stride, ++n)
 	{
-	  if (*src && min_max_choose (*src, ex, sign) > 0)
+	  if (*src && min_max_choose (*src, ex, sign, back_val) > 0)
 	    mpz_set_si ((*dest)->value.integer, n + 1);
 	}
 
@@ -5367,12 +5371,13 @@ simplify_minmaxloc_to_array (gfc_expr *result, gfc_expr *array,
 
 gfc_expr *
 gfc_simplify_minmaxloc (gfc_expr *array, gfc_expr *dim, gfc_expr *mask,
-			gfc_expr *kind, int sign)
+			gfc_expr *kind, gfc_expr *back, int sign)
 {
   gfc_expr *result;
   gfc_expr *extremum;
   int ikind;
   int init_val;
+  bool back_val = false;
 
   if (!is_constant_array_expr (array)
       || !gfc_is_constant_expr (dim))
@@ -5391,6 +5396,14 @@ gfc_simplify_minmaxloc (gfc_expr *array, gfc_expr *dim, gfc_expr *mask,
   else
     ikind = gfc_default_integer_kind;
 
+  if (back)
+    {
+      if (back->expr_type != EXPR_CONSTANT)
+	return NULL;
+
+      back_val = back->value.logical;
+    }
+  
   if (sign < 0)
     init_val = INT_MAX;
   else if (sign > 0)
@@ -5408,29 +5421,32 @@ gfc_simplify_minmaxloc (gfc_expr *array, gfc_expr *dim, gfc_expr *mask,
       init_result_expr (result, 0, array);
 
       if (array->rank == 1)
-	return simplify_minmaxloc_to_scalar (result, array, mask, extremum, sign);
+	return simplify_minmaxloc_to_scalar (result, array, mask, extremum,
+					     sign, back_val);
       else
-	return simplify_minmaxloc_to_array (result, array, dim, mask, extremum, sign);
+	return simplify_minmaxloc_to_array (result, array, dim, mask, extremum,
+					    sign, back_val);
     }
   else
     {
       result = new_array (BT_INTEGER, ikind, array->rank, &array->where);
-      return simplify_minmaxloc_nodim (result, extremum, array, mask, sign);
+      return simplify_minmaxloc_nodim (result, extremum, array, mask,
+				       sign, back_val);
     }
 }
 
 gfc_expr *
 gfc_simplify_minloc (gfc_expr *array, gfc_expr *dim, gfc_expr *mask, gfc_expr *kind,
-		     gfc_expr *back ATTRIBUTE_UNUSED)
+		     gfc_expr *back)
 {
-  return gfc_simplify_minmaxloc (array, dim, mask, kind, -1);
+  return gfc_simplify_minmaxloc (array, dim, mask, kind, back, -1);
 }
 
 gfc_expr *
 gfc_simplify_maxloc (gfc_expr *array, gfc_expr *dim, gfc_expr *mask, gfc_expr *kind,
-		     gfc_expr *back ATTRIBUTE_UNUSED)
+		     gfc_expr *back)
 {
-  return gfc_simplify_minmaxloc (array, dim, mask, kind, 1);
+  return gfc_simplify_minmaxloc (array, dim, mask, kind, back, 1);
 }
 
 gfc_expr *
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 87b3ca7..651a97f 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -4684,7 +4684,20 @@ gfc_conv_intrinsic_dot_product (gfc_se * se, gfc_expr * expr)
 	S++;
       }
    For 3) and 5), if mask is scalar, this all goes into a conditional,
-   setting pos = 0; in the else branch.  */
+   setting pos = 0; in the else branch.
+
+   Since we now also support the BACK argument, instead of using
+   if (a[S] < limit), we now use
+
+   if (back)
+     cond = a[S] <= limit;
+   else
+     cond = a[S] < limit;
+   if (cond) {
+     ....
+
+     The optimizer is smart enough to move the condition out of the loop.
+     The are now marked as unlikely to for further speedup.  */
 
 static void
 gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
@@ -4702,6 +4715,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
   tree offset;
   tree nonempty;
   tree lab1, lab2;
+  tree b_if, b_else;
   gfc_loopinfo loop;
   gfc_actual_arglist *actual;
   gfc_ss *arrayss;
@@ -4710,6 +4724,8 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
   gfc_se maskse;
   gfc_expr *arrayexpr;
   gfc_expr *maskexpr;
+  gfc_expr *backexpr;
+  gfc_se backse;
   tree pos;
   int n;
 
@@ -4766,6 +4782,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
   actual = actual->next->next;
   gcc_assert (actual);
   maskexpr = actual->expr;
+  backexpr = actual->next->next->expr;
   nonempty = NULL;
   if (maskexpr && maskexpr->rank != 0)
     {
@@ -4904,6 +4921,10 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
   gfc_conv_expr_val (&arrayse, arrayexpr);
   gfc_add_block_to_block (&block, &arrayse.pre);
 
+  gfc_init_se (&backse, NULL);
+  gfc_conv_expr_val (&backse, backexpr);
+  gfc_add_block_to_block (&block, &backse.pre);
+
   /* We do the following if this is a more extreme value.  */
   gfc_start_block (&ifblock);
 
@@ -4943,9 +4964,33 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
 				op == GT_EXPR ? GE_EXPR : LE_EXPR,
 				logical_type_node, arrayse.expr, limit);
       else
-	cond = fold_build2_loc (input_location, op, logical_type_node,
-				arrayse.expr, limit);
+	{
+	  tree ifbody2, elsebody2;
+	  
+	  /* We switch to > or >= depending on the value of the BACK argument. */
+	  cond = gfc_create_var (logical_type_node, "cond");
+
+	  gfc_start_block (&ifblock);
+	  b_if = fold_build2_loc (input_location, op == GT_EXPR ? GE_EXPR : LE_EXPR,
+				  logical_type_node, arrayse.expr, limit);
+
+	  gfc_add_modify (&ifblock, cond, b_if);
+	  ifbody2 = gfc_finish_block (&ifblock);
+
+	  gfc_start_block (&elseblock);
+	  b_else = fold_build2_loc (input_location, op, logical_type_node,
+				    arrayse.expr, limit);
+
+	  gfc_add_modify (&elseblock, cond, b_else);
+	  elsebody2 = gfc_finish_block (&elseblock);
+
+	  tmp = fold_build3_loc (input_location, COND_EXPR, logical_type_node,
+				 backse.expr, ifbody2, elsebody2);
+
+	  gfc_add_expr_to_block (&block, tmp);
+	}
 
+      cond = gfc_unlikely (cond, PRED_BUILTIN_EXPECT);
       ifbody = build3_v (COND_EXPR, cond, ifbody,
 			 build_empty_stmt (input_location));
     }
@@ -5014,11 +5059,35 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
 
       ifbody = gfc_finish_block (&ifblock);
 
-      cond = fold_build2_loc (input_location, op, logical_type_node,
-			      arrayse.expr, limit);
+      /* We switch to > or >= depending on the value of the BACK argument. */
+      {
+	tree ifbody2, elsebody2;
+
+	cond = gfc_create_var (logical_type_node, "cond");
+
+	gfc_start_block (&ifblock);
+	b_if = fold_build2_loc (input_location, op == GT_EXPR ? GE_EXPR : LE_EXPR,
+				logical_type_node, arrayse.expr, limit);
+
+	gfc_add_modify (&ifblock, cond, b_if);
+	ifbody2 = gfc_finish_block (&ifblock);
 
+	gfc_start_block (&elseblock);
+	b_else = fold_build2_loc (input_location, op, logical_type_node,
+				  arrayse.expr, limit);
+
+	gfc_add_modify (&elseblock, cond, b_else);
+	elsebody2 = gfc_finish_block (&elseblock);
+
+	tmp = fold_build3_loc (input_location, COND_EXPR, logical_type_node,
+			       backse.expr, ifbody2, elsebody2);
+      }
+
+      gfc_add_expr_to_block (&block, tmp);
+      cond = gfc_unlikely (cond, PRED_BUILTIN_EXPECT);
       tmp = build3_v (COND_EXPR, cond, ifbody,
 		      build_empty_stmt (input_location));
+
       gfc_add_expr_to_block (&block, tmp);
 
       if (maskss)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index df4bacb..6a94c06 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+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.
+
 2018-05-07  Nathan Sidwell  <nathan@acm.org>
 
 	* g++.dg/cpp0x/range-for10.C: Delete.
diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_12.f90 b/gcc/testsuite/gfortran.dg/minmaxloc_12.f90
new file mode 100644
index 0000000..54bebba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmaxloc_12.f90
@@ -0,0 +1,67 @@
+! { dg-do  run }
+! Test compile-time simplification of minloc and maxloc with BACK argument
+program main
+  integer, parameter :: i1(*) = [ 1,2,3,1,2,3];
+  integer, parameter :: d1 = minloc(i1,dim=1,back=.true.)
+  integer, parameter :: d2 = minloc(i1,dim=1,back=.false.)
+  integer, parameter :: d3 = maxloc(i1,dim=1,back=.true.)
+  integer, parameter :: d4 = maxloc(i1,dim=1,back=.false.)
+  integer, parameter :: i2(4,4) = reshape([1,2,1,2,2,3,3,2,3,4,4,3,4,5,5,4], &
+       [4,4]);
+  integer, parameter :: d5(2) = minloc(i2,back=.true.)
+  integer, parameter :: d6(2) = maxloc(i2,back=.true.)
+  integer, parameter :: d7(4) = minloc(i2,dim=1,back=.true.)
+  integer, parameter :: d25(4) = minloc(i2,dim=2,mask=i2<2,back=.true.)
+  integer, parameter :: d26(4) = maxloc(i2,dim=1,mask=i2<3,back=.true.)
+
+  integer, parameter :: i3(4,4) = transpose(i2)
+  integer, parameter :: d8(4) = minloc(i3,dim=2,back=.true.)
+  integer, parameter :: i4(4,4) = reshape([1,2,1,2,2,1,2,1,1,2,1,2,2,1,2,1],&
+       ([4,4]))
+  integer, parameter :: d9(4) = minloc(i4,dim=1,mask=i4>1,back=.true.)
+
+  integer, parameter :: d10(4) = maxloc(i4,dim=1,mask=i4>1,back=.true.)
+  character(len=2), parameter :: c0(9) = ["aa", "bb", "aa", &
+       "cc", "bb", "cc", "aa", "bb", "aa"]
+  character(len=2), parameter :: c1 (3,3) = reshape(c0, [3,3]);
+  integer, parameter :: d11(2) = minloc(c1,back=.true.)
+  integer, parameter :: d12(2) = maxloc(c1,back=.true.)
+  integer, parameter :: d13(2) = minloc(c1,mask=c1>"aa",back=.true.)
+  integer, parameter :: d14(2) = maxloc(c1,mask=c1<"cc",back=.true.)
+  integer, parameter :: d15(3) = minloc(c1,dim=1,back=.true.)
+  integer, parameter :: d16(3) = maxloc(c1,dim=1,back=.true.)
+  integer, parameter :: d17(3) = minloc(c1,dim=2,back=.true.)
+  integer, parameter :: d18(3) = maxloc(c1,dim=2,back=.true.)
+  integer, parameter :: d19    = minloc(c0,dim=1,back=.true.)
+  integer, parameter :: d20    = maxloc(c0,dim=1,back=.true.)
+  integer, parameter :: d21    = minloc(c0,dim=1,mask=c0>"aa",back=.true.)
+  integer, parameter :: d22    = maxloc(c0,dim=1,mask=c0<"cc",back=.true.)
+  integer, parameter :: d23(3) = minloc(c1,dim=2,mask=c1>"aa",back=.true.)
+  integer, parameter :: d24(3) = maxloc(c1,dim=2,mask=c1<"cc",back=.true.)
+
+  if (d1 /= 4) STOP 2078
+  if (d2 /= 1) STOP 2079
+  if (d3 /= 6) STOP 2080
+  if (d4 /= 3) STOP 2081
+  if (any (d5 /= [3,1])) STOP 2082
+  if (any (d6 /= [3,4])) STOP 2083
+  if (any (d7 /= [3,4,4,4])) STOP 2084
+  if (any (d8 /= d7)) STOP 2085
+  if (any (d9 /= [4,3,4,3])) STOP 2086
+  if (any (d10 /= d9)) STOP 2087
+  if (any(d11 /= [3,3])) STOP 2088
+  if (any(d12 /= [3,2])) STOP 2089
+  if (any(d13 /= [2,3])) STOP 2090
+  if (any(d14 /= [2,3])) STOP 2091
+  if (any(d15 /= [3,2,3])) STOP 2092
+  if (any(d16 /= [2,3,2])) STOP 2093
+  if (any(d17 /= [3,3,3])) STOP 2094
+  if (any(d18 /= [2,3,2])) STOP 2095
+  if (d19 /= 9) STOP 2096
+  if (d20 /= 6) STOP 2097
+  if (d21 /= 8 .or. d22 /= 8) STOP 2098
+  if (any(d23 /= [2,3,2])) STOP 2099
+  if (any(d24 /= 3)) STOP 2100
+  if (any(d25 /= [1,0,1,0])) STOP 2101
+  if (any(d26 /= [4,4,0,0])) STOP 2102
+end program main
diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_13.f90 b/gcc/testsuite/gfortran.dg/minmaxloc_13.f90
new file mode 100644
index 0000000..3ebfdc9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmaxloc_13.f90
@@ -0,0 +1,103 @@
+! { dg-do  run }
+! Test run-time of MINLOC and MAXLOC with BACK
+program main
+  implicit none
+  integer:: i1(6) 
+  integer:: d1 
+  integer:: d2 
+  integer:: d3 
+  integer:: d4 
+  integer:: i2(4,4) 
+  integer:: d5(2) 
+  integer:: d6(2) 
+  integer:: d7(4) 
+  integer:: d25(4) 
+  integer:: d26(4) 
+
+  integer:: i3(4,4) 
+  integer:: d8(4) 
+  integer:: i4(4,4) 
+  integer:: d9(4) 
+
+  integer:: d10(4) 
+  character(len=2) :: c0(9)
+  character(len=2) :: c1(3,3)
+  integer:: d11(2) 
+  integer:: d12(2) 
+  integer:: d13(2) 
+  integer:: d14(2) 
+  integer:: d15(3) 
+  integer:: d16(3) 
+  integer:: d17(3) 
+  integer:: d18(3) 
+  integer:: d19    
+  integer:: d20    
+  integer:: d21    
+  integer:: d22    
+  integer:: d23(3) 
+  integer:: d24(3)
+
+  i1 = [ 1,2,3,1,2,3];
+  d1 = minloc(i1,dim=1,back=.true.)
+  d2 = minloc(i1,dim=1,back=.false.)
+  d3 = maxloc(i1,dim=1,back=.true.)
+  d4 = maxloc(i1,dim=1,back=.false.)
+  i2 = reshape([1,2,1,2,2,3,3,2,3,4,4,3,4,5,5,4], &
+       [4,4]);
+  d5 = minloc(i2,back=.true.)
+  d6 = maxloc(i2,back=.true.)
+  d7= minloc(i2,dim=1,back=.true.)
+  d25 = minloc(i2,dim=2,mask=i2<2,back=.true.)
+  d26 = maxloc(i2,dim=1,mask=i2<3,back=.true.)
+
+  i3 = transpose(i2)
+  d8 = minloc(i3,dim=2,back=.true.)
+  i4 = reshape([1,2,1,2,2,1,2,1,1,2,1,2,2,1,2,1],&
+       ([4,4]))
+  d9 = minloc(i4,dim=1,mask=i4>1,back=.true.)
+
+  d10 = maxloc(i4,dim=1,mask=i4>1,back=.true.)
+  c0 = ["aa", "bb", "aa", &
+       "cc", "bb", "cc", "aa", "bb", "aa"]
+  c1 = reshape(c0, [3,3]);
+  d11 = minloc(c1,back=.true.)
+  d12 = maxloc(c1,back=.true.)
+  d13 = minloc(c1,mask=c1>"aa",back=.true.)
+  d14 = maxloc(c1,mask=c1<"cc",back=.true.)
+  d15 = minloc(c1,dim=1,back=.true.)
+  d16 = maxloc(c1,dim=1,back=.true.)
+  d17 = minloc(c1,dim=2,back=.true.)
+  d18 = maxloc(c1,dim=2,back=.true.)
+  d19    = minloc(c0,dim=1,back=.true.)
+  d20    = maxloc(c0,dim=1,back=.true.)
+  d21    = minloc(c0,dim=1,mask=c0>"aa",back=.true.)
+  d22    = maxloc(c0,dim=1,mask=c0<"cc",back=.true.)
+  d23 = minloc(c1,dim=2,mask=c1>"aa",back=.true.)
+  d24 = maxloc(c1,dim=2,mask=c1<"cc",back=.true.)
+
+  if (d1 /= 4) STOP 2626
+  if (d2 /= 1) STOP 2627
+  if (d3 /= 6) STOP 2628
+  if (d4 /= 3) STOP 2629
+  if (any (d5 /= [3,1])) STOP 2630
+  if (any (d6 /= [3,4])) STOP 2631
+  if (any (d7 /= [3,4,4,4])) STOP 2632
+  if (any (d8 /= d7)) STOP 2633
+  if (any (d9 /= [4,3,4,3])) STOP 2634
+  if (any (d10 /= d9)) STOP 2635
+  if (any(d11 /= [3,3])) STOP 2636
+  if (any(d12 /= [3,2])) STOP 2637
+  if (any(d13 /= [2,3])) STOP 2638
+  if (any(d14 /= [2,3])) STOP 2639
+  if (any(d15 /= [3,2,3])) STOP 2640
+  if (any(d16 /= [2,3,2])) STOP 2641
+  if (any(d17 /= [3,3,3])) STOP 2642
+  if (any(d18 /= [2,3,2])) STOP 2643
+  if (d19 /= 9) STOP 2644
+  if (d20 /= 6) STOP 2645
+  if (d21 /= 8 .or. d22 /= 8) STOP 2646
+  if (any(d23 /= [2,3,2])) STOP 2647
+  if (any(d24 /= 3)) STOP 2648
+  if (any(d25 /= [1,0,1,0])) STOP 2649
+  if (any(d26 /= [4,4,0,0])) STOP 2650
+end program