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