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

/* Implementation of the MINLOC intrinsic
   Copyright (C) 2002-2018 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_8)


extern void minloc0_8_i2 (gfc_array_i8 * const restrict retarray, 
	gfc_array_i2 * const restrict array, GFC_LOGICAL_4);
export_proto(minloc0_8_i2);

void
minloc0_8_i2 (gfc_array_i8 * 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_8 * restrict dest;
  index_type rank;
  index_type n;

  assert(back == 0);
  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);
      GFC_DTYPE_COPY_SETRANK(retarray,retarray,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,
				"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)
    {
      do
	{
	  /* Implementation start.  */

#if defined(GFC_INTEGER_2_QUIET_NAN)
	}
      while (0);
      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 do
	{
#endif
	  if (*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_8_i2 (gfc_array_i8 * const restrict, 
	gfc_array_i2 * const restrict, gfc_array_l1 * const restrict,
	GFC_LOGICAL_4);
export_proto(mminloc0_8_i2);

void
mminloc0_8_i2 (gfc_array_i8 * 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_8 *dest;
  const GFC_INTEGER_2 *base;
  GFC_LOGICAL_1 *mbase;
  int rank;
  index_type n;
  int mask_kind;

  assert(back == 0);
  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);
      GFC_DTYPE_COPY_SETRANK(retarray,retarray,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,
				  "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)
    {
      do
	{
	  /* Implementation start.  */

	}
      while (0);
      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 do
	{
	  if (*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_8_i2 (gfc_array_i8 * const restrict, 
	gfc_array_i2 * const restrict, GFC_LOGICAL_4 *, GFC_LOGICAL_4);
export_proto(sminloc0_8_i2);

void
sminloc0_8_i2 (gfc_array_i8 * 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_8 *dest;

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