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

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

This file is part of the GNU Fortran 95 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_16) && defined (HAVE_GFC_INTEGER_4)


extern void maxloc0_4_i16 (gfc_array_i4 * const restrict retarray, 
	gfc_array_i16 * const restrict array, GFC_LOGICAL_4);
export_proto(maxloc0_4_i16);

void
maxloc0_4_i16 (gfc_array_i4 * const restrict retarray, 
	gfc_array_i16 * const restrict array, 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;
  const GFC_INTEGER_16 *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.rank = 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);
      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;
  {

    GFC_INTEGER_16 maxval;
#if defined(GFC_INTEGER_16_QUIET_NAN)
    int fast = 0;
#endif

#if defined(GFC_INTEGER_16_INFINITY)
    maxval = -GFC_INTEGER_16_INFINITY;
#else
    maxval = (-GFC_INTEGER_16_HUGE-1);
#endif
  while (base)
    {
	  /* Implementation start.  */

#if defined(GFC_INTEGER_16_QUIET_NAN)
      if (unlikely (!fast))
	{
	  do
	    {
	      if (*base >= maxval)
		{
		  fast = 1;
		  maxval = *base;
		  for (n = 0; n < rank; n++)
		    dest[n * dstride] = count[n] + 1;
		  break;
		}
	      base += sstride[0];
	    }
	  while (++count[0] != extent[0]);
	  if (likely (fast))
	    continue;
	}
      else
#endif
        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;
	       }
	  /* 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_i16 (gfc_array_i4 * const restrict, 
	gfc_array_i16 * const restrict, gfc_array_l1 * const restrict,
	GFC_LOGICAL_4);
export_proto(mmaxloc0_4_i16);

void
mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray, 
	gfc_array_i16 * const restrict array,
	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 mstride[GFC_MAX_DIMENSIONS];
  index_type dstride;
  GFC_INTEGER_4 *dest;
  const GFC_INTEGER_16 *base;
  GFC_LOGICAL_1 *mbase;
  int rank;
  index_type n;
  int mask_kind;


  if (mask == NULL)
    {
      maxloc0_4_i16 (retarray, array, back);
      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.rank = 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);
      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;
  {

  GFC_INTEGER_16 maxval;
   int fast = 0;

#if defined(GFC_INTEGER_16_INFINITY)
    maxval = -GFC_INTEGER_16_INFINITY;
#else
    maxval = (-GFC_INTEGER_16_HUGE-1);
#endif
  while (base)
    {
	  /* Implementation start.  */

      if (unlikely (!fast))
	{
	  do
	    {
	      if (*mbase)
		{
#if defined(GFC_INTEGER_16_QUIET_NAN)
		  if (unlikely (dest[0] == 0))
		    for (n = 0; n < rank; n++)
		      dest[n * dstride] = count[n] + 1;
		  if (*base >= maxval)
#endif
		    {
		      fast = 1;
		      maxval = *base;
		      for (n = 0; n < rank; n++)
			dest[n * dstride] = count[n] + 1;
		      break;
		    }
		}
	      base += sstride[0];
	      mbase += mstride[0];
	    }
	  while (++count[0] != extent[0]);
	  if (likely (fast))
	    continue;
	}
      else
        if (back)
	  do
	    {
	      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;
	        }
	  /* 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_i16 (gfc_array_i4 * const restrict, 
	gfc_array_i16 * const restrict, GFC_LOGICAL_4 *, GFC_LOGICAL_4);
export_proto(smaxloc0_4_i16);

void
smaxloc0_4_i16 (gfc_array_i4 * const restrict retarray, 
	gfc_array_i16 * const restrict array,
	GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
{
  index_type rank;
  index_type dstride;
  index_type n;
  GFC_INTEGER_4 *dest;

  if (mask == NULL || *mask)
    {
      maxloc0_4_i16 (retarray, array, back);
      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.rank = 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
Commit	Line	Data
920e54ef	1	/* Implementation of the MAXLOC intrinsic
fbd26352	2	Copyright (C) 2002-2019 Free Software Foundation, Inc.
920e54ef	3	Contributed by Paul Brook <paul@nowt.org>
	4
	5	This file is part of the GNU Fortran 95 runtime library (libgfortran).
	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_16) && defined (HAVE_GFC_INTEGER_4)
	31
	32
b4cafd67	33	extern void maxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
cb458068	34	gfc_array_i16 * const restrict array, GFC_LOGICAL_4);
920e54ef	35	export_proto(maxloc0_4_i16);
	36
	37	void
b4cafd67	38	maxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
cb458068	39	gfc_array_i16 * const restrict array, GFC_LOGICAL_4 back)
920e54ef	40	{
	41	index_type count[GFC_MAX_DIMENSIONS];
	42	index_type extent[GFC_MAX_DIMENSIONS];
	43	index_type sstride[GFC_MAX_DIMENSIONS];
	44	index_type dstride;
b4cafd67	45	const GFC_INTEGER_16 *base;
9d259edf	46	GFC_INTEGER_4 * restrict dest;
920e54ef	47	index_type rank;
	48	index_type n;
	49
	50	rank = GFC_DESCRIPTOR_RANK (array);
	51	if (rank <= 0)
	52	runtime_error ("Rank of array needs to be > 0");
	53
553877d9	54	if (retarray->base_addr == NULL)
920e54ef	55	{
827aef63	56	GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
0bb0be20	57	retarray->dtype.rank = 1;
920e54ef	58	retarray->offset = 0;
af1e9051	59	retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
920e54ef	60	}
	61	else
	62	{
c7fb575f	63	if (unlikely (compile_options.bounds_check))
7ebee933	64	bounds_iforeach_return ((array_t ) retarray, (array_t ) array,
7ebee933	65	"MAXLOC");
920e54ef	66	}
920e54ef	67
827aef63	68	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
553877d9	69	dest = retarray->base_addr;
920e54ef	70	for (n = 0; n < rank; n++)
920e54ef	71	{
827aef63	72	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
827aef63	73	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
920e54ef	74	count[n] = 0;
	75	if (extent[n] <= 0)
	76	{
	77	/* Set the return value. */
	78	for (n = 0; n < rank; n++)
	79	dest[n * dstride] = 0;
	80	return;
	81	}
	82	}
	83
553877d9	84	base = array->base_addr;
920e54ef	85
	86	/* Initialize the return value. */
	87	for (n = 0; n < rank; n++)
7ebee933	88	dest[n * dstride] = 1;
920e54ef	89	{
920e54ef	90
7ebee933	91	GFC_INTEGER_16 maxval;
	92	#if defined(GFC_INTEGER_16_QUIET_NAN)
	93	int fast = 0;
	94	#endif
920e54ef	95
7ebee933	96	#if defined(GFC_INTEGER_16_INFINITY)
	97	maxval = -GFC_INTEGER_16_INFINITY;
	98	#else
	99	maxval = (-GFC_INTEGER_16_HUGE-1);
	100	#endif
920e54ef	101	while (base)
920e54ef	102	{
7ebee933	103	/* Implementation start. */
920e54ef	104
7ebee933	105	#if defined(GFC_INTEGER_16_QUIET_NAN)
7ebee933	106	if (unlikely (!fast))
	107	{
	108	do
	109	{
	110	if (*base >= maxval)
	111	{
	112	fast = 1;
	113	maxval = *base;
	114	for (n = 0; n < rank; n++)
	115	dest[n * dstride] = count[n] + 1;
	116	break;
	117	}
	118	base += sstride[0];
	119	}
	120	while (++count[0] != extent[0]);
	121	if (likely (fast))
	122	continue;
	123	}
ca96069a	124	else
7ebee933	125	#endif
ca96069a	126	if (back)
	127	do
	128	{
	129	if (unlikely (*base >= maxval))
	130	{
	131	maxval = *base;
	132	for (n = 0; n < rank; n++)
	133	dest[n * dstride] = count[n] + 1;
	134	}
	135	base += sstride[0];
	136	}
	137	while (++count[0] != extent[0]);
	138	else
	139	do
	140	{
	141	if (unlikely (*base > maxval))
	142	{
	143	maxval = *base;
	144	for (n = 0; n < rank; n++)
	145	dest[n * dstride] = count[n] + 1;
	146	}
7ebee933	147	/* Implementation end. */
	148	/* Advance to the next element. */
	149	base += sstride[0];
	150	}
	151	while (++count[0] != extent[0]);
920e54ef	152	n = 0;
7ebee933	153	do
	154	{
	155	/* When we get to the end of a dimension, reset it and increment
	156	the next dimension. */
	157	count[n] = 0;
	158	/* We could precalculate these products, but this is a less
	159	frequently used path so probably not worth it. */
	160	base -= sstride[n] * extent[n];
	161	n++;
bacde0a1	162	if (n >= rank)
7ebee933	163	{
	164	/* Break out of the loop. */
	165	base = NULL;
	166	break;
	167	}
	168	else
	169	{
	170	count[n]++;
	171	base += sstride[n];
	172	}
	173	}
	174	while (count[n] == extent[n]);
920e54ef	175	}
	176	}
	177	}
	178
b4cafd67	179	extern void mmaxloc0_4_i16 (gfc_array_i4 * const restrict,
cb458068	180	gfc_array_i16 * const restrict, gfc_array_l1 * const restrict,
cb458068	181	GFC_LOGICAL_4);
920e54ef	182	export_proto(mmaxloc0_4_i16);
	183
	184	void
b4cafd67	185	mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
b4cafd67	186	gfc_array_i16 * const restrict array,
cb458068	187	gfc_array_l1 * const restrict mask, GFC_LOGICAL_4 back)
920e54ef	188	{
	189	index_type count[GFC_MAX_DIMENSIONS];
	190	index_type extent[GFC_MAX_DIMENSIONS];
	191	index_type sstride[GFC_MAX_DIMENSIONS];
	192	index_type mstride[GFC_MAX_DIMENSIONS];
	193	index_type dstride;
	194	GFC_INTEGER_4 *dest;
b4cafd67	195	const GFC_INTEGER_16 *base;
7ed8f627	196	GFC_LOGICAL_1 *mbase;
920e54ef	197	int rank;
920e54ef	198	index_type n;
7ed8f627	199	int mask_kind;
920e54ef	200
538bdcdc	201
	202	if (mask == NULL)
	203	{
	204	maxloc0_4_i16 (retarray, array, back);
	205	return;
	206	}
	207
920e54ef	208	rank = GFC_DESCRIPTOR_RANK (array);
	209	if (rank <= 0)
	210	runtime_error ("Rank of array needs to be > 0");
	211
553877d9	212	if (retarray->base_addr == NULL)
920e54ef	213	{
827aef63	214	GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
0bb0be20	215	retarray->dtype.rank = 1;
920e54ef	216	retarray->offset = 0;
af1e9051	217	retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
920e54ef	218	}
	219	else
	220	{
c7fb575f	221	if (unlikely (compile_options.bounds_check))
8dec97a0	222	{
5d04d450	223
	224	bounds_iforeach_return ((array_t ) retarray, (array_t ) array,
	225	"MAXLOC");
	226	bounds_equal_extents ((array_t ) mask, (array_t ) array,
	227	"MASK argument", "MAXLOC");
8dec97a0	228	}
920e54ef	229	}
920e54ef	230
7ed8f627	231	mask_kind = GFC_DESCRIPTOR_SIZE (mask);
7ed8f627	232
553877d9	233	mbase = mask->base_addr;
7ed8f627	234
	235	if (mask_kind == 1 \|\| mask_kind == 2 \|\| mask_kind == 4 \|\| mask_kind == 8
	236	#ifdef HAVE_GFC_LOGICAL_16
	237	\|\| mask_kind == 16
	238	#endif
	239	)
	240	mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
	241	else
	242	runtime_error ("Funny sized logical array");
	243
827aef63	244	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
553877d9	245	dest = retarray->base_addr;
920e54ef	246	for (n = 0; n < rank; n++)
920e54ef	247	{
827aef63	248	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
	249	mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
	250	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
920e54ef	251	count[n] = 0;
	252	if (extent[n] <= 0)
	253	{
	254	/* Set the return value. */
	255	for (n = 0; n < rank; n++)
	256	dest[n * dstride] = 0;
	257	return;
	258	}
	259	}
	260
553877d9	261	base = array->base_addr;
920e54ef	262
	263	/* Initialize the return value. */
	264	for (n = 0; n < rank; n++)
b1660f25	265	dest[n * dstride] = 0;
920e54ef	266	{
	267
	268	GFC_INTEGER_16 maxval;
7ebee933	269	int fast = 0;
920e54ef	270
7ebee933	271	#if defined(GFC_INTEGER_16_INFINITY)
	272	maxval = -GFC_INTEGER_16_INFINITY;
	273	#else
	274	maxval = (-GFC_INTEGER_16_HUGE-1);
	275	#endif
920e54ef	276	while (base)
920e54ef	277	{
7ebee933	278	/* Implementation start. */
920e54ef	279
7ebee933	280	if (unlikely (!fast))
	281	{
	282	do
	283	{
	284	if (*mbase)
	285	{
	286	#if defined(GFC_INTEGER_16_QUIET_NAN)
	287	if (unlikely (dest[0] == 0))
	288	for (n = 0; n < rank; n++)
	289	dest[n * dstride] = count[n] + 1;
	290	if (*base >= maxval)
	291	#endif
	292	{
	293	fast = 1;
	294	maxval = *base;
	295	for (n = 0; n < rank; n++)
	296	dest[n * dstride] = count[n] + 1;
	297	break;
	298	}
	299	}
	300	base += sstride[0];
	301	mbase += mstride[0];
	302	}
	303	while (++count[0] != extent[0]);
	304	if (likely (fast))
	305	continue;
	306	}
ca96069a	307	else
	308	if (back)
	309	do
7ebee933	310	{
ca96069a	311	if (mbase && base >= maxval)
	312	{
	313	maxval = *base;
	314	for (n = 0; n < rank; n++)
	315	dest[n * dstride] = count[n] + 1;
	316	}
	317	base += sstride[0];
7ebee933	318	}
ca96069a	319	while (++count[0] != extent[0]);
	320	else
	321	do
	322	{
	323	if (mbase && unlikely (base > maxval))
	324	{
	325	maxval = *base;
	326	for (n = 0; n < rank; n++)
	327	dest[n * dstride] = count[n] + 1;
	328	}
7ebee933	329	/* Implementation end. */
	330	/* Advance to the next element. */
	331	base += sstride[0];
	332	mbase += mstride[0];
	333	}
	334	while (++count[0] != extent[0]);
920e54ef	335	n = 0;
7ebee933	336	do
	337	{
	338	/* When we get to the end of a dimension, reset it and increment
	339	the next dimension. */
	340	count[n] = 0;
	341	/* We could precalculate these products, but this is a less
	342	frequently used path so probably not worth it. */
	343	base -= sstride[n] * extent[n];
	344	mbase -= mstride[n] * extent[n];
	345	n++;
bacde0a1	346	if (n >= rank)
7ebee933	347	{
	348	/* Break out of the loop. */
	349	base = NULL;
	350	break;
	351	}
	352	else
	353	{
	354	count[n]++;
	355	base += sstride[n];
	356	mbase += mstride[n];
	357	}
	358	}
	359	while (count[n] == extent[n]);
920e54ef	360	}
	361	}
	362	}
	363
4292b27d	364
4292b27d	365	extern void smaxloc0_4_i16 (gfc_array_i4 * const restrict,
cb458068	366	gfc_array_i16 * const restrict, GFC_LOGICAL_4 *, GFC_LOGICAL_4);
4292b27d	367	export_proto(smaxloc0_4_i16);
	368
	369	void
	370	smaxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
	371	gfc_array_i16 * const restrict array,
cb458068	372	GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
4292b27d	373	{
	374	index_type rank;
	375	index_type dstride;
	376	index_type n;
	377	GFC_INTEGER_4 *dest;
	378
538bdcdc	379	if (mask == NULL \|\| *mask)
4292b27d	380	{
cb458068	381	maxloc0_4_i16 (retarray, array, back);
4292b27d	382	return;
	383	}
	384
	385	rank = GFC_DESCRIPTOR_RANK (array);
	386
	387	if (rank <= 0)
	388	runtime_error ("Rank of array needs to be > 0");
	389
553877d9	390	if (retarray->base_addr == NULL)
4292b27d	391	{
827aef63	392	GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
0bb0be20	393	retarray->dtype.rank = 1;
4292b27d	394	retarray->offset = 0;
af1e9051	395	retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
4292b27d	396	}
5d04d450	397	else if (unlikely (compile_options.bounds_check))
4292b27d	398	{
5d04d450	399	bounds_iforeach_return ((array_t ) retarray, (array_t ) array,
5d04d450	400	"MAXLOC");
4292b27d	401	}
4292b27d	402
827aef63	403	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
553877d9	404	dest = retarray->base_addr;
4292b27d	405	for (n = 0; n<rank; n++)
	406	dest[n * dstride] = 0 ;
	407	}
920e54ef	408	#endif