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

/* Implementation of the MINLOC 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_2) && defined (HAVE_GFC_INTEGER_16)


extern void minloc0_16_i2 (gfc_array_i16 * const restrict retarray, 
	gfc_array_i2 * const restrict array, GFC_LOGICAL_4);
export_proto(minloc0_16_i2);

void
minloc0_16_i2 (gfc_array_i16 * const restrict retarray, 
	gfc_array_i2 * 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_2 *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.rank = 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,
				"MINLOC");
    }

  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_2 minval;
#if defined(GFC_INTEGER_2_QUIET_NAN)
    int fast = 0;
#endif

#if defined(GFC_INTEGER_2_INFINITY)
    minval = GFC_INTEGER_2_INFINITY;
#else
    minval = GFC_INTEGER_2_HUGE;
#endif
  while (base)
    {
	  /* Implementation start.  */

#if defined(GFC_INTEGER_2_QUIET_NAN)
      if (unlikely (!fast))
	{
	  do
	    {
	      if (*base <= minval)
		{
		  fast = 1;
		  minval = *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 <= minval))
	      {
		minval = *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 < minval))
	      {
		minval = *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 mminloc0_16_i2 (gfc_array_i16 * const restrict, 
	gfc_array_i2 * const restrict, gfc_array_l1 * const restrict,
	GFC_LOGICAL_4);
export_proto(mminloc0_16_i2);

void
mminloc0_16_i2 (gfc_array_i16 * const restrict retarray, 
	gfc_array_i2 * 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_16 *dest;
  const GFC_INTEGER_2 *base;
  GFC_LOGICAL_1 *mbase;
  int rank;
  index_type n;
  int mask_kind;


  if (mask == NULL)
    {
      minloc0_16_i2 (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_16));
    }
  else
    {
      if (unlikely (compile_options.bounds_check))
	{

	  bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
				  "MINLOC");
	  bounds_equal_extents ((array_t *) mask, (array_t *) array,
				  "MASK argument", "MINLOC");
	}
    }

  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_2 minval;
   int fast = 0;

#if defined(GFC_INTEGER_2_INFINITY)
    minval = GFC_INTEGER_2_INFINITY;
#else
    minval = GFC_INTEGER_2_HUGE;
#endif
  while (base)
    {
	  /* Implementation start.  */

      if (unlikely (!fast))
	{
	  do
	    {
	      if (*mbase)
		{
#if defined(GFC_INTEGER_2_QUIET_NAN)
		  if (unlikely (dest[0] == 0))
		    for (n = 0; n < rank; n++)
		      dest[n * dstride] = count[n] + 1;
		  if (*base <= minval)
#endif
		    {
		      fast = 1;
		      minval = *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 (unlikely (*mbase && (*base <= minval)))
	        {
	      	  minval = *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 (*mbase && (*base < minval)))
		{
		  minval = *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 sminloc0_16_i2 (gfc_array_i16 * const restrict, 
	gfc_array_i2 * const restrict, GFC_LOGICAL_4 *, GFC_LOGICAL_4);
export_proto(sminloc0_16_i2);

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

  if (mask == NULL || *mask)
    {
      minloc0_16_i2 (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_16));
    }
  else if (unlikely (compile_options.bounds_check))
    {
       bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
			       "MINLOC");
    }

  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 MINLOC intrinsic
	2	Copyright (C) 2002-2020 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_2) && defined (HAVE_GFC_INTEGER_16)
	31
	32
	33	extern void minloc0_16_i2 (gfc_array_i16 * const restrict retarray,
	34	gfc_array_i2 * const restrict array, GFC_LOGICAL_4);
	35	export_proto(minloc0_16_i2);
	36
	37	void
	38	minloc0_16_i2 (gfc_array_i16 * const restrict retarray,
	39	gfc_array_i2 * 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_2 *base;
	46	GFC_INTEGER_16 * 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_16));
	60	}
	61	else
	62	{
	63	if (unlikely (compile_options.bounds_check))
	64	bounds_iforeach_return ((array_t ) retarray, (array_t ) array,
	65	"MINLOC");
	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_2 minval;
	92	#if defined(GFC_INTEGER_2_QUIET_NAN)
	93	int fast = 0;
	94	#endif
	95
	96	#if defined(GFC_INTEGER_2_INFINITY)
	97	minval = GFC_INTEGER_2_INFINITY;
	98	#else
	99	minval = GFC_INTEGER_2_HUGE;
	100	#endif
	101	while (base)
	102	{
	103	/* Implementation start. */
	104
	105	#if defined(GFC_INTEGER_2_QUIET_NAN)
	106	if (unlikely (!fast))
	107	{
	108	do
	109	{
	110	if (*base <= minval)
	111	{
	112	fast = 1;
	113	minval = *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 <= minval))
	130	{
	131	minval = *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 < minval))
	142	{
	143	minval = *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 mminloc0_16_i2 (gfc_array_i16 * const restrict,
	180	gfc_array_i2 * const restrict, gfc_array_l1 * const restrict,
	181	GFC_LOGICAL_4);
	182	export_proto(mminloc0_16_i2);
	183
	184	void
	185	mminloc0_16_i2 (gfc_array_i16 * const restrict retarray,
	186	gfc_array_i2 * 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_16 *dest;
	195	const GFC_INTEGER_2 *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	minloc0_16_i2 (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_16));
	218	}
	219	else
	220	{
	221	if (unlikely (compile_options.bounds_check))
	222	{
	223
	224	bounds_iforeach_return ((array_t ) retarray, (array_t ) array,
	225	"MINLOC");
	226	bounds_equal_extents ((array_t ) mask, (array_t ) array,
	227	"MASK argument", "MINLOC");
	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_2 minval;
	269	int fast = 0;
	270
	271	#if defined(GFC_INTEGER_2_INFINITY)
	272	minval = GFC_INTEGER_2_INFINITY;
	273	#else
	274	minval = GFC_INTEGER_2_HUGE;
	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_2_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 <= minval)
	291	#endif
	292	{
	293	fast = 1;
	294	minval = *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 (unlikely (mbase && (base <= minval)))
	312	{
	313	minval = *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 (unlikely (mbase && (base < minval)))
	324	{
	325	minval = *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	extern void sminloc0_16_i2 (gfc_array_i16 * const restrict,
	365	gfc_array_i2 * const restrict, GFC_LOGICAL_4 *, GFC_LOGICAL_4);
	366	export_proto(sminloc0_16_i2);
	367
	368	void
	369	sminloc0_16_i2 (gfc_array_i16 * const restrict retarray,
	370	gfc_array_i2 * const restrict array,
	371	GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
	372	{
	373	index_type rank;
	374	index_type dstride;
	375	index_type n;
	376	GFC_INTEGER_16 *dest;
	377
	378	if (mask == NULL \|\| *mask)
	379	{
	380	minloc0_16_i2 (retarray, array, back);
	381	return;
	382	}
	383
	384	rank = GFC_DESCRIPTOR_RANK (array);
	385
	386	if (rank <= 0)
	387	runtime_error ("Rank of array needs to be > 0");
	388
	389	if (retarray->base_addr == NULL)
	390	{
	391	GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
	392	retarray->dtype.rank = 1;
	393	retarray->offset = 0;
	394	retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_16));
	395	}
	396	else if (unlikely (compile_options.bounds_check))
	397	{
	398	bounds_iforeach_return ((array_t ) retarray, (array_t ) array,
	399	"MINLOC");
	400	}
	401
	402	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
	403	dest = retarray->base_addr;
	404	for (n = 0; n<rank; n++)
	405	dest[n * dstride] = 0 ;
	406	}
	407	#endif