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

/* Implementation of the MINLOC intrinsic
   Copyright 2002, 2007, 2009 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 <stdlib.h>
#include <assert.h>
#include <limits.h>


#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4)


extern void minloc0_4_i1 (gfc_array_i4 * const restrict retarray, 
	gfc_array_i1 * const restrict array);
export_proto(minloc0_4_i1);

void
minloc0_4_i1 (gfc_array_i4 * const restrict retarray, 
	gfc_array_i1 * 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_1 *base;
  GFC_INTEGER_4 * 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->data == NULL)
    {
      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
      retarray->offset = 0;
      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
    }
  else
    {
      if (unlikely (compile_options.bounds_check))
	{
	  int ret_rank;
	  index_type ret_extent;

	  ret_rank = GFC_DESCRIPTOR_RANK (retarray);
	  if (ret_rank != 1)
	    runtime_error ("rank of return array in MINLOC intrinsic"
			   " should be 1, is %ld", (long int) ret_rank);

	  ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
	  if (ret_extent != rank)
	    runtime_error ("Incorrect extent in return value of"
			   " MINLOC intrnisic: is %ld, should be %ld",
			   (long int) ret_extent, (long int) rank);
	}
    }

  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
  dest = retarray->data;
  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->data;

  /* Initialize the return value.  */
  for (n = 0; n < rank; n++)
    dest[n * dstride] = 0;
  {

  GFC_INTEGER_1 minval;

  minval = GFC_INTEGER_1_HUGE;

  while (base)
    {
      {
        /* Implementation start.  */

  if (*base < minval || !dest[0])
    {
      minval = *base;
      for (n = 0; n < rank; n++)
        dest[n * dstride] = count[n] + 1;
    }
        /* Implementation end.  */
      }
      /* Advance to the next element.  */
      count[0]++;
      base += sstride[0];
      n = 0;
      while (count[n] == extent[n])
        {
          /* 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];
            }
        }
    }
  }
}


extern void mminloc0_4_i1 (gfc_array_i4 * const restrict, 
	gfc_array_i1 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_4_i1);

void
mminloc0_4_i1 (gfc_array_i4 * const restrict retarray, 
	gfc_array_i1 * 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_4 *dest;
  const GFC_INTEGER_1 *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->data == NULL)
    {
      GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1);
      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
      retarray->offset = 0;
      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
    }
  else
    {
      if (unlikely (compile_options.bounds_check))
	{
	  int ret_rank, mask_rank;
	  index_type ret_extent;
	  int n;
	  index_type array_extent, mask_extent;

	  ret_rank = GFC_DESCRIPTOR_RANK (retarray);
	  if (ret_rank != 1)
	    runtime_error ("rank of return array in MINLOC intrinsic"
			   " should be 1, is %ld", (long int) ret_rank);

	  ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
	  if (ret_extent != rank)
	    runtime_error ("Incorrect extent in return value of"
			   " MINLOC intrnisic: is %ld, should be %ld",
			   (long int) ret_extent, (long int) rank);
	
	  mask_rank = GFC_DESCRIPTOR_RANK (mask);
	  if (rank != mask_rank)
	    runtime_error ("rank of MASK argument in MINLOC intrnisic"
	                   "should be %ld, is %ld", (long int) rank,
			   (long int) mask_rank);

	  for (n=0; n<rank; n++)
	    {
	      array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
	      mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
	      if (array_extent != mask_extent)
		runtime_error ("Incorrect extent in MASK argument of"
			       " MINLOC intrinsic in dimension %ld:"
			       " is %ld, should be %ld", (long int) n + 1,
			       (long int) mask_extent, (long int) array_extent);
	    }
	}
    }

  mask_kind = GFC_DESCRIPTOR_SIZE (mask);

  mbase = mask->data;

  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->data;
  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->data;

  /* Initialize the return value.  */
  for (n = 0; n < rank; n++)
    dest[n * dstride] = 0;
  {

  GFC_INTEGER_1 minval;

  minval = GFC_INTEGER_1_HUGE;

  while (base)
    {
      {
        /* Implementation start.  */

  if (*mbase && (*base < minval || !dest[0]))
    {
      minval = *base;
      for (n = 0; n < rank; n++)
        dest[n * dstride] = count[n] + 1;
    }
        /* Implementation end.  */
      }
      /* Advance to the next element.  */
      count[0]++;
      base += sstride[0];
      mbase += mstride[0];
      n = 0;
      while (count[n] == extent[n])
        {
          /* 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];
            }
        }
    }
  }
}


extern void sminloc0_4_i1 (gfc_array_i4 * const restrict, 
	gfc_array_i1 * const restrict, GFC_LOGICAL_4 *);
export_proto(sminloc0_4_i1);

void
sminloc0_4_i1 (gfc_array_i4 * const restrict retarray, 
	gfc_array_i1 * const restrict array,
	GFC_LOGICAL_4 * mask)
{
  index_type rank;
  index_type dstride;
  index_type n;
  GFC_INTEGER_4 *dest;

  if (*mask)
    {
      minloc0_4_i1 (retarray, array);
      return;
    }

  rank = GFC_DESCRIPTOR_RANK (array);

  if (rank <= 0)
    runtime_error ("Rank of array needs to be > 0");

  if (retarray->data == NULL)
    {
      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
      retarray->offset = 0;
      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
    }
  else
    {
      if (unlikely (compile_options.bounds_check))
	{
	  int ret_rank;
	  index_type ret_extent;

	  ret_rank = GFC_DESCRIPTOR_RANK (retarray);
	  if (ret_rank != 1)
	    runtime_error ("rank of return array in MINLOC intrinsic"
			   " should be 1, is %ld", (long int) ret_rank);

	  ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
	    if (ret_extent != rank)
	      runtime_error ("dimension of return array incorrect");
	}
    }

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