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

/* Implementation of the MAXLOC intrinsic
   Copyright (C) 2002-2016 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 <stdlib.h>
#include <assert.h>
#include <limits.h>


#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4)


extern void maxloc0_4_r10 (gfc_array_i4 * const restrict retarray, 
	gfc_array_r10 * const restrict array);
export_proto(maxloc0_4_r10);

void
maxloc0_4_r10 (gfc_array_i4 * const restrict retarray, 
	gfc_array_r10 * const restrict array)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type dstride;
  const GFC_REAL_10 *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 = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 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_REAL_10 maxval;
#if defined(GFC_REAL_10_QUIET_NAN)
    int fast = 0;
#endif

#if defined(GFC_REAL_10_INFINITY)
    maxval = -GFC_REAL_10_INFINITY;
#else
    maxval = -GFC_REAL_10_HUGE;
#endif
  while (base)
    {
      do
	{
	  /* Implementation start.  */

#if defined(GFC_REAL_10_QUIET_NAN)
	}
      while (0);
      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 do
	{
#endif
	  if (*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_r10 (gfc_array_i4 * const restrict, 
	gfc_array_r10 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_4_r10);

void
mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray, 
	gfc_array_r10 * const restrict array,
	gfc_array_l1 * const restrict mask)
{
  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_REAL_10 *base;
  GFC_LOGICAL_1 *mbase;
  int rank;
  index_type n;
  int mask_kind;

  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 = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 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_REAL_10 maxval;
   int fast = 0;

#if defined(GFC_REAL_10_INFINITY)
    maxval = -GFC_REAL_10_INFINITY;
#else
    maxval = -GFC_REAL_10_HUGE;
#endif
  while (base)
    {
      do
	{
	  /* Implementation start.  */

	}
      while (0);
      if (unlikely (!fast))
	{
	  do
	    {
	      if (*mbase)
		{
#if defined(GFC_REAL_10_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 do
	{
	  if (*mbase && *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_r10 (gfc_array_i4 * const restrict, 
	gfc_array_r10 * const restrict, GFC_LOGICAL_4 *);
export_proto(smaxloc0_4_r10);

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

  if (*mask)
    {
      maxloc0_4_r10 (retarray, array);
      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 = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 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
644cb69f	1	/* Implementation of the MAXLOC intrinsic
818ab71a	2	Copyright (C) 2002-2016 Free Software Foundation, Inc.
644cb69f FXC	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
748086b7	10	version 3 of the License, or (at your option) any later version.
644cb69f FXC	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
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/>. */
644cb69f	25
36ae8a61	26	#include "libgfortran.h"
644cb69f FXC	27	#include <stdlib.h>
644cb69f FXC	28	#include <assert.h>
644cb69f	29	#include <limits.h>
644cb69f FXC	30
	31
	32	#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4)
	33
	34
64acfd99 JB	35	extern void maxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
64acfd99 JB	36	gfc_array_r10 * const restrict array);
644cb69f FXC	37	export_proto(maxloc0_4_r10);
	38
	39	void
64acfd99 JB	40	maxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
64acfd99 JB	41	gfc_array_r10 * const restrict array)
644cb69f FXC	42	{
	43	index_type count[GFC_MAX_DIMENSIONS];
	44	index_type extent[GFC_MAX_DIMENSIONS];
	45	index_type sstride[GFC_MAX_DIMENSIONS];
	46	index_type dstride;
64acfd99	47	const GFC_REAL_10 *base;
5863aacf	48	GFC_INTEGER_4 * restrict dest;
644cb69f FXC	49	index_type rank;
	50	index_type n;
	51
	52	rank = GFC_DESCRIPTOR_RANK (array);
	53	if (rank <= 0)
	54	runtime_error ("Rank of array needs to be > 0");
	55
21d1335b	56	if (retarray->base_addr == NULL)
644cb69f	57	{
dfb55fdc	58	GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
644cb69f FXC	59	retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) \| 1;
644cb69f FXC	60	retarray->offset = 0;
92e6f3a4	61	retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
644cb69f FXC	62	}
	63	else
	64	{
9731c4a3	65	if (unlikely (compile_options.bounds_check))
80927a56 JJ	66	bounds_iforeach_return ((array_t ) retarray, (array_t ) array,
80927a56 JJ	67	"MAXLOC");
644cb69f FXC	68	}
644cb69f FXC	69
dfb55fdc	70	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
21d1335b	71	dest = retarray->base_addr;
644cb69f FXC	72	for (n = 0; n < rank; n++)
644cb69f FXC	73	{
dfb55fdc TK	74	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
dfb55fdc TK	75	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
644cb69f FXC	76	count[n] = 0;
	77	if (extent[n] <= 0)
	78	{
	79	/* Set the return value. */
	80	for (n = 0; n < rank; n++)
	81	dest[n * dstride] = 0;
	82	return;
	83	}
	84	}
	85
21d1335b	86	base = array->base_addr;
644cb69f FXC	87
	88	/* Initialize the return value. */
	89	for (n = 0; n < rank; n++)
80927a56	90	dest[n * dstride] = 1;
644cb69f FXC	91	{
644cb69f FXC	92
80927a56 JJ	93	GFC_REAL_10 maxval;
	94	#if defined(GFC_REAL_10_QUIET_NAN)
	95	int fast = 0;
	96	#endif
644cb69f	97
80927a56 JJ	98	#if defined(GFC_REAL_10_INFINITY)
	99	maxval = -GFC_REAL_10_INFINITY;
	100	#else
	101	maxval = -GFC_REAL_10_HUGE;
	102	#endif
644cb69f FXC	103	while (base)
644cb69f FXC	104	{
80927a56 JJ	105	do
	106	{
	107	/* Implementation start. */
644cb69f	108
80927a56 JJ	109	#if defined(GFC_REAL_10_QUIET_NAN)
	110	}
	111	while (0);
	112	if (unlikely (!fast))
	113	{
	114	do
	115	{
	116	if (*base >= maxval)
	117	{
	118	fast = 1;
	119	maxval = *base;
	120	for (n = 0; n < rank; n++)
	121	dest[n * dstride] = count[n] + 1;
	122	break;
	123	}
	124	base += sstride[0];
	125	}
	126	while (++count[0] != extent[0]);
	127	if (likely (fast))
	128	continue;
	129	}
	130	else do
	131	{
	132	#endif
	133	if (*base > maxval)
	134	{
	135	maxval = *base;
	136	for (n = 0; n < rank; n++)
	137	dest[n * dstride] = count[n] + 1;
	138	}
	139	/* Implementation end. */
	140	/* Advance to the next element. */
	141	base += sstride[0];
	142	}
	143	while (++count[0] != extent[0]);
644cb69f	144	n = 0;
80927a56 JJ	145	do
	146	{
	147	/* When we get to the end of a dimension, reset it and increment
	148	the next dimension. */
	149	count[n] = 0;
	150	/* We could precalculate these products, but this is a less
	151	frequently used path so probably not worth it. */
	152	base -= sstride[n] * extent[n];
	153	n++;
	154	if (n == rank)
	155	{
	156	/* Break out of the loop. */
	157	base = NULL;
	158	break;
	159	}
	160	else
	161	{
	162	count[n]++;
	163	base += sstride[n];
	164	}
	165	}
	166	while (count[n] == extent[n]);
644cb69f FXC	167	}
	168	}
	169	}
	170
	171
64acfd99	172	extern void mmaxloc0_4_r10 (gfc_array_i4 * const restrict,
28dc6b33	173	gfc_array_r10 * const restrict, gfc_array_l1 * const restrict);
644cb69f FXC	174	export_proto(mmaxloc0_4_r10);
	175
	176	void
64acfd99 JB	177	mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
64acfd99 JB	178	gfc_array_r10 * const restrict array,
28dc6b33	179	gfc_array_l1 * const restrict mask)
644cb69f FXC	180	{
	181	index_type count[GFC_MAX_DIMENSIONS];
	182	index_type extent[GFC_MAX_DIMENSIONS];
	183	index_type sstride[GFC_MAX_DIMENSIONS];
	184	index_type mstride[GFC_MAX_DIMENSIONS];
	185	index_type dstride;
	186	GFC_INTEGER_4 *dest;
64acfd99	187	const GFC_REAL_10 *base;
28dc6b33	188	GFC_LOGICAL_1 *mbase;
644cb69f FXC	189	int rank;
644cb69f FXC	190	index_type n;
28dc6b33	191	int mask_kind;
644cb69f FXC	192
	193	rank = GFC_DESCRIPTOR_RANK (array);
	194	if (rank <= 0)
	195	runtime_error ("Rank of array needs to be > 0");
	196
21d1335b	197	if (retarray->base_addr == NULL)
644cb69f	198	{
dfb55fdc	199	GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
644cb69f FXC	200	retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) \| 1;
644cb69f FXC	201	retarray->offset = 0;
92e6f3a4	202	retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
644cb69f FXC	203	}
	204	else
	205	{
9731c4a3	206	if (unlikely (compile_options.bounds_check))
fd6590f8	207	{
16bff921 TK	208
	209	bounds_iforeach_return ((array_t ) retarray, (array_t ) array,
	210	"MAXLOC");
	211	bounds_equal_extents ((array_t ) mask, (array_t ) array,
	212	"MASK argument", "MAXLOC");
fd6590f8	213	}
644cb69f FXC	214	}
644cb69f FXC	215
28dc6b33 TK	216	mask_kind = GFC_DESCRIPTOR_SIZE (mask);
28dc6b33 TK	217
21d1335b	218	mbase = mask->base_addr;
28dc6b33 TK	219
	220	if (mask_kind == 1 \|\| mask_kind == 2 \|\| mask_kind == 4 \|\| mask_kind == 8
	221	#ifdef HAVE_GFC_LOGICAL_16
	222	\|\| mask_kind == 16
	223	#endif
	224	)
	225	mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
	226	else
	227	runtime_error ("Funny sized logical array");
	228
dfb55fdc	229	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
21d1335b	230	dest = retarray->base_addr;
644cb69f FXC	231	for (n = 0; n < rank; n++)
644cb69f FXC	232	{
dfb55fdc TK	233	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
	234	mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
	235	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
644cb69f FXC	236	count[n] = 0;
	237	if (extent[n] <= 0)
	238	{
	239	/* Set the return value. */
	240	for (n = 0; n < rank; n++)
	241	dest[n * dstride] = 0;
	242	return;
	243	}
	244	}
	245
21d1335b	246	base = array->base_addr;
644cb69f FXC	247
	248	/* Initialize the return value. */
	249	for (n = 0; n < rank; n++)
a4b9e93e	250	dest[n * dstride] = 0;
644cb69f FXC	251	{
	252
	253	GFC_REAL_10 maxval;
80927a56	254	int fast = 0;
644cb69f	255
80927a56 JJ	256	#if defined(GFC_REAL_10_INFINITY)
	257	maxval = -GFC_REAL_10_INFINITY;
	258	#else
	259	maxval = -GFC_REAL_10_HUGE;
	260	#endif
644cb69f FXC	261	while (base)
644cb69f FXC	262	{
80927a56 JJ	263	do
	264	{
	265	/* Implementation start. */
644cb69f	266
80927a56 JJ	267	}
	268	while (0);
	269	if (unlikely (!fast))
	270	{
	271	do
	272	{
	273	if (*mbase)
	274	{
	275	#if defined(GFC_REAL_10_QUIET_NAN)
	276	if (unlikely (dest[0] == 0))
	277	for (n = 0; n < rank; n++)
	278	dest[n * dstride] = count[n] + 1;
	279	if (*base >= maxval)
	280	#endif
	281	{
	282	fast = 1;
	283	maxval = *base;
	284	for (n = 0; n < rank; n++)
	285	dest[n * dstride] = count[n] + 1;
	286	break;
	287	}
	288	}
	289	base += sstride[0];
	290	mbase += mstride[0];
	291	}
	292	while (++count[0] != extent[0]);
	293	if (likely (fast))
	294	continue;
	295	}
	296	else do
	297	{
	298	if (mbase && base > maxval)
	299	{
	300	maxval = *base;
	301	for (n = 0; n < rank; n++)
	302	dest[n * dstride] = count[n] + 1;
	303	}
	304	/* Implementation end. */
	305	/* Advance to the next element. */
	306	base += sstride[0];
	307	mbase += mstride[0];
	308	}
	309	while (++count[0] != extent[0]);
644cb69f	310	n = 0;
80927a56 JJ	311	do
	312	{
	313	/* When we get to the end of a dimension, reset it and increment
	314	the next dimension. */
	315	count[n] = 0;
	316	/* We could precalculate these products, but this is a less
	317	frequently used path so probably not worth it. */
	318	base -= sstride[n] * extent[n];
	319	mbase -= mstride[n] * extent[n];
	320	n++;
	321	if (n == rank)
	322	{
	323	/* Break out of the loop. */
	324	base = NULL;
	325	break;
	326	}
	327	else
	328	{
	329	count[n]++;
	330	base += sstride[n];
	331	mbase += mstride[n];
	332	}
	333	}
	334	while (count[n] == extent[n]);
644cb69f FXC	335	}
	336	}
	337	}
	338
97a62038 TK	339
	340	extern void smaxloc0_4_r10 (gfc_array_i4 * const restrict,
	341	gfc_array_r10 * const restrict, GFC_LOGICAL_4 *);
	342	export_proto(smaxloc0_4_r10);
	343
	344	void
	345	smaxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
	346	gfc_array_r10 * const restrict array,
	347	GFC_LOGICAL_4 * mask)
	348	{
	349	index_type rank;
	350	index_type dstride;
	351	index_type n;
	352	GFC_INTEGER_4 *dest;
	353
	354	if (*mask)
	355	{
	356	maxloc0_4_r10 (retarray, array);
	357	return;
	358	}
	359
	360	rank = GFC_DESCRIPTOR_RANK (array);
	361
	362	if (rank <= 0)
	363	runtime_error ("Rank of array needs to be > 0");
	364
21d1335b	365	if (retarray->base_addr == NULL)
97a62038	366	{
dfb55fdc	367	GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
97a62038 TK	368	retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) \| 1;
97a62038 TK	369	retarray->offset = 0;
92e6f3a4	370	retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
97a62038	371	}
16bff921	372	else if (unlikely (compile_options.bounds_check))
97a62038	373	{
16bff921 TK	374	bounds_iforeach_return ((array_t ) retarray, (array_t ) array,
16bff921 TK	375	"MAXLOC");
97a62038 TK	376	}
97a62038 TK	377
dfb55fdc	378	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
21d1335b	379	dest = retarray->base_addr;
97a62038 TK	380	for (n = 0; n<rank; n++)
	381	dest[n * dstride] = 0 ;
	382	}
644cb69f	383	#endif