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

/* Implementation of the MINLOC intrinsic
   Copyright 2002, 2007 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 2 of the License, or (at your option) any later version.

In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file.  (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)

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.

You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING.  If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA.  */

#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#include <limits.h>


#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4)


extern void minloc0_4_r16 (gfc_array_i4 * const restrict retarray, 
	gfc_array_r16 * const restrict array);
export_proto(minloc0_4_r16);

void
minloc0_4_r16 (gfc_array_i4 * const restrict retarray, 
	gfc_array_r16 * 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_REAL_16 *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)
    {
      retarray->dim[0].lbound = 0;
      retarray->dim[0].ubound = rank-1;
      retarray->dim[0].stride = 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 = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
	  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 = retarray->dim[0].stride;
  dest = retarray->data;
  for (n = 0; n < rank; n++)
    {
      sstride[n] = array->dim[n].stride;
      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
      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_REAL_16 minval;

  minval = GFC_REAL_16_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_r16 (gfc_array_i4 * const restrict, 
	gfc_array_r16 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_4_r16);

void
mminloc0_4_r16 (gfc_array_i4 * const restrict retarray, 
	gfc_array_r16 * 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_REAL_16 *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)
    {
      retarray->dim[0].lbound = 0;
      retarray->dim[0].ubound = rank-1;
      retarray->dim[0].stride = 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 = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
	  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 = array->dim[n].ubound + 1 - array->dim[n].lbound;
	      mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
	      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 = retarray->dim[0].stride;
  dest = retarray->data;
  for (n = 0; n < rank; n++)
    {
      sstride[n] = array->dim[n].stride;
      mstride[n] = mask->dim[n].stride * mask_kind;
      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
      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_REAL_16 minval;

  minval = GFC_REAL_16_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_r16 (gfc_array_i4 * const restrict, 
	gfc_array_r16 * const restrict, GFC_LOGICAL_4 *);
export_proto(sminloc0_4_r16);

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

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

  rank = GFC_DESCRIPTOR_RANK (array);

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

  if (retarray->data == NULL)
    {
      retarray->dim[0].lbound = 0;
      retarray->dim[0].ubound = rank-1;
      retarray->dim[0].stride = 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 = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
	    if (ret_extent != rank)
	      runtime_error ("dimension of return array incorrect");
	}
    }

  dstride = retarray->dim[0].stride;
  dest = retarray->data;
  for (n = 0; n<rank; n++)
    dest[n * dstride] = 0 ;
}
#endif
Commit	Line	Data
644cb69f	1	/* Implementation of the MINLOC intrinsic
36ae8a61	2	Copyright 2002, 2007 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
	10	version 2 of the License, or (at your option) any later version.
	11
	12	In addition to the permissions in the GNU General Public License, the
	13	Free Software Foundation gives you unlimited permission to link the
	14	compiled version of this file into combinations with other programs,
	15	and to distribute those combinations without any restriction coming
	16	from the use of this file. (The General Public License restrictions
	17	do apply in other respects; for example, they cover modification of
	18	the file, and distribution when not linked into a combine
	19	executable.)
	20
	21	Libgfortran is distributed in the hope that it will be useful,
	22	but WITHOUT ANY WARRANTY; without even the implied warranty of
	23	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	24	GNU General Public License for more details.
	25
	26	You should have received a copy of the GNU General Public
	27	License along with libgfortran; see the file COPYING. If not,
	28	write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
	29	Boston, MA 02110-1301, USA. */
	30
36ae8a61	31	#include "libgfortran.h"
644cb69f FXC	32	#include <stdlib.h>
644cb69f FXC	33	#include <assert.h>
644cb69f	34	#include <limits.h>
644cb69f FXC	35
	36
	37	#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4)
	38
	39
64acfd99 JB	40	extern void minloc0_4_r16 (gfc_array_i4 * const restrict retarray,
64acfd99 JB	41	gfc_array_r16 * const restrict array);
644cb69f FXC	42	export_proto(minloc0_4_r16);
	43
	44	void
64acfd99 JB	45	minloc0_4_r16 (gfc_array_i4 * const restrict retarray,
64acfd99 JB	46	gfc_array_r16 * const restrict array)
644cb69f FXC	47	{
	48	index_type count[GFC_MAX_DIMENSIONS];
	49	index_type extent[GFC_MAX_DIMENSIONS];
	50	index_type sstride[GFC_MAX_DIMENSIONS];
	51	index_type dstride;
64acfd99	52	const GFC_REAL_16 *base;
5863aacf	53	GFC_INTEGER_4 * restrict dest;
644cb69f FXC	54	index_type rank;
	55	index_type n;
	56
	57	rank = GFC_DESCRIPTOR_RANK (array);
	58	if (rank <= 0)
	59	runtime_error ("Rank of array needs to be > 0");
	60
	61	if (retarray->data == NULL)
	62	{
	63	retarray->dim[0].lbound = 0;
	64	retarray->dim[0].ubound = rank-1;
	65	retarray->dim[0].stride = 1;
	66	retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) \| 1;
	67	retarray->offset = 0;
	68	retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
	69	}
	70	else
	71	{
9731c4a3	72	if (unlikely (compile_options.bounds_check))
fd6590f8 TK	73	{
	74	int ret_rank;
	75	index_type ret_extent;
	76
	77	ret_rank = GFC_DESCRIPTOR_RANK (retarray);
	78	if (ret_rank != 1)
	79	runtime_error ("rank of return array in MINLOC intrinsic"
ccacefc7	80	" should be 1, is %ld", (long int) ret_rank);
fd6590f8 TK	81
	82	ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
	83	if (ret_extent != rank)
	84	runtime_error ("Incorrect extent in return value of"
ccacefc7 TK	85	" MINLOC intrnisic: is %ld, should be %ld",
ccacefc7 TK	86	(long int) ret_extent, (long int) rank);
fd6590f8	87	}
644cb69f FXC	88	}
644cb69f FXC	89
644cb69f FXC	90	dstride = retarray->dim[0].stride;
	91	dest = retarray->data;
	92	for (n = 0; n < rank; n++)
	93	{
	94	sstride[n] = array->dim[n].stride;
	95	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
	96	count[n] = 0;
	97	if (extent[n] <= 0)
	98	{
	99	/* Set the return value. */
	100	for (n = 0; n < rank; n++)
	101	dest[n * dstride] = 0;
	102	return;
	103	}
	104	}
	105
	106	base = array->data;
	107
	108	/* Initialize the return value. */
	109	for (n = 0; n < rank; n++)
a4b9e93e	110	dest[n * dstride] = 0;
644cb69f FXC	111	{
	112
	113	GFC_REAL_16 minval;
	114
	115	minval = GFC_REAL_16_HUGE;
	116
	117	while (base)
	118	{
	119	{
	120	/* Implementation start. */
	121
a4b9e93e	122	if (*base < minval \|\| !dest[0])
644cb69f FXC	123	{
	124	minval = *base;
	125	for (n = 0; n < rank; n++)
	126	dest[n * dstride] = count[n] + 1;
	127	}
	128	/* Implementation end. */
	129	}
	130	/* Advance to the next element. */
	131	count[0]++;
	132	base += sstride[0];
	133	n = 0;
	134	while (count[n] == extent[n])
	135	{
	136	/* When we get to the end of a dimension, reset it and increment
	137	the next dimension. */
	138	count[n] = 0;
	139	/* We could precalculate these products, but this is a less
5d7adf7a	140	frequently used path so probably not worth it. */
644cb69f FXC	141	base -= sstride[n] * extent[n];
	142	n++;
	143	if (n == rank)
	144	{
	145	/* Break out of the loop. */
	146	base = NULL;
	147	break;
	148	}
	149	else
	150	{
	151	count[n]++;
	152	base += sstride[n];
	153	}
	154	}
	155	}
	156	}
	157	}
	158
	159
64acfd99	160	extern void mminloc0_4_r16 (gfc_array_i4 * const restrict,
28dc6b33	161	gfc_array_r16 * const restrict, gfc_array_l1 * const restrict);
644cb69f FXC	162	export_proto(mminloc0_4_r16);
	163
	164	void
64acfd99 JB	165	mminloc0_4_r16 (gfc_array_i4 * const restrict retarray,
64acfd99 JB	166	gfc_array_r16 * const restrict array,
28dc6b33	167	gfc_array_l1 * const restrict mask)
644cb69f FXC	168	{
	169	index_type count[GFC_MAX_DIMENSIONS];
	170	index_type extent[GFC_MAX_DIMENSIONS];
	171	index_type sstride[GFC_MAX_DIMENSIONS];
	172	index_type mstride[GFC_MAX_DIMENSIONS];
	173	index_type dstride;
	174	GFC_INTEGER_4 *dest;
64acfd99	175	const GFC_REAL_16 *base;
28dc6b33	176	GFC_LOGICAL_1 *mbase;
644cb69f FXC	177	int rank;
644cb69f FXC	178	index_type n;
28dc6b33	179	int mask_kind;
644cb69f FXC	180
	181	rank = GFC_DESCRIPTOR_RANK (array);
	182	if (rank <= 0)
	183	runtime_error ("Rank of array needs to be > 0");
	184
	185	if (retarray->data == NULL)
	186	{
	187	retarray->dim[0].lbound = 0;
	188	retarray->dim[0].ubound = rank-1;
	189	retarray->dim[0].stride = 1;
	190	retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) \| 1;
	191	retarray->offset = 0;
	192	retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
	193	}
	194	else
	195	{
9731c4a3	196	if (unlikely (compile_options.bounds_check))
fd6590f8 TK	197	{
	198	int ret_rank, mask_rank;
	199	index_type ret_extent;
	200	int n;
	201	index_type array_extent, mask_extent;
	202
	203	ret_rank = GFC_DESCRIPTOR_RANK (retarray);
	204	if (ret_rank != 1)
	205	runtime_error ("rank of return array in MINLOC intrinsic"
ccacefc7	206	" should be 1, is %ld", (long int) ret_rank);
fd6590f8 TK	207
	208	ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
	209	if (ret_extent != rank)
	210	runtime_error ("Incorrect extent in return value of"
ccacefc7 TK	211	" MINLOC intrnisic: is %ld, should be %ld",
ccacefc7 TK	212	(long int) ret_extent, (long int) rank);
fd6590f8 TK	213
	214	mask_rank = GFC_DESCRIPTOR_RANK (mask);
	215	if (rank != mask_rank)
	216	runtime_error ("rank of MASK argument in MINLOC intrnisic"
ccacefc7 TK	217	"should be %ld, is %ld", (long int) rank,
ccacefc7 TK	218	(long int) mask_rank);
fd6590f8 TK	219
	220	for (n=0; n<rank; n++)
	221	{
	222	array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
	223	mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
	224	if (array_extent != mask_extent)
	225	runtime_error ("Incorrect extent in MASK argument of"
ccacefc7 TK	226	" MINLOC intrinsic in dimension %ld:"
ccacefc7 TK	227	" is %ld, should be %ld", (long int) n + 1,
fd6590f8 TK	228	(long int) mask_extent, (long int) array_extent);
	229	}
	230	}
644cb69f FXC	231	}
644cb69f FXC	232
28dc6b33 TK	233	mask_kind = GFC_DESCRIPTOR_SIZE (mask);
	234
	235	mbase = mask->data;
	236
	237	if (mask_kind == 1 \|\| mask_kind == 2 \|\| mask_kind == 4 \|\| mask_kind == 8
	238	#ifdef HAVE_GFC_LOGICAL_16
	239	\|\| mask_kind == 16
	240	#endif
	241	)
	242	mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
	243	else
	244	runtime_error ("Funny sized logical array");
	245
644cb69f FXC	246	dstride = retarray->dim[0].stride;
	247	dest = retarray->data;
	248	for (n = 0; n < rank; n++)
	249	{
	250	sstride[n] = array->dim[n].stride;
28dc6b33	251	mstride[n] = mask->dim[n].stride * mask_kind;
644cb69f FXC	252	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
	253	count[n] = 0;
	254	if (extent[n] <= 0)
	255	{
	256	/* Set the return value. */
	257	for (n = 0; n < rank; n++)
	258	dest[n * dstride] = 0;
	259	return;
	260	}
	261	}
	262
	263	base = array->data;
644cb69f FXC	264
	265	/* Initialize the return value. */
	266	for (n = 0; n < rank; n++)
a4b9e93e	267	dest[n * dstride] = 0;
644cb69f FXC	268	{
	269
	270	GFC_REAL_16 minval;
	271
	272	minval = GFC_REAL_16_HUGE;
	273
	274	while (base)
	275	{
	276	{
	277	/* Implementation start. */
	278
a4b9e93e	279	if (mbase && (base < minval \|\| !dest[0]))
644cb69f FXC	280	{
	281	minval = *base;
	282	for (n = 0; n < rank; n++)
	283	dest[n * dstride] = count[n] + 1;
	284	}
	285	/* Implementation end. */
	286	}
	287	/* Advance to the next element. */
	288	count[0]++;
	289	base += sstride[0];
	290	mbase += mstride[0];
	291	n = 0;
	292	while (count[n] == extent[n])
	293	{
	294	/* When we get to the end of a dimension, reset it and increment
	295	the next dimension. */
	296	count[n] = 0;
	297	/* We could precalculate these products, but this is a less
5d7adf7a	298	frequently used path so probably not worth it. */
644cb69f FXC	299	base -= sstride[n] * extent[n];
	300	mbase -= mstride[n] * extent[n];
	301	n++;
	302	if (n == rank)
	303	{
	304	/* Break out of the loop. */
	305	base = NULL;
	306	break;
	307	}
	308	else
	309	{
	310	count[n]++;
	311	base += sstride[n];
	312	mbase += mstride[n];
	313	}
	314	}
	315	}
	316	}
	317	}
	318
97a62038 TK	319
	320	extern void sminloc0_4_r16 (gfc_array_i4 * const restrict,
	321	gfc_array_r16 * const restrict, GFC_LOGICAL_4 *);
	322	export_proto(sminloc0_4_r16);
	323
	324	void
	325	sminloc0_4_r16 (gfc_array_i4 * const restrict retarray,
	326	gfc_array_r16 * const restrict array,
	327	GFC_LOGICAL_4 * mask)
	328	{
	329	index_type rank;
	330	index_type dstride;
	331	index_type n;
	332	GFC_INTEGER_4 *dest;
	333
	334	if (*mask)
	335	{
	336	minloc0_4_r16 (retarray, array);
	337	return;
	338	}
	339
	340	rank = GFC_DESCRIPTOR_RANK (array);
	341
	342	if (rank <= 0)
	343	runtime_error ("Rank of array needs to be > 0");
	344
	345	if (retarray->data == NULL)
	346	{
	347	retarray->dim[0].lbound = 0;
	348	retarray->dim[0].ubound = rank-1;
	349	retarray->dim[0].stride = 1;
	350	retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) \| 1;
	351	retarray->offset = 0;
	352	retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
	353	}
	354	else
	355	{
9731c4a3	356	if (unlikely (compile_options.bounds_check))
fd6590f8 TK	357	{
	358	int ret_rank;
	359	index_type ret_extent;
97a62038	360
fd6590f8 TK	361	ret_rank = GFC_DESCRIPTOR_RANK (retarray);
	362	if (ret_rank != 1)
	363	runtime_error ("rank of return array in MINLOC intrinsic"
ccacefc7	364	" should be 1, is %ld", (long int) ret_rank);
fd6590f8 TK	365
	366	ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
	367	if (ret_extent != rank)
	368	runtime_error ("dimension of return array incorrect");
	369	}
97a62038 TK	370	}
	371
	372	dstride = retarray->dim[0].stride;
	373	dest = retarray->data;
	374	for (n = 0; n<rank; n++)
	375	dest[n * dstride] = 0 ;
	376	}
644cb69f	377	#endif