[thirdparty/gcc.git] / libgfortran / generated / maxloc0_16_r4.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_4) && defined (HAVE_GFC_INTEGER_16)


extern void maxloc0_16_r4 (gfc_array_i16 * const restrict retarray, 
	gfc_array_r4 * const restrict array);
export_proto(maxloc0_16_r4);

void
maxloc0_16_r4 (gfc_array_i16 * const restrict retarray, 
	gfc_array_r4 * 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_4 *base;
  GFC_INTEGER_16 * 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_16));
    }
  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_4 maxval;
#if defined(GFC_REAL_4_QUIET_NAN)
    int fast = 0;
#endif

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

#if defined(GFC_REAL_4_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_16_r4 (gfc_array_i16 * const restrict, 
	gfc_array_r4 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_16_r4);

void
mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray, 
	gfc_array_r4 * 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_16 *dest;
  const GFC_REAL_4 *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_16));
    }
  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_4 maxval;
   int fast = 0;

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

	}
      while (0);
      if (unlikely (!fast))
	{
	  do
	    {
	      if (*mbase)
		{
#if defined(GFC_REAL_4_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_16_r4 (gfc_array_i16 * const restrict, 
	gfc_array_r4 * const restrict, GFC_LOGICAL_4 *);
export_proto(smaxloc0_16_r4);

void
smaxloc0_16_r4 (gfc_array_i16 * const restrict retarray, 
	gfc_array_r4 * const restrict array,
	GFC_LOGICAL_4 * mask)
{
  index_type rank;
  index_type dstride;
  index_type n;
  GFC_INTEGER_16 *dest;

  if (*mask)
    {
      maxloc0_16_r4 (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_16));
    }
  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
f1717362	2	Copyright (C) 2002-2016 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"
920e54ef	27	#include <stdlib.h>
920e54ef	28	#include <assert.h>
920e54ef	29	#include <limits.h>
920e54ef	30
	31
	32	#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_16)
	33
	34
b4cafd67	35	extern void maxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
b4cafd67	36	gfc_array_r4 * const restrict array);
920e54ef	37	export_proto(maxloc0_16_r4);
	38
	39	void
b4cafd67	40	maxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
b4cafd67	41	gfc_array_r4 * const restrict array)
920e54ef	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;
b4cafd67	47	const GFC_REAL_4 *base;
9d259edf	48	GFC_INTEGER_16 * restrict dest;
920e54ef	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
553877d9	56	if (retarray->base_addr == NULL)
920e54ef	57	{
827aef63	58	GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
920e54ef	59	retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) \| 1;
920e54ef	60	retarray->offset = 0;
af1e9051	61	retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
920e54ef	62	}
	63	else
	64	{
c7fb575f	65	if (unlikely (compile_options.bounds_check))
7ebee933	66	bounds_iforeach_return ((array_t ) retarray, (array_t ) array,
7ebee933	67	"MAXLOC");
920e54ef	68	}
920e54ef	69
827aef63	70	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
553877d9	71	dest = retarray->base_addr;
920e54ef	72	for (n = 0; n < rank; n++)
920e54ef	73	{
827aef63	74	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
827aef63	75	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
920e54ef	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
553877d9	86	base = array->base_addr;
920e54ef	87
	88	/* Initialize the return value. */
	89	for (n = 0; n < rank; n++)
7ebee933	90	dest[n * dstride] = 1;
920e54ef	91	{
920e54ef	92
7ebee933	93	GFC_REAL_4 maxval;
	94	#if defined(GFC_REAL_4_QUIET_NAN)
	95	int fast = 0;
	96	#endif
920e54ef	97
7ebee933	98	#if defined(GFC_REAL_4_INFINITY)
	99	maxval = -GFC_REAL_4_INFINITY;
	100	#else
	101	maxval = -GFC_REAL_4_HUGE;
	102	#endif
920e54ef	103	while (base)
920e54ef	104	{
7ebee933	105	do
	106	{
	107	/* Implementation start. */
920e54ef	108
7ebee933	109	#if defined(GFC_REAL_4_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]);
920e54ef	144	n = 0;
7ebee933	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]);
920e54ef	167	}
	168	}
	169	}
	170
	171
b4cafd67	172	extern void mmaxloc0_16_r4 (gfc_array_i16 * const restrict,
7ed8f627	173	gfc_array_r4 * const restrict, gfc_array_l1 * const restrict);
920e54ef	174	export_proto(mmaxloc0_16_r4);
	175
	176	void
b4cafd67	177	mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
b4cafd67	178	gfc_array_r4 * const restrict array,
7ed8f627	179	gfc_array_l1 * const restrict mask)
920e54ef	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_16 *dest;
b4cafd67	187	const GFC_REAL_4 *base;
7ed8f627	188	GFC_LOGICAL_1 *mbase;
920e54ef	189	int rank;
920e54ef	190	index_type n;
7ed8f627	191	int mask_kind;
920e54ef	192
	193	rank = GFC_DESCRIPTOR_RANK (array);
	194	if (rank <= 0)
	195	runtime_error ("Rank of array needs to be > 0");
	196
553877d9	197	if (retarray->base_addr == NULL)
920e54ef	198	{
827aef63	199	GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
920e54ef	200	retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) \| 1;
920e54ef	201	retarray->offset = 0;
af1e9051	202	retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
920e54ef	203	}
	204	else
	205	{
c7fb575f	206	if (unlikely (compile_options.bounds_check))
8dec97a0	207	{
5d04d450	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");
8dec97a0	213	}
920e54ef	214	}
920e54ef	215
7ed8f627	216	mask_kind = GFC_DESCRIPTOR_SIZE (mask);
7ed8f627	217
553877d9	218	mbase = mask->base_addr;
7ed8f627	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
827aef63	229	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
553877d9	230	dest = retarray->base_addr;
920e54ef	231	for (n = 0; n < rank; n++)
920e54ef	232	{
827aef63	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);
920e54ef	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
553877d9	246	base = array->base_addr;
920e54ef	247
	248	/* Initialize the return value. */
	249	for (n = 0; n < rank; n++)
b1660f25	250	dest[n * dstride] = 0;
920e54ef	251	{
	252
	253	GFC_REAL_4 maxval;
7ebee933	254	int fast = 0;
920e54ef	255
7ebee933	256	#if defined(GFC_REAL_4_INFINITY)
	257	maxval = -GFC_REAL_4_INFINITY;
	258	#else
	259	maxval = -GFC_REAL_4_HUGE;
	260	#endif
920e54ef	261	while (base)
920e54ef	262	{
7ebee933	263	do
	264	{
	265	/* Implementation start. */
920e54ef	266
7ebee933	267	}
	268	while (0);
	269	if (unlikely (!fast))
	270	{
	271	do
	272	{
	273	if (*mbase)
	274	{
	275	#if defined(GFC_REAL_4_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]);
920e54ef	310	n = 0;
7ebee933	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]);
920e54ef	335	}
	336	}
	337	}
	338
4292b27d	339
	340	extern void smaxloc0_16_r4 (gfc_array_i16 * const restrict,
	341	gfc_array_r4 * const restrict, GFC_LOGICAL_4 *);
	342	export_proto(smaxloc0_16_r4);
	343
	344	void
	345	smaxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
	346	gfc_array_r4 * const restrict array,
	347	GFC_LOGICAL_4 * mask)
	348	{
	349	index_type rank;
	350	index_type dstride;
	351	index_type n;
	352	GFC_INTEGER_16 *dest;
	353
	354	if (*mask)
	355	{
	356	maxloc0_16_r4 (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
553877d9	365	if (retarray->base_addr == NULL)
4292b27d	366	{
827aef63	367	GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
4292b27d	368	retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) \| 1;
4292b27d	369	retarray->offset = 0;
af1e9051	370	retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
4292b27d	371	}
5d04d450	372	else if (unlikely (compile_options.bounds_check))
4292b27d	373	{
5d04d450	374	bounds_iforeach_return ((array_t ) retarray, (array_t ) array,
5d04d450	375	"MAXLOC");
4292b27d	376	}
4292b27d	377
827aef63	378	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
553877d9	379	dest = retarray->base_addr;
4292b27d	380	for (n = 0; n<rank; n++)
	381	dest[n * dstride] = 0 ;
	382	}
920e54ef	383	#endif