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

/* Implementation of the MAXLOC intrinsic
   Copyright (C) 2002-2020 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_8) && defined (HAVE_GFC_INTEGER_4)


extern void maxloc0_4_i8 (gfc_array_i4 * const restrict retarray, 
	gfc_array_i8 * const restrict array, GFC_LOGICAL_4);
export_proto(maxloc0_4_i8);

void
maxloc0_4_i8 (gfc_array_i4 * const restrict retarray, 
	gfc_array_i8 * 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_8 *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_8 maxval;
#if defined(GFC_INTEGER_8_QUIET_NAN)
    int fast = 0;
#endif

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

#if defined(GFC_INTEGER_8_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_i8 (gfc_array_i4 * const restrict, 
	gfc_array_i8 * const restrict, gfc_array_l1 * const restrict,
	GFC_LOGICAL_4);
export_proto(mmaxloc0_4_i8);

void
mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray, 
	gfc_array_i8 * 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_8 *base;
  GFC_LOGICAL_1 *mbase;
  int rank;
  index_type n;
  int mask_kind;


  if (mask == NULL)
    {
      maxloc0_4_i8 (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_8 maxval;
   int fast = 0;

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

      if (unlikely (!fast))
	{
	  do
	    {
	      if (*mbase)
		{
#if defined(GFC_INTEGER_8_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_i8 (gfc_array_i4 * const restrict, 
	gfc_array_i8 * const restrict, GFC_LOGICAL_4 *, GFC_LOGICAL_4);
export_proto(smaxloc0_4_i8);

void
smaxloc0_4_i8 (gfc_array_i4 * const restrict retarray, 
	gfc_array_i8 * 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_i8 (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
6de9cd9a	1	/* Implementation of the MAXLOC intrinsic
8d9254fc	2	Copyright (C) 2002-2020 Free Software Foundation, Inc.
6de9cd9a DN	3	Contributed by Paul Brook <paul@nowt.org>
6de9cd9a DN	4
57dea9f6	5	This file is part of the GNU Fortran 95 runtime library (libgfortran).
6de9cd9a DN	6
6de9cd9a DN	7	Libgfortran is free software; you can redistribute it and/or
57dea9f6	8	modify it under the terms of the GNU General Public
6de9cd9a	9	License as published by the Free Software Foundation; either
748086b7	10	version 3 of the License, or (at your option) any later version.
6de9cd9a DN	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
57dea9f6	15	GNU General Public License for more details.
6de9cd9a	16
748086b7 JJ	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/>. */
6de9cd9a	25
36ae8a61	26	#include "libgfortran.h"
64b1806b	27	#include <assert.h>
6de9cd9a DN	28
6de9cd9a DN	29
644cb69f FXC	30	#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4)
644cb69f FXC	31
7d7b8bfe	32
64acfd99	33	extern void maxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
64b1806b	34	gfc_array_i8 * const restrict array, GFC_LOGICAL_4);
7f68c75f	35	export_proto(maxloc0_4_i8);
7d7b8bfe	36
6de9cd9a	37	void
64acfd99	38	maxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
64b1806b	39	gfc_array_i8 * const restrict array, GFC_LOGICAL_4 back)
6de9cd9a DN	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;
64acfd99	45	const GFC_INTEGER_8 *base;
5863aacf	46	GFC_INTEGER_4 * restrict dest;
6de9cd9a DN	47	index_type rank;
	48	index_type n;
	49
	50	rank = GFC_DESCRIPTOR_RANK (array);
50dd63a9 TK	51	if (rank <= 0)
	52	runtime_error ("Rank of array needs to be > 0");
	53
21d1335b	54	if (retarray->base_addr == NULL)
50dd63a9	55	{
dfb55fdc	56	GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
ca708a2b	57	retarray->dtype.rank = 1;
efd4dc1a	58	retarray->offset = 0;
92e6f3a4	59	retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
50dd63a9 TK	60	}
	61	else
	62	{
9731c4a3	63	if (unlikely (compile_options.bounds_check))
80927a56 JJ	64	bounds_iforeach_return ((array_t ) retarray, (array_t ) array,
80927a56 JJ	65	"MAXLOC");
50dd63a9	66	}
e33e218b	67
dfb55fdc	68	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
21d1335b	69	dest = retarray->base_addr;
6de9cd9a DN	70	for (n = 0; n < rank; n++)
6de9cd9a DN	71	{
dfb55fdc TK	72	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
dfb55fdc TK	73	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
6de9cd9a DN	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
21d1335b	84	base = array->base_addr;
6de9cd9a DN	85
	86	/* Initialize the return value. */
	87	for (n = 0; n < rank; n++)
80927a56	88	dest[n * dstride] = 1;
6de9cd9a DN	89	{
6de9cd9a DN	90
80927a56 JJ	91	GFC_INTEGER_8 maxval;
	92	#if defined(GFC_INTEGER_8_QUIET_NAN)
	93	int fast = 0;
	94	#endif
6de9cd9a	95
80927a56 JJ	96	#if defined(GFC_INTEGER_8_INFINITY)
	97	maxval = -GFC_INTEGER_8_INFINITY;
	98	#else
	99	maxval = (-GFC_INTEGER_8_HUGE-1);
	100	#endif
6de9cd9a DN	101	while (base)
6de9cd9a DN	102	{
80927a56	103	/* Implementation start. */
6de9cd9a	104
80927a56	105	#if defined(GFC_INTEGER_8_QUIET_NAN)
80927a56 JJ	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	}
b573f931	124	else
80927a56	125	#endif
b573f931 TK	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	}
80927a56 JJ	147	/* Implementation end. */
	148	/* Advance to the next element. */
	149	base += sstride[0];
	150	}
	151	while (++count[0] != extent[0]);
6de9cd9a	152	n = 0;
80927a56 JJ	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++;
80dd631f	162	if (n >= rank)
80927a56 JJ	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]);
6de9cd9a DN	175	}
	176	}
	177	}
	178
64acfd99	179	extern void mmaxloc0_4_i8 (gfc_array_i4 * const restrict,
64b1806b TK	180	gfc_array_i8 * const restrict, gfc_array_l1 * const restrict,
64b1806b TK	181	GFC_LOGICAL_4);
7f68c75f	182	export_proto(mmaxloc0_4_i8);
7d7b8bfe	183
6de9cd9a	184	void
64acfd99 JB	185	mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
64acfd99 JB	186	gfc_array_i8 * const restrict array,
64b1806b	187	gfc_array_l1 * const restrict mask, GFC_LOGICAL_4 back)
6de9cd9a DN	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;
64acfd99	195	const GFC_INTEGER_8 *base;
28dc6b33	196	GFC_LOGICAL_1 *mbase;
6de9cd9a DN	197	int rank;
6de9cd9a DN	198	index_type n;
28dc6b33	199	int mask_kind;
6de9cd9a	200
2ea47ee9 TK	201
	202	if (mask == NULL)
	203	{
	204	maxloc0_4_i8 (retarray, array, back);
	205	return;
	206	}
	207
6de9cd9a	208	rank = GFC_DESCRIPTOR_RANK (array);
50dd63a9 TK	209	if (rank <= 0)
	210	runtime_error ("Rank of array needs to be > 0");
	211
21d1335b	212	if (retarray->base_addr == NULL)
50dd63a9	213	{
dfb55fdc	214	GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
ca708a2b	215	retarray->dtype.rank = 1;
efd4dc1a	216	retarray->offset = 0;
92e6f3a4	217	retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
50dd63a9 TK	218	}
	219	else
	220	{
9731c4a3	221	if (unlikely (compile_options.bounds_check))
fd6590f8	222	{
16bff921 TK	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");
fd6590f8	228	}
50dd63a9	229	}
6de9cd9a	230
28dc6b33 TK	231	mask_kind = GFC_DESCRIPTOR_SIZE (mask);
28dc6b33 TK	232
21d1335b	233	mbase = mask->base_addr;
28dc6b33 TK	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
dfb55fdc	244	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
21d1335b	245	dest = retarray->base_addr;
6de9cd9a DN	246	for (n = 0; n < rank; n++)
6de9cd9a DN	247	{
dfb55fdc TK	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);
6de9cd9a DN	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
21d1335b	261	base = array->base_addr;
6de9cd9a DN	262
	263	/* Initialize the return value. */
	264	for (n = 0; n < rank; n++)
a4b9e93e	265	dest[n * dstride] = 0;
6de9cd9a DN	266	{
	267
	268	GFC_INTEGER_8 maxval;
80927a56	269	int fast = 0;
6de9cd9a	270
80927a56 JJ	271	#if defined(GFC_INTEGER_8_INFINITY)
	272	maxval = -GFC_INTEGER_8_INFINITY;
	273	#else
	274	maxval = (-GFC_INTEGER_8_HUGE-1);
	275	#endif
6de9cd9a DN	276	while (base)
6de9cd9a DN	277	{
80927a56	278	/* Implementation start. */
6de9cd9a	279
80927a56 JJ	280	if (unlikely (!fast))
	281	{
	282	do
	283	{
	284	if (*mbase)
	285	{
	286	#if defined(GFC_INTEGER_8_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	}
b573f931 TK	307	else
	308	if (back)
	309	do
80927a56	310	{
b573f931 TK	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];
80927a56	318	}
b573f931 TK	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	}
80927a56 JJ	329	/* Implementation end. */
	330	/* Advance to the next element. */
	331	base += sstride[0];
	332	mbase += mstride[0];
	333	}
	334	while (++count[0] != extent[0]);
6de9cd9a	335	n = 0;
80927a56 JJ	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++;
80dd631f	346	if (n >= rank)
80927a56 JJ	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]);
6de9cd9a DN	360	}
	361	}
	362	}
644cb69f	363
97a62038 TK	364
97a62038 TK	365	extern void smaxloc0_4_i8 (gfc_array_i4 * const restrict,
64b1806b	366	gfc_array_i8 * const restrict, GFC_LOGICAL_4 *, GFC_LOGICAL_4);
97a62038 TK	367	export_proto(smaxloc0_4_i8);
	368
	369	void
	370	smaxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
	371	gfc_array_i8 * const restrict array,
64b1806b	372	GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
97a62038 TK	373	{
	374	index_type rank;
	375	index_type dstride;
	376	index_type n;
	377	GFC_INTEGER_4 *dest;
	378
2ea47ee9	379	if (mask == NULL \|\| *mask)
97a62038	380	{
64b1806b	381	maxloc0_4_i8 (retarray, array, back);
97a62038 TK	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
21d1335b	390	if (retarray->base_addr == NULL)
97a62038	391	{
dfb55fdc	392	GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
ca708a2b	393	retarray->dtype.rank = 1;
97a62038	394	retarray->offset = 0;
92e6f3a4	395	retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
97a62038	396	}
16bff921	397	else if (unlikely (compile_options.bounds_check))
97a62038	398	{
16bff921 TK	399	bounds_iforeach_return ((array_t ) retarray, (array_t ) array,
16bff921 TK	400	"MAXLOC");
97a62038 TK	401	}
97a62038 TK	402
dfb55fdc	403	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
21d1335b	404	dest = retarray->base_addr;
97a62038 TK	405	for (n = 0; n<rank; n++)
	406	dest[n * dstride] = 0 ;
	407	}
644cb69f	408	#endif