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

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


#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16)


extern void minloc0_16_i8 (gfc_array_i16 * const restrict retarray, 
	gfc_array_i8 * const restrict array);
export_proto(minloc0_16_i8);

void
minloc0_16_i8 (gfc_array_i16 * const restrict retarray, 
	gfc_array_i8 * 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_INTEGER_8 *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,
				"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_8 minval;
#if defined(GFC_INTEGER_8_QUIET_NAN)
    int fast = 0;
#endif

#if defined(GFC_INTEGER_8_INFINITY)
    minval = GFC_INTEGER_8_INFINITY;
#else
    minval = GFC_INTEGER_8_HUGE;
#endif
  while (base)
    {
      do
	{
	  /* Implementation start.  */

#if defined(GFC_INTEGER_8_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_16_i8 (gfc_array_i16 * const restrict, 
	gfc_array_i8 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_16_i8);

void
mminloc0_16_i8 (gfc_array_i16 * const restrict retarray, 
	gfc_array_i8 * 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_INTEGER_8 *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,
				  "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_8 minval;
   int fast = 0;

#if defined(GFC_INTEGER_8_INFINITY)
    minval = GFC_INTEGER_8_INFINITY;
#else
    minval = GFC_INTEGER_8_HUGE;
#endif
  while (base)
    {
      do
	{
	  /* Implementation start.  */

	}
      while (0);
      if (unlikely (!fast))
	{
	  do
	    {
	      if (*mbase)
		{
#if defined(GFC_INTEGER_8_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_16_i8 (gfc_array_i16 * const restrict, 
	gfc_array_i8 * const restrict, GFC_LOGICAL_4 *);
export_proto(sminloc0_16_i8);

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

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