[thirdparty/gcc.git] / libgfortran / generated / minloc1_16_i8.c

/* Implementation of the MINLOC intrinsic
   Copyright (C) 2002-2019 Free Software Foundation, Inc.
   Contributed by Paul Brook <paul@nowt.org>

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 <assert.h>


#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16)

#define HAVE_BACK_ARG 1


extern void minloc1_16_i8 (gfc_array_i16 * const restrict, 
	gfc_array_i8 * const restrict, const index_type * const restrict, GFC_LOGICAL_4 back);
export_proto(minloc1_16_i8);

void
minloc1_16_i8 (gfc_array_i16 * const restrict retarray, 
	gfc_array_i8 * const restrict array, 
	const index_type * const restrict pdim, GFC_LOGICAL_4 back)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type dstride[GFC_MAX_DIMENSIONS];
  const GFC_INTEGER_8 * restrict base;
  GFC_INTEGER_16 * restrict dest;
  index_type rank;
  index_type n;
  index_type len;
  index_type delta;
  index_type dim;
  int continue_loop;

  /* Make dim zero based to avoid confusion.  */
  rank = GFC_DESCRIPTOR_RANK (array) - 1;
  dim = (*pdim) - 1;

  if (unlikely (dim < 0 || dim > rank))
    {
      runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
 		     "is %ld, should be between 1 and %ld",
		     (long int) dim + 1, (long int) rank + 1);
    }

  len = GFC_DESCRIPTOR_EXTENT(array,dim);
  if (len < 0)
    len = 0;
  delta = GFC_DESCRIPTOR_STRIDE(array,dim);

  for (n = 0; n < dim; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);

      if (extent[n] < 0)
	extent[n] = 0;
    }
  for (n = dim; n < rank; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);

      if (extent[n] < 0)
	extent[n] = 0;
    }

  if (retarray->base_addr == NULL)
    {
      size_t alloc_size, str;

      for (n = 0; n < rank; n++)
	{
	  if (n == 0)
	    str = 1;
	  else
	    str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];

	  GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);

	}

      retarray->offset = 0;
      retarray->dtype.rank = rank;

      alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];

      retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16));
      if (alloc_size == 0)
	{
	  /* Make sure we have a zero-sized array.  */
	  GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
	  return;

	}
    }
  else
    {
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
	runtime_error ("rank of return array incorrect in"
		       " MINLOC intrinsic: is %ld, should be %ld",
		       (long int) (GFC_DESCRIPTOR_RANK (retarray)),
		       (long int) rank);

      if (unlikely (compile_options.bounds_check))
	bounds_ifunction_return ((array_t *) retarray, extent,
				 "return value", "MINLOC");
    }

  for (n = 0; n < rank; n++)
    {
      count[n] = 0;
      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
      if (extent[n] <= 0)
	return;
    }

  base = array->base_addr;
  dest = retarray->base_addr;

  continue_loop = 1;
  while (continue_loop)
    {
      const GFC_INTEGER_8 * restrict src;
      GFC_INTEGER_16 result;
      src = base;
      {

	GFC_INTEGER_8 minval;
#if defined (GFC_INTEGER_8_INFINITY)
	minval = GFC_INTEGER_8_INFINITY;
#else
	minval = GFC_INTEGER_8_HUGE;
#endif
	result = 1;
	if (len <= 0)
	  *dest = 0;
	else
	  {
#if ! defined HAVE_BACK_ARG
	    for (n = 0; n < len; n++, src += delta)
	      {
#endif

#if defined (GFC_INTEGER_8_QUIET_NAN)
     	   for (n = 0; n < len; n++, src += delta)
	     {
		if (*src <= minval)
		  {
		    minval = *src;
		    result = (GFC_INTEGER_16)n + 1;
		    break;
		  }
	      }
#else
	    n = 0;
#endif
	    if (back)
	      for (; n < len; n++, src += delta)
	        {
		  if (unlikely (*src <= minval))
		    {
		      minval = *src;
		      result = (GFC_INTEGER_16)n + 1;
		    }
		}
	    else
	      for (; n < len; n++, src += delta)
	        {
		  if (unlikely (*src < minval))
		    {
		      minval = *src;
		      result = (GFC_INTEGER_16) n + 1;
		    }
	      }
	    
	    *dest = result;
	  }
      }
      /* Advance to the next element.  */
      count[0]++;
      base += sstride[0];
      dest += dstride[0];
      n = 0;
      while (count[n] == extent[n])
	{
	  /* 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];
	  dest -= dstride[n] * extent[n];
	  n++;
	  if (n >= rank)
	    {
	      /* Break out of the loop.  */
	      continue_loop = 0;
	      break;
	    }
	  else
	    {
	      count[n]++;
	      base += sstride[n];
	      dest += dstride[n];
	    }
	}
    }
}


extern void mminloc1_16_i8 (gfc_array_i16 * const restrict, 
	gfc_array_i8 * const restrict, const index_type * const restrict,
	gfc_array_l1 * const restrict, GFC_LOGICAL_4 back);
export_proto(mminloc1_16_i8);

void
mminloc1_16_i8 (gfc_array_i16 * const restrict retarray, 
	gfc_array_i8 * const restrict array, 
	const index_type * const restrict pdim, 
	gfc_array_l1 * const restrict mask, GFC_LOGICAL_4 back)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type dstride[GFC_MAX_DIMENSIONS];
  index_type mstride[GFC_MAX_DIMENSIONS];
  GFC_INTEGER_16 * restrict dest;
  const GFC_INTEGER_8 * restrict base;
  const GFC_LOGICAL_1 * restrict mbase;
  index_type rank;
  index_type dim;
  index_type n;
  index_type len;
  index_type delta;
  index_type mdelta;
  int mask_kind;

  if (mask == NULL)
    {
#ifdef HAVE_BACK_ARG
      minloc1_16_i8 (retarray, array, pdim, back);
#else
      minloc1_16_i8 (retarray, array, pdim);
#endif
      return;
    }

  dim = (*pdim) - 1;
  rank = GFC_DESCRIPTOR_RANK (array) - 1;


  if (unlikely (dim < 0 || dim > rank))
    {
      runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
 		     "is %ld, should be between 1 and %ld",
		     (long int) dim + 1, (long int) rank + 1);
    }

  len = GFC_DESCRIPTOR_EXTENT(array,dim);
  if (len <= 0)
    return;

  mbase = mask->base_addr;

  mask_kind = GFC_DESCRIPTOR_SIZE (mask);

  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");

  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
  mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);

  for (n = 0; n < dim; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);

      if (extent[n] < 0)
	extent[n] = 0;

    }
  for (n = dim; n < rank; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);

      if (extent[n] < 0)
	extent[n] = 0;
    }

  if (retarray->base_addr == NULL)
    {
      size_t alloc_size, str;

      for (n = 0; n < rank; n++)
	{
	  if (n == 0)
	    str = 1;
	  else
	    str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];

	  GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);

	}

      alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];

      retarray->offset = 0;
      retarray->dtype.rank = rank;

      if (alloc_size == 0)
	{
	  /* Make sure we have a zero-sized array.  */
	  GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
	  return;
	}
      else
	retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16));

    }
  else
    {
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
	runtime_error ("rank of return array incorrect in MINLOC intrinsic");

      if (unlikely (compile_options.bounds_check))
	{
	  bounds_ifunction_return ((array_t *) retarray, extent,
				   "return value", "MINLOC");
	  bounds_equal_extents ((array_t *) mask, (array_t *) array,
	  			"MASK argument", "MINLOC");
	}
    }

  for (n = 0; n < rank; n++)
    {
      count[n] = 0;
      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
      if (extent[n] <= 0)
	return;
    }

  dest = retarray->base_addr;
  base = array->base_addr;

  while (base)
    {
      const GFC_INTEGER_8 * restrict src;
      const GFC_LOGICAL_1 * restrict msrc;
      GFC_INTEGER_16 result;
      src = base;
      msrc = mbase;
      {

	GFC_INTEGER_8 minval;
#if defined (GFC_INTEGER_8_INFINITY)
	minval = GFC_INTEGER_8_INFINITY;
#else
	minval = GFC_INTEGER_8_HUGE;
#endif
#if defined (GFC_INTEGER_8_QUIET_NAN)
	GFC_INTEGER_16 result2 = 0;
#endif
	result = 0;
	for (n = 0; n < len; n++, src += delta, msrc += mdelta)
	  {

		if (*msrc)
		  {
#if defined (GFC_INTEGER_8_QUIET_NAN)
		    if (!result2)
		      result2 = (GFC_INTEGER_16)n + 1;
		    if (*src <= minval)
#endif
		      {
			minval = *src;
			result = (GFC_INTEGER_16)n + 1;
			break;
		      }
		  }
	      }
#if defined (GFC_INTEGER_8_QUIET_NAN)
	    if (unlikely (n >= len))
	      result = result2;
	    else
#endif
	    if (back)
	      for (; n < len; n++, src += delta, msrc += mdelta)
	      	{
		  if (*msrc && unlikely (*src <= minval))
		    {
		      minval = *src;
		      result = (GFC_INTEGER_16)n + 1;
		    }
		}
	      else
	        for (; n < len; n++, src += delta, msrc += mdelta)
		  {
		    if (*msrc && unlikely (*src < minval))
		      {
		        minval = *src;
			result = (GFC_INTEGER_16) n + 1;
		      }
	  }
	*dest = result;
      }
      /* Advance to the next element.  */
      count[0]++;
      base += sstride[0];
      mbase += mstride[0];
      dest += dstride[0];
      n = 0;
      while (count[n] == extent[n])
	{
	  /* 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];
	  dest -= dstride[n] * extent[n];
	  n++;
	  if (n >= rank)
	    {
	      /* Break out of the loop.  */
	      base = NULL;
	      break;
	    }
	  else
	    {
	      count[n]++;
	      base += sstride[n];
	      mbase += mstride[n];
	      dest += dstride[n];
	    }
	}
    }
}


extern void sminloc1_16_i8 (gfc_array_i16 * const restrict, 
	gfc_array_i8 * const restrict, const index_type * const restrict,
	GFC_LOGICAL_4 *, GFC_LOGICAL_4 back);
export_proto(sminloc1_16_i8);

void
sminloc1_16_i8 (gfc_array_i16 * const restrict retarray, 
	gfc_array_i8 * const restrict array, 
	const index_type * const restrict pdim, 
	GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type dstride[GFC_MAX_DIMENSIONS];
  GFC_INTEGER_16 * restrict dest;
  index_type rank;
  index_type n;
  index_type dim;


  if (mask == NULL || *mask)
    {
#ifdef HAVE_BACK_ARG
      minloc1_16_i8 (retarray, array, pdim, back);
#else
      minloc1_16_i8 (retarray, array, pdim);
#endif
      return;
    }
  /* Make dim zero based to avoid confusion.  */
  dim = (*pdim) - 1;
  rank = GFC_DESCRIPTOR_RANK (array) - 1;

  if (unlikely (dim < 0 || dim > rank))
    {
      runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
 		     "is %ld, should be between 1 and %ld",
		     (long int) dim + 1, (long int) rank + 1);
    }

  for (n = 0; n < dim; n++)
    {
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);

      if (extent[n] <= 0)
	extent[n] = 0;
    }

  for (n = dim; n < rank; n++)
    {
      extent[n] =
	GFC_DESCRIPTOR_EXTENT(array,n + 1);

      if (extent[n] <= 0)
	extent[n] = 0;
    }

  if (retarray->base_addr == NULL)
    {
      size_t alloc_size, str;

      for (n = 0; n < rank; n++)
	{
	  if (n == 0)
	    str = 1;
	  else
	    str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];

	  GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);

	}

      retarray->offset = 0;
      retarray->dtype.rank = rank;

      alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];

      if (alloc_size == 0)
	{
	  /* Make sure we have a zero-sized array.  */
	  GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
	  return;
	}
      else
	retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16));
    }
  else
    {
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
	runtime_error ("rank of return array incorrect in"
		       " MINLOC intrinsic: is %ld, should be %ld",
		       (long int) (GFC_DESCRIPTOR_RANK (retarray)),
		       (long int) rank);

      if (unlikely (compile_options.bounds_check))
	{
	  for (n=0; n < rank; n++)
	    {
	      index_type ret_extent;

	      ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
	      if (extent[n] != ret_extent)
		runtime_error ("Incorrect extent in return value of"
			       " MINLOC intrinsic in dimension %ld:"
			       " is %ld, should be %ld", (long int) n + 1,
			       (long int) ret_extent, (long int) extent[n]);
	    }
	}
    }

  for (n = 0; n < rank; n++)
    {
      count[n] = 0;
      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
    }

  dest = retarray->base_addr;

  while(1)
    {
      *dest = 0;
      count[0]++;
      dest += dstride[0];
      n = 0;
      while (count[n] == extent[n])
	{
	  /* 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.  */
	  dest -= dstride[n] * extent[n];
	  n++;
	  if (n >= rank)
	    return;
	  else
	    {
	      count[n]++;
	      dest += dstride[n];
	    }
      	}
    }
}

#endif
Commit	Line	Data
920e54ef	1	/* Implementation of the MINLOC intrinsic
fbd26352	2	Copyright (C) 2002-2019 Free Software Foundation, Inc.
920e54ef	3	Contributed by Paul Brook <paul@nowt.org>
920e54ef	4
b4ba8232	5	This file is part of the GNU Fortran runtime library (libgfortran).
920e54ef	6
	7	Libgfortran is free software; you can redistribute it and/or
	8	modify it under the terms of the GNU General Public
	9	License as published by the Free Software Foundation; either
6bc9506f	10	version 3 of the License, or (at your option) any later version.
920e54ef	11
	12	Libgfortran is distributed in the hope that it will be useful,
	13	but WITHOUT ANY WARRANTY; without even the implied warranty of
	14	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	15	GNU General Public License for more details.
	16
6bc9506f	17	Under Section 7 of GPL version 3, you are granted additional
	18	permissions described in the GCC Runtime Library Exception, version
	19	3.1, as published by the Free Software Foundation.
	20
	21	You should have received a copy of the GNU General Public License and
	22	a copy of the GCC Runtime Library Exception along with this program;
	23	see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
	24	<http://www.gnu.org/licenses/>. */
920e54ef	25
41f2d5e8	26	#include "libgfortran.h"
cb458068	27	#include <assert.h>
920e54ef	28
	29
	30	#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16)
	31
cb458068	32	#define HAVE_BACK_ARG 1
cb458068	33
920e54ef	34
b4cafd67	35	extern void minloc1_16_i8 (gfc_array_i16 * const restrict,
cb458068	36	gfc_array_i8 * const restrict, const index_type * const restrict, GFC_LOGICAL_4 back);
920e54ef	37	export_proto(minloc1_16_i8);
	38
	39	void
b4cafd67	40	minloc1_16_i8 (gfc_array_i16 * const restrict retarray,
b4cafd67	41	gfc_array_i8 * const restrict array,
cb458068	42	const index_type * const restrict pdim, GFC_LOGICAL_4 back)
920e54ef	43	{
	44	index_type count[GFC_MAX_DIMENSIONS];
	45	index_type extent[GFC_MAX_DIMENSIONS];
	46	index_type sstride[GFC_MAX_DIMENSIONS];
	47	index_type dstride[GFC_MAX_DIMENSIONS];
b4cafd67	48	const GFC_INTEGER_8 * restrict base;
b4cafd67	49	GFC_INTEGER_16 * restrict dest;
920e54ef	50	index_type rank;
	51	index_type n;
	52	index_type len;
	53	index_type delta;
	54	index_type dim;
393a1b6c	55	int continue_loop;
920e54ef	56
920e54ef	57	/* Make dim zero based to avoid confusion. */
920e54ef	58	rank = GFC_DESCRIPTOR_RANK (array) - 1;
3a33b9df	59	dim = (*pdim) - 1;
	60
	61	if (unlikely (dim < 0 \|\| dim > rank))
	62	{
	63	runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
	64	"is %ld, should be between 1 and %ld",
	65	(long int) dim + 1, (long int) rank + 1);
	66	}
920e54ef	67
827aef63	68	len = GFC_DESCRIPTOR_EXTENT(array,dim);
393a1b6c	69	if (len < 0)
393a1b6c	70	len = 0;
827aef63	71	delta = GFC_DESCRIPTOR_STRIDE(array,dim);
920e54ef	72
	73	for (n = 0; n < dim; n++)
	74	{
827aef63	75	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
827aef63	76	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
a14c06e9	77
	78	if (extent[n] < 0)
	79	extent[n] = 0;
920e54ef	80	}
	81	for (n = dim; n < rank; n++)
	82	{
827aef63	83	sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
827aef63	84	extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
a14c06e9	85
	86	if (extent[n] < 0)
	87	extent[n] = 0;
920e54ef	88	}
920e54ef	89
553877d9	90	if (retarray->base_addr == NULL)
920e54ef	91	{
827aef63	92	size_t alloc_size, str;
a14c06e9	93
920e54ef	94	for (n = 0; n < rank; n++)
7ebee933	95	{
7ebee933	96	if (n == 0)
827aef63	97	str = 1;
7ebee933	98	else
7ebee933	99	str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
827aef63	100
	101	GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
	102
7ebee933	103	}
920e54ef	104
920e54ef	105	retarray->offset = 0;
0bb0be20	106	retarray->dtype.rank = rank;
a14c06e9	107
af1e9051	108	alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
a14c06e9	109
af1e9051	110	retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16));
a14c06e9	111	if (alloc_size == 0)
	112	{
	113	/* Make sure we have a zero-sized array. */
827aef63	114	GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
a14c06e9	115	return;
827aef63	116
a14c06e9	117	}
920e54ef	118	}
	119	else
	120	{
920e54ef	121	if (rank != GFC_DESCRIPTOR_RANK (retarray))
8dec97a0	122	runtime_error ("rank of return array incorrect in"
ae66f8f3	123	" MINLOC intrinsic: is %ld, should be %ld",
	124	(long int) (GFC_DESCRIPTOR_RANK (retarray)),
	125	(long int) rank);
8dec97a0	126
c7fb575f	127	if (unlikely (compile_options.bounds_check))
5d04d450	128	bounds_ifunction_return ((array_t *) retarray, extent,
5d04d450	129	"return value", "MINLOC");
920e54ef	130	}
	131
	132	for (n = 0; n < rank; n++)
	133	{
	134	count[n] = 0;
827aef63	135	dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
920e54ef	136	if (extent[n] <= 0)
7cbf86e5	137	return;
920e54ef	138	}
920e54ef	139
553877d9	140	base = array->base_addr;
553877d9	141	dest = retarray->base_addr;
920e54ef	142
393a1b6c	143	continue_loop = 1;
393a1b6c	144	while (continue_loop)
920e54ef	145	{
b4cafd67	146	const GFC_INTEGER_8 * restrict src;
920e54ef	147	GFC_INTEGER_16 result;
	148	src = base;
	149	{
	150
7ebee933	151	GFC_INTEGER_8 minval;
	152	#if defined (GFC_INTEGER_8_INFINITY)
	153	minval = GFC_INTEGER_8_INFINITY;
	154	#else
	155	minval = GFC_INTEGER_8_HUGE;
	156	#endif
	157	result = 1;
	158	if (len <= 0)
920e54ef	159	*dest = 0;
	160	else
	161	{
ca96069a	162	#if ! defined HAVE_BACK_ARG
920e54ef	163	for (n = 0; n < len; n++, src += delta)
920e54ef	164	{
ca96069a	165	#endif
920e54ef	166
7ebee933	167	#if defined (GFC_INTEGER_8_QUIET_NAN)
ca96069a	168	for (n = 0; n < len; n++, src += delta)
ca96069a	169	{
7ebee933	170	if (*src <= minval)
	171	{
	172	minval = *src;
	173	result = (GFC_INTEGER_16)n + 1;
	174	break;
	175	}
	176	}
ca96069a	177	#else
ca96069a	178	n = 0;
7ebee933	179	#endif
ca96069a	180	if (back)
	181	for (; n < len; n++, src += delta)
	182	{
	183	if (unlikely (*src <= minval))
	184	{
	185	minval = *src;
	186	result = (GFC_INTEGER_16)n + 1;
	187	}
	188	}
	189	else
	190	for (; n < len; n++, src += delta)
	191	{
	192	if (unlikely (*src < minval))
	193	{
	194	minval = *src;
	195	result = (GFC_INTEGER_16) n + 1;
	196	}
7ebee933	197	}
b4ba8232	198
920e54ef	199	*dest = result;
	200	}
	201	}
	202	/* Advance to the next element. */
	203	count[0]++;
	204	base += sstride[0];
	205	dest += dstride[0];
	206	n = 0;
	207	while (count[n] == extent[n])
7ebee933	208	{
	209	/* When we get to the end of a dimension, reset it and increment
	210	the next dimension. */
	211	count[n] = 0;
	212	/* We could precalculate these products, but this is a less
	213	frequently used path so probably not worth it. */
	214	base -= sstride[n] * extent[n];
	215	dest -= dstride[n] * extent[n];
	216	n++;
bacde0a1	217	if (n >= rank)
7ebee933	218	{
bacde0a1	219	/* Break out of the loop. */
393a1b6c	220	continue_loop = 0;
393a1b6c	221	break;
7ebee933	222	}
	223	else
	224	{
	225	count[n]++;
	226	base += sstride[n];
	227	dest += dstride[n];
	228	}
	229	}
920e54ef	230	}
	231	}
	232
	233
b4cafd67	234	extern void mminloc1_16_i8 (gfc_array_i16 * const restrict,
b4cafd67	235	gfc_array_i8 * const restrict, const index_type * const restrict,
cb458068	236	gfc_array_l1 * const restrict, GFC_LOGICAL_4 back);
920e54ef	237	export_proto(mminloc1_16_i8);
	238
	239	void
b4cafd67	240	mminloc1_16_i8 (gfc_array_i16 * const restrict retarray,
	241	gfc_array_i8 * const restrict array,
	242	const index_type * const restrict pdim,
cb458068	243	gfc_array_l1 * const restrict mask, GFC_LOGICAL_4 back)
920e54ef	244	{
	245	index_type count[GFC_MAX_DIMENSIONS];
	246	index_type extent[GFC_MAX_DIMENSIONS];
	247	index_type sstride[GFC_MAX_DIMENSIONS];
	248	index_type dstride[GFC_MAX_DIMENSIONS];
	249	index_type mstride[GFC_MAX_DIMENSIONS];
b4cafd67	250	GFC_INTEGER_16 * restrict dest;
b4cafd67	251	const GFC_INTEGER_8 * restrict base;
7ed8f627	252	const GFC_LOGICAL_1 * restrict mbase;
3a33b9df	253	index_type rank;
3a33b9df	254	index_type dim;
920e54ef	255	index_type n;
	256	index_type len;
	257	index_type delta;
	258	index_type mdelta;
7ed8f627	259	int mask_kind;
920e54ef	260
538bdcdc	261	if (mask == NULL)
	262	{
	263	#ifdef HAVE_BACK_ARG
	264	minloc1_16_i8 (retarray, array, pdim, back);
	265	#else
	266	minloc1_16_i8 (retarray, array, pdim);
	267	#endif
	268	return;
	269	}
	270
920e54ef	271	dim = (*pdim) - 1;
	272	rank = GFC_DESCRIPTOR_RANK (array) - 1;
	273
3a33b9df	274
	275	if (unlikely (dim < 0 \|\| dim > rank))
	276	{
	277	runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
	278	"is %ld, should be between 1 and %ld",
	279	(long int) dim + 1, (long int) rank + 1);
	280	}
	281
827aef63	282	len = GFC_DESCRIPTOR_EXTENT(array,dim);
920e54ef	283	if (len <= 0)
920e54ef	284	return;
7ed8f627	285
553877d9	286	mbase = mask->base_addr;
7ed8f627	287
	288	mask_kind = GFC_DESCRIPTOR_SIZE (mask);
	289
	290	if (mask_kind == 1 \|\| mask_kind == 2 \|\| mask_kind == 4 \|\| mask_kind == 8
	291	#ifdef HAVE_GFC_LOGICAL_16
	292	\|\| mask_kind == 16
	293	#endif
	294	)
	295	mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
	296	else
	297	runtime_error ("Funny sized logical array");
	298
827aef63	299	delta = GFC_DESCRIPTOR_STRIDE(array,dim);
827aef63	300	mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
920e54ef	301
	302	for (n = 0; n < dim; n++)
	303	{
827aef63	304	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
	305	mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
	306	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
a14c06e9	307
	308	if (extent[n] < 0)
	309	extent[n] = 0;
	310
920e54ef	311	}
	312	for (n = dim; n < rank; n++)
	313	{
827aef63	314	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
	315	mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
	316	extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
a14c06e9	317
	318	if (extent[n] < 0)
	319	extent[n] = 0;
920e54ef	320	}
920e54ef	321
553877d9	322	if (retarray->base_addr == NULL)
920e54ef	323	{
827aef63	324	size_t alloc_size, str;
a14c06e9	325
920e54ef	326	for (n = 0; n < rank; n++)
7ebee933	327	{
	328	if (n == 0)
	329	str = 1;
	330	else
	331	str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
827aef63	332
	333	GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
	334
7ebee933	335	}
920e54ef	336
af1e9051	337	alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
a14c06e9	338
920e54ef	339	retarray->offset = 0;
0bb0be20	340	retarray->dtype.rank = rank;
a14c06e9	341
	342	if (alloc_size == 0)
	343	{
	344	/* Make sure we have a zero-sized array. */
827aef63	345	GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
a14c06e9	346	return;
	347	}
	348	else
af1e9051	349	retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16));
a14c06e9	350
920e54ef	351	}
	352	else
	353	{
920e54ef	354	if (rank != GFC_DESCRIPTOR_RANK (retarray))
8dec97a0	355	runtime_error ("rank of return array incorrect in MINLOC intrinsic");
8dec97a0	356
c7fb575f	357	if (unlikely (compile_options.bounds_check))
8dec97a0	358	{
5d04d450	359	bounds_ifunction_return ((array_t *) retarray, extent,
	360	"return value", "MINLOC");
	361	bounds_equal_extents ((array_t ) mask, (array_t ) array,
	362	"MASK argument", "MINLOC");
8dec97a0	363	}
920e54ef	364	}
	365
	366	for (n = 0; n < rank; n++)
	367	{
	368	count[n] = 0;
827aef63	369	dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
920e54ef	370	if (extent[n] <= 0)
7ebee933	371	return;
920e54ef	372	}
920e54ef	373
553877d9	374	dest = retarray->base_addr;
553877d9	375	base = array->base_addr;
920e54ef	376
	377	while (base)
	378	{
b4cafd67	379	const GFC_INTEGER_8 * restrict src;
7ed8f627	380	const GFC_LOGICAL_1 * restrict msrc;
920e54ef	381	GFC_INTEGER_16 result;
	382	src = base;
	383	msrc = mbase;
	384	{
	385
7ebee933	386	GFC_INTEGER_8 minval;
	387	#if defined (GFC_INTEGER_8_INFINITY)
	388	minval = GFC_INTEGER_8_INFINITY;
	389	#else
	390	minval = GFC_INTEGER_8_HUGE;
	391	#endif
	392	#if defined (GFC_INTEGER_8_QUIET_NAN)
	393	GFC_INTEGER_16 result2 = 0;
	394	#endif
	395	result = 0;
08e1eb56	396	for (n = 0; n < len; n++, src += delta, msrc += mdelta)
920e54ef	397	{
920e54ef	398
7ebee933	399	if (*msrc)
	400	{
	401	#if defined (GFC_INTEGER_8_QUIET_NAN)
	402	if (!result2)
	403	result2 = (GFC_INTEGER_16)n + 1;
	404	if (*src <= minval)
	405	#endif
	406	{
	407	minval = *src;
	408	result = (GFC_INTEGER_16)n + 1;
	409	break;
	410	}
	411	}
	412	}
	413	#if defined (GFC_INTEGER_8_QUIET_NAN)
	414	if (unlikely (n >= len))
	415	result = result2;
	416	else
	417	#endif
ca96069a	418	if (back)
	419	for (; n < len; n++, src += delta, msrc += mdelta)
	420	{
	421	if (msrc && unlikely (src <= minval))
	422	{
	423	minval = *src;
	424	result = (GFC_INTEGER_16)n + 1;
	425	}
	426	}
	427	else
	428	for (; n < len; n++, src += delta, msrc += mdelta)
7ebee933	429	{
ca96069a	430	if (msrc && unlikely (src < minval))
	431	{
	432	minval = *src;
	433	result = (GFC_INTEGER_16) n + 1;
	434	}
920e54ef	435	}
08e1eb56	436	*dest = result;
920e54ef	437	}
	438	/* Advance to the next element. */
	439	count[0]++;
	440	base += sstride[0];
	441	mbase += mstride[0];
	442	dest += dstride[0];
	443	n = 0;
	444	while (count[n] == extent[n])
7ebee933	445	{
	446	/* When we get to the end of a dimension, reset it and increment
	447	the next dimension. */
	448	count[n] = 0;
	449	/* We could precalculate these products, but this is a less
	450	frequently used path so probably not worth it. */
	451	base -= sstride[n] * extent[n];
	452	mbase -= mstride[n] * extent[n];
	453	dest -= dstride[n] * extent[n];
	454	n++;
bacde0a1	455	if (n >= rank)
7ebee933	456	{
bacde0a1	457	/* Break out of the loop. */
7ebee933	458	base = NULL;
	459	break;
	460	}
	461	else
	462	{
	463	count[n]++;
	464	base += sstride[n];
	465	mbase += mstride[n];
	466	dest += dstride[n];
	467	}
	468	}
920e54ef	469	}
	470	}
	471
4292b27d	472
	473	extern void sminloc1_16_i8 (gfc_array_i16 * const restrict,
	474	gfc_array_i8 * const restrict, const index_type * const restrict,
cb458068	475	GFC_LOGICAL_4 *, GFC_LOGICAL_4 back);
4292b27d	476	export_proto(sminloc1_16_i8);
	477
	478	void
	479	sminloc1_16_i8 (gfc_array_i16 * const restrict retarray,
	480	gfc_array_i8 * const restrict array,
	481	const index_type * const restrict pdim,
cb458068	482	GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
4292b27d	483	{
f955bfc4	484	index_type count[GFC_MAX_DIMENSIONS];
f955bfc4	485	index_type extent[GFC_MAX_DIMENSIONS];
f955bfc4	486	index_type dstride[GFC_MAX_DIMENSIONS];
f955bfc4	487	GFC_INTEGER_16 * restrict dest;
4292b27d	488	index_type rank;
4292b27d	489	index_type n;
f955bfc4	490	index_type dim;
f955bfc4	491
4292b27d	492
538bdcdc	493	if (mask == NULL \|\| *mask)
4292b27d	494	{
cb458068	495	#ifdef HAVE_BACK_ARG
	496	minloc1_16_i8 (retarray, array, pdim, back);
	497	#else
4292b27d	498	minloc1_16_i8 (retarray, array, pdim);
cb458068	499	#endif
4292b27d	500	return;
4292b27d	501	}
f955bfc4	502	/* Make dim zero based to avoid confusion. */
	503	dim = (*pdim) - 1;
	504	rank = GFC_DESCRIPTOR_RANK (array) - 1;
	505
3a33b9df	506	if (unlikely (dim < 0 \|\| dim > rank))
	507	{
	508	runtime_error ("Dim argument incorrect in MINLOC intrinsic: "
	509	"is %ld, should be between 1 and %ld",
	510	(long int) dim + 1, (long int) rank + 1);
	511	}
	512
f955bfc4	513	for (n = 0; n < dim; n++)
f955bfc4	514	{
827aef63	515	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
f955bfc4	516
	517	if (extent[n] <= 0)
	518	extent[n] = 0;
	519	}
	520
	521	for (n = dim; n < rank; n++)
	522	{
f955bfc4	523	extent[n] =
7ebee933	524	GFC_DESCRIPTOR_EXTENT(array,n + 1);
f955bfc4	525
f955bfc4	526	if (extent[n] <= 0)
7ebee933	527	extent[n] = 0;
f955bfc4	528	}
4292b27d	529
553877d9	530	if (retarray->base_addr == NULL)
4292b27d	531	{
827aef63	532	size_t alloc_size, str;
f955bfc4	533
f955bfc4	534	for (n = 0; n < rank; n++)
7ebee933	535	{
	536	if (n == 0)
	537	str = 1;
	538	else
	539	str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
827aef63	540
	541	GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
	542
7ebee933	543	}
f955bfc4	544
4292b27d	545	retarray->offset = 0;
0bb0be20	546	retarray->dtype.rank = rank;
f955bfc4	547
af1e9051	548	alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
f955bfc4	549
	550	if (alloc_size == 0)
	551	{
	552	/* Make sure we have a zero-sized array. */
827aef63	553	GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
f955bfc4	554	return;
	555	}
	556	else
af1e9051	557	retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_16));
4292b27d	558	}
	559	else
	560	{
f955bfc4	561	if (rank != GFC_DESCRIPTOR_RANK (retarray))
	562	runtime_error ("rank of return array incorrect in"
	563	" MINLOC intrinsic: is %ld, should be %ld",
	564	(long int) (GFC_DESCRIPTOR_RANK (retarray)),
	565	(long int) rank);
	566
c7fb575f	567	if (unlikely (compile_options.bounds_check))
8dec97a0	568	{
f955bfc4	569	for (n=0; n < rank; n++)
	570	{
	571	index_type ret_extent;
4292b27d	572
827aef63	573	ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
f955bfc4	574	if (extent[n] != ret_extent)
	575	runtime_error ("Incorrect extent in return value of"
	576	" MINLOC intrinsic in dimension %ld:"
	577	" is %ld, should be %ld", (long int) n + 1,
	578	(long int) ret_extent, (long int) extent[n]);
	579	}
8dec97a0	580	}
8dec97a0	581	}
4292b27d	582
f955bfc4	583	for (n = 0; n < rank; n++)
	584	{
	585	count[n] = 0;
827aef63	586	dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
f955bfc4	587	}
f955bfc4	588
553877d9	589	dest = retarray->base_addr;
f955bfc4	590
	591	while(1)
	592	{
	593	*dest = 0;
	594	count[0]++;
	595	dest += dstride[0];
	596	n = 0;
	597	while (count[n] == extent[n])
7ebee933	598	{
f955bfc4	599	/* When we get to the end of a dimension, reset it and increment
7ebee933	600	the next dimension. */
	601	count[n] = 0;
	602	/* We could precalculate these products, but this is a less
	603	frequently used path so probably not worth it. */
	604	dest -= dstride[n] * extent[n];
	605	n++;
bacde0a1	606	if (n >= rank)
f955bfc4	607	return;
7ebee933	608	else
	609	{
	610	count[n]++;
	611	dest += dstride[n];
	612	}
f955bfc4	613	}
f955bfc4	614	}
4292b27d	615	}
4292b27d	616
920e54ef	617	#endif