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

/* Implementation of the MAXLOC intrinsic
   Copyright (C) 2002-2024 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_4) && defined (HAVE_GFC_INTEGER_8)


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

void
maxloc0_8_i4 (gfc_array_i8 * const restrict retarray, 
	gfc_array_i4 * 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_4 *base;
  GFC_INTEGER_8 * 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_8));
    }
  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_4 maxval;
#if defined(GFC_INTEGER_4_QUIET_NAN)
    int fast = 0;
#endif

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

#if defined(GFC_INTEGER_4_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_8_i4 (gfc_array_i8 * const restrict, 
	gfc_array_i4 * const restrict, gfc_array_l1 * const restrict,
	GFC_LOGICAL_4);
export_proto(mmaxloc0_8_i4);

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


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

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

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

void
smaxloc0_8_i4 (gfc_array_i8 * const restrict retarray, 
	gfc_array_i4 * const restrict array,
	GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
{
  index_type rank;
  index_type dstride;
  index_type n;
  GFC_INTEGER_8 *dest;

  if (mask == NULL || *mask)
    {
      maxloc0_8_i4 (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_8));
    }
  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
	1	/* Implementation of the MAXLOC intrinsic
	2	Copyright (C) 2002-2024 Free Software Foundation, Inc.
	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
	10	version 3 of the License, or (at your option) any later version.
	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
	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/>. */
	25
	26	#include "libgfortran.h"
	27	#include <assert.h>
	28
	29
	30	#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
	31
	32
	33	extern void maxloc0_8_i4 (gfc_array_i8 * const restrict retarray,
	34	gfc_array_i4 * const restrict array, GFC_LOGICAL_4);
	35	export_proto(maxloc0_8_i4);
	36
	37	void
	38	maxloc0_8_i4 (gfc_array_i8 * const restrict retarray,
	39	gfc_array_i4 * const restrict array, GFC_LOGICAL_4 back)
	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;
	45	const GFC_INTEGER_4 *base;
	46	GFC_INTEGER_8 * restrict dest;
	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
	54	if (retarray->base_addr == NULL)
	55	{
	56	GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
	57	retarray->dtype.rank = 1;
	58	retarray->offset = 0;
	59	retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
	60	}
	61	else
	62	{
	63	if (unlikely (compile_options.bounds_check))
	64	bounds_iforeach_return ((array_t ) retarray, (array_t ) array,
	65	"MAXLOC");
	66	}
	67
	68	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
	69	dest = retarray->base_addr;
	70	for (n = 0; n < rank; n++)
	71	{
	72	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
	73	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
	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
	84	base = array->base_addr;
	85
	86	/* Initialize the return value. */
	87	for (n = 0; n < rank; n++)
	88	dest[n * dstride] = 1;
	89	{
	90
	91	GFC_INTEGER_4 maxval;
	92	#if defined(GFC_INTEGER_4_QUIET_NAN)
	93	int fast = 0;
	94	#endif
	95
	96	#if defined(GFC_INTEGER_4_INFINITY)
	97	maxval = -GFC_INTEGER_4_INFINITY;
	98	#else
	99	maxval = (-GFC_INTEGER_4_HUGE-1);
	100	#endif
	101	while (base)
	102	{
	103	/* Implementation start. */
	104
	105	#if defined(GFC_INTEGER_4_QUIET_NAN)
	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	}
	124	else
	125	#endif
	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	}
	147	/* Implementation end. */
	148	/* Advance to the next element. */
	149	base += sstride[0];
	150	}
	151	while (++count[0] != extent[0]);
	152	n = 0;
	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++;
	162	if (n >= rank)
	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]);
	175	}
	176	}
	177	}
	178
	179	extern void mmaxloc0_8_i4 (gfc_array_i8 * const restrict,
	180	gfc_array_i4 * const restrict, gfc_array_l1 * const restrict,
	181	GFC_LOGICAL_4);
	182	export_proto(mmaxloc0_8_i4);
	183
	184	void
	185	mmaxloc0_8_i4 (gfc_array_i8 * const restrict retarray,
	186	gfc_array_i4 * const restrict array,
	187	gfc_array_l1 * const restrict mask, GFC_LOGICAL_4 back)
	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_8 *dest;
	195	const GFC_INTEGER_4 *base;
	196	GFC_LOGICAL_1 *mbase;
	197	int rank;
	198	index_type n;
	199	int mask_kind;
	200
	201
	202	if (mask == NULL)
	203	{
	204	maxloc0_8_i4 (retarray, array, back);
	205	return;
	206	}
	207
	208	rank = GFC_DESCRIPTOR_RANK (array);
	209	if (rank <= 0)
	210	runtime_error ("Rank of array needs to be > 0");
	211
	212	if (retarray->base_addr == NULL)
	213	{
	214	GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
	215	retarray->dtype.rank = 1;
	216	retarray->offset = 0;
	217	retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
	218	}
	219	else
	220	{
	221	if (unlikely (compile_options.bounds_check))
	222	{
	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");
	228	}
	229	}
	230
	231	mask_kind = GFC_DESCRIPTOR_SIZE (mask);
	232
	233	mbase = mask->base_addr;
	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
	244	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
	245	dest = retarray->base_addr;
	246	for (n = 0; n < rank; n++)
	247	{
	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);
	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
	261	base = array->base_addr;
	262
	263	/* Initialize the return value. */
	264	for (n = 0; n < rank; n++)
	265	dest[n * dstride] = 0;
	266	{
	267
	268	GFC_INTEGER_4 maxval;
	269	int fast = 0;
	270
	271	#if defined(GFC_INTEGER_4_INFINITY)
	272	maxval = -GFC_INTEGER_4_INFINITY;
	273	#else
	274	maxval = (-GFC_INTEGER_4_HUGE-1);
	275	#endif
	276	while (base)
	277	{
	278	/* Implementation start. */
	279
	280	if (unlikely (!fast))
	281	{
	282	do
	283	{
	284	if (*mbase)
	285	{
	286	#if defined(GFC_INTEGER_4_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	}
	307	else
	308	if (back)
	309	do
	310	{
	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];
	318	}
	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	}
	329	/* Implementation end. */
	330	/* Advance to the next element. */
	331	base += sstride[0];
	332	mbase += mstride[0];
	333	}
	334	while (++count[0] != extent[0]);
	335	n = 0;
	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++;
	346	if (n >= rank)
	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]);
	360	}
	361	}
	362	}
	363
	364
	365	extern void smaxloc0_8_i4 (gfc_array_i8 * const restrict,
	366	gfc_array_i4 * const restrict, GFC_LOGICAL_4 *, GFC_LOGICAL_4);
	367	export_proto(smaxloc0_8_i4);
	368
	369	void
	370	smaxloc0_8_i4 (gfc_array_i8 * const restrict retarray,
	371	gfc_array_i4 * const restrict array,
	372	GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
	373	{
	374	index_type rank;
	375	index_type dstride;
	376	index_type n;
	377	GFC_INTEGER_8 *dest;
	378
	379	if (mask == NULL \|\| *mask)
	380	{
	381	maxloc0_8_i4 (retarray, array, back);
	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
	390	if (retarray->base_addr == NULL)
	391	{
	392	GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
	393	retarray->dtype.rank = 1;
	394	retarray->offset = 0;
	395	retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_8));
	396	}
	397	else if (unlikely (compile_options.bounds_check))
	398	{
	399	bounds_iforeach_return ((array_t ) retarray, (array_t ) array,
	400	"MAXLOC");
	401	}
	402
	403	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
	404	dest = retarray->base_addr;
	405	for (n = 0; n<rank; n++)
	406	dest[n * dstride] = 0 ;
	407	}
	408	#endif