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

/* Implementation of the MINLOC intrinsic
   Copyright 2002 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 "config.h"
#include <stdlib.h>
#include <assert.h>
#include <float.h>
#include <limits.h>
#include "libgfortran.h"


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


extern void minloc1_4_i4 (gfc_array_i4 * const restrict, 
	gfc_array_i4 * const restrict, const index_type * const restrict);
export_proto(minloc1_4_i4);

void
minloc1_4_i4 (gfc_array_i4 * const restrict retarray, 
	gfc_array_i4 * const restrict array, 
	const index_type * const restrict pdim)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type dstride[GFC_MAX_DIMENSIONS];
  const GFC_INTEGER_4 * restrict base;
  GFC_INTEGER_4 * restrict dest;
  index_type rank;
  index_type n;
  index_type len;
  index_type delta;
  index_type dim;

  /* Make dim zero based to avoid confusion.  */
  dim = (*pdim) - 1;
  rank = GFC_DESCRIPTOR_RANK (array) - 1;

  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
  delta = array->dim[dim].stride;

  for (n = 0; n < dim; n++)
    {
      sstride[n] = array->dim[n].stride;
      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;

      if (extent[n] < 0)
	extent[n] = 0;
    }
  for (n = dim; n < rank; n++)
    {
      sstride[n] = array->dim[n + 1].stride;
      extent[n] =
        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;

      if (extent[n] < 0)
	extent[n] = 0;
    }

  if (retarray->data == NULL)
    {
      size_t alloc_size;

      for (n = 0; n < rank; n++)
        {
          retarray->dim[n].lbound = 0;
          retarray->dim[n].ubound = extent[n]-1;
          if (n == 0)
            retarray->dim[n].stride = 1;
          else
            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
        }

      retarray->offset = 0;
      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;

      alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
    		   * extent[rank-1];

      if (alloc_size == 0)
	{
	  /* Make sure we have a zero-sized array.  */
	  retarray->dim[0].lbound = 0;
	  retarray->dim[0].ubound = -1;
	  return;
	}
      else
	retarray->data = internal_malloc_size (alloc_size);
    }
  else
    {
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
	runtime_error ("rank of return array incorrect");
    }

  for (n = 0; n < rank; n++)
    {
      count[n] = 0;
      dstride[n] = retarray->dim[n].stride;
      if (extent[n] <= 0)
        len = 0;
    }

  base = array->data;
  dest = retarray->data;

  while (base)
    {
      const GFC_INTEGER_4 * restrict src;
      GFC_INTEGER_4 result;
      src = base;
      {

  GFC_INTEGER_4 minval;
  minval = GFC_INTEGER_4_HUGE;
  result = 0;
        if (len <= 0)
	  *dest = 0;
	else
	  {
	    for (n = 0; n < len; n++, src += delta)
	      {

  if (*src < minval || !result)
    {
      minval = *src;
      result = (GFC_INTEGER_4)n + 1;
    }
          }
	    *dest = result;
	  }
      }
      /* Advance to the next element.  */
      count[0]++;
      base += sstride[0];
      dest += dstride[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];
          dest -= dstride[n] * extent[n];
          n++;
          if (n == rank)
            {
              /* Break out of the look.  */
              base = NULL;
              break;
            }
          else
            {
              count[n]++;
              base += sstride[n];
              dest += dstride[n];
            }
        }
    }
}


extern void mminloc1_4_i4 (gfc_array_i4 * const restrict, 
	gfc_array_i4 * const restrict, const index_type * const restrict,
	gfc_array_l4 * const restrict);
export_proto(mminloc1_4_i4);

void
mminloc1_4_i4 (gfc_array_i4 * const restrict retarray, 
	gfc_array_i4 * const restrict array, 
	const index_type * const restrict pdim, 
	gfc_array_l4 * const restrict mask)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type dstride[GFC_MAX_DIMENSIONS];
  index_type mstride[GFC_MAX_DIMENSIONS];
  GFC_INTEGER_4 * restrict dest;
  const GFC_INTEGER_4 * restrict base;
  const GFC_LOGICAL_4 * restrict mbase;
  int rank;
  int dim;
  index_type n;
  index_type len;
  index_type delta;
  index_type mdelta;

  dim = (*pdim) - 1;
  rank = GFC_DESCRIPTOR_RANK (array) - 1;

  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
  if (len <= 0)
    return;
  delta = array->dim[dim].stride;
  mdelta = mask->dim[dim].stride;

  for (n = 0; n < dim; n++)
    {
      sstride[n] = array->dim[n].stride;
      mstride[n] = mask->dim[n].stride;
      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;

      if (extent[n] < 0)
	extent[n] = 0;

    }
  for (n = dim; n < rank; n++)
    {
      sstride[n] = array->dim[n + 1].stride;
      mstride[n] = mask->dim[n + 1].stride;
      extent[n] =
        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;

      if (extent[n] < 0)
	extent[n] = 0;
    }

  if (retarray->data == NULL)
    {
      size_t alloc_size;

      for (n = 0; n < rank; n++)
        {
          retarray->dim[n].lbound = 0;
          retarray->dim[n].ubound = extent[n]-1;
          if (n == 0)
            retarray->dim[n].stride = 1;
          else
            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
        }

      alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
    		   * extent[rank-1];

      retarray->offset = 0;
      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;

      if (alloc_size == 0)
	{
	  /* Make sure we have a zero-sized array.  */
	  retarray->dim[0].lbound = 0;
	  retarray->dim[0].ubound = -1;
	  return;
	}
      else
	retarray->data = internal_malloc_size (alloc_size);

    }
  else
    {
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
	runtime_error ("rank of return array incorrect");
    }

  for (n = 0; n < rank; n++)
    {
      count[n] = 0;
      dstride[n] = retarray->dim[n].stride;
      if (extent[n] <= 0)
        return;
    }

  dest = retarray->data;
  base = array->data;
  mbase = mask->data;

  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
    {
      /* This allows the same loop to be used for all logical types.  */
      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
      for (n = 0; n < rank; n++)
        mstride[n] <<= 1;
      mdelta <<= 1;
      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
    }

  while (base)
    {
      const GFC_INTEGER_4 * restrict src;
      const GFC_LOGICAL_4 * restrict msrc;
      GFC_INTEGER_4 result;
      src = base;
      msrc = mbase;
      {

  GFC_INTEGER_4 minval;
  minval = GFC_INTEGER_4_HUGE;
  result = 0;
        if (len <= 0)
	  *dest = 0;
	else
	  {
	    for (n = 0; n < len; n++, src += delta, msrc += mdelta)
	      {

  if (*msrc && (*src < minval || !result))
    {
      minval = *src;
      result = (GFC_INTEGER_4)n + 1;
    }
              }
	    *dest = result;
	  }
      }
      /* Advance to the next element.  */
      count[0]++;
      base += sstride[0];
      mbase += mstride[0];
      dest += dstride[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];
          dest -= dstride[n] * extent[n];
          n++;
          if (n == rank)
            {
              /* Break out of the look.  */
              base = NULL;
              break;
            }
          else
            {
              count[n]++;
              base += sstride[n];
              mbase += mstride[n];
              dest += dstride[n];
            }
        }
    }
}


extern void sminloc1_4_i4 (gfc_array_i4 * const restrict, 
	gfc_array_i4 * const restrict, const index_type * const restrict,
	GFC_LOGICAL_4 *);
export_proto(sminloc1_4_i4);

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

  if (*mask)
    {
      minloc1_4_i4 (retarray, array, pdim);
      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 (GFC_DESCRIPTOR_RANK (retarray) != 1)
	runtime_error ("rank of return array does not equal 1");

      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != 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
6de9cd9a DN	1	/* Implementation of the MINLOC intrinsic
	2	Copyright 2002 Free Software Foundation, Inc.
	3	Contributed by Paul Brook <paul@nowt.org>
	4
57dea9f6	5	This file is part of the GNU Fortran 95 runtime library (libgfortran).
6de9cd9a DN	6
6de9cd9a DN	7	Libgfortran is free software; you can redistribute it and/or
57dea9f6	8	modify it under the terms of the GNU General Public
6de9cd9a	9	License as published by the Free Software Foundation; either
57dea9f6 TM	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.)
6de9cd9a DN	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
57dea9f6	24	GNU General Public License for more details.
6de9cd9a	25
57dea9f6 TM	26	You should have received a copy of the GNU General Public
57dea9f6 TM	27	License along with libgfortran; see the file COPYING. If not,
fe2ae685 KC	28	write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
fe2ae685 KC	29	Boston, MA 02110-1301, USA. */
6de9cd9a DN	30
	31	#include "config.h"
	32	#include <stdlib.h>
	33	#include <assert.h>
	34	#include <float.h>
	35	#include <limits.h>
	36	#include "libgfortran.h"
	37
7d7b8bfe	38
644cb69f FXC	39	#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
	40
	41
64acfd99 JB	42	extern void minloc1_4_i4 (gfc_array_i4 * const restrict,
64acfd99 JB	43	gfc_array_i4 * const restrict, const index_type * const restrict);
7f68c75f	44	export_proto(minloc1_4_i4);
7d7b8bfe	45
6de9cd9a	46	void
64acfd99 JB	47	minloc1_4_i4 (gfc_array_i4 * const restrict retarray,
	48	gfc_array_i4 * const restrict array,
	49	const index_type * const restrict pdim)
6de9cd9a	50	{
e33e218b TK	51	index_type count[GFC_MAX_DIMENSIONS];
	52	index_type extent[GFC_MAX_DIMENSIONS];
	53	index_type sstride[GFC_MAX_DIMENSIONS];
	54	index_type dstride[GFC_MAX_DIMENSIONS];
64acfd99 JB	55	const GFC_INTEGER_4 * restrict base;
64acfd99 JB	56	GFC_INTEGER_4 * restrict dest;
6de9cd9a DN	57	index_type rank;
	58	index_type n;
	59	index_type len;
	60	index_type delta;
	61	index_type dim;
	62
	63	/* Make dim zero based to avoid confusion. */
	64	dim = (*pdim) - 1;
	65	rank = GFC_DESCRIPTOR_RANK (array) - 1;
e33e218b	66
6de9cd9a DN	67	len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
	68	delta = array->dim[dim].stride;
	69
	70	for (n = 0; n < dim; n++)
	71	{
	72	sstride[n] = array->dim[n].stride;
	73	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
80ee04b9 TK	74
	75	if (extent[n] < 0)
	76	extent[n] = 0;
6de9cd9a DN	77	}
	78	for (n = dim; n < rank; n++)
	79	{
	80	sstride[n] = array->dim[n + 1].stride;
	81	extent[n] =
	82	array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
80ee04b9 TK	83
	84	if (extent[n] < 0)
	85	extent[n] = 0;
6de9cd9a DN	86	}
6de9cd9a DN	87
6c167c45 VL	88	if (retarray->data == NULL)
6c167c45 VL	89	{
80ee04b9 TK	90	size_t alloc_size;
80ee04b9 TK	91
6c167c45 VL	92	for (n = 0; n < rank; n++)
	93	{
	94	retarray->dim[n].lbound = 0;
	95	retarray->dim[n].ubound = extent[n]-1;
	96	if (n == 0)
	97	retarray->dim[n].stride = 1;
	98	else
	99	retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
	100	}
	101
efd4dc1a	102	retarray->offset = 0;
50dd63a9	103	retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) \| rank;
80ee04b9 TK	104
	105	alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
	106	* extent[rank-1];
	107
	108	if (alloc_size == 0)
	109	{
	110	/* Make sure we have a zero-sized array. */
	111	retarray->dim[0].lbound = 0;
	112	retarray->dim[0].ubound = -1;
	113	return;
	114	}
	115	else
	116	retarray->data = internal_malloc_size (alloc_size);
6c167c45	117	}
50dd63a9 TK	118	else
50dd63a9 TK	119	{
50dd63a9 TK	120	if (rank != GFC_DESCRIPTOR_RANK (retarray))
	121	runtime_error ("rank of return array incorrect");
	122	}
	123
6de9cd9a DN	124	for (n = 0; n < rank; n++)
	125	{
	126	count[n] = 0;
	127	dstride[n] = retarray->dim[n].stride;
	128	if (extent[n] <= 0)
	129	len = 0;
	130	}
	131
	132	base = array->data;
	133	dest = retarray->data;
	134
	135	while (base)
	136	{
64acfd99	137	const GFC_INTEGER_4 * restrict src;
6de9cd9a DN	138	GFC_INTEGER_4 result;
	139	src = base;
	140	{
	141
	142	GFC_INTEGER_4 minval;
	143	minval = GFC_INTEGER_4_HUGE;
a4b9e93e	144	result = 0;
6de9cd9a DN	145	if (len <= 0)
	146	*dest = 0;
	147	else
	148	{
	149	for (n = 0; n < len; n++, src += delta)
	150	{
	151
a4b9e93e	152	if (*src < minval \|\| !result)
6de9cd9a DN	153	{
	154	minval = *src;
	155	result = (GFC_INTEGER_4)n + 1;
	156	}
	157	}
	158	*dest = result;
	159	}
	160	}
	161	/* Advance to the next element. */
	162	count[0]++;
	163	base += sstride[0];
	164	dest += dstride[0];
	165	n = 0;
	166	while (count[n] == extent[n])
	167	{
	168	/* When we get to the end of a dimension, reset it and increment
	169	the next dimension. */
	170	count[n] = 0;
	171	/* We could precalculate these products, but this is a less
5d7adf7a	172	frequently used path so probably not worth it. */
6de9cd9a DN	173	base -= sstride[n] * extent[n];
	174	dest -= dstride[n] * extent[n];
	175	n++;
	176	if (n == rank)
	177	{
	178	/* Break out of the look. */
	179	base = NULL;
	180	break;
	181	}
	182	else
	183	{
	184	count[n]++;
	185	base += sstride[n];
	186	dest += dstride[n];
	187	}
	188	}
	189	}
	190	}
	191
7d7b8bfe	192
64acfd99 JB	193	extern void mminloc1_4_i4 (gfc_array_i4 * const restrict,
	194	gfc_array_i4 * const restrict, const index_type * const restrict,
	195	gfc_array_l4 * const restrict);
7f68c75f	196	export_proto(mminloc1_4_i4);
7d7b8bfe	197
6de9cd9a	198	void
64acfd99 JB	199	mminloc1_4_i4 (gfc_array_i4 * const restrict retarray,
	200	gfc_array_i4 * const restrict array,
	201	const index_type * const restrict pdim,
	202	gfc_array_l4 * const restrict mask)
6de9cd9a	203	{
e33e218b TK	204	index_type count[GFC_MAX_DIMENSIONS];
	205	index_type extent[GFC_MAX_DIMENSIONS];
	206	index_type sstride[GFC_MAX_DIMENSIONS];
	207	index_type dstride[GFC_MAX_DIMENSIONS];
	208	index_type mstride[GFC_MAX_DIMENSIONS];
64acfd99 JB	209	GFC_INTEGER_4 * restrict dest;
	210	const GFC_INTEGER_4 * restrict base;
	211	const GFC_LOGICAL_4 * restrict mbase;
6de9cd9a DN	212	int rank;
	213	int dim;
	214	index_type n;
	215	index_type len;
	216	index_type delta;
	217	index_type mdelta;
	218
	219	dim = (*pdim) - 1;
	220	rank = GFC_DESCRIPTOR_RANK (array) - 1;
e33e218b	221
6de9cd9a DN	222	len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
	223	if (len <= 0)
	224	return;
	225	delta = array->dim[dim].stride;
	226	mdelta = mask->dim[dim].stride;
	227
	228	for (n = 0; n < dim; n++)
	229	{
	230	sstride[n] = array->dim[n].stride;
	231	mstride[n] = mask->dim[n].stride;
	232	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
80ee04b9 TK	233
	234	if (extent[n] < 0)
	235	extent[n] = 0;
	236
6de9cd9a DN	237	}
	238	for (n = dim; n < rank; n++)
	239	{
	240	sstride[n] = array->dim[n + 1].stride;
	241	mstride[n] = mask->dim[n + 1].stride;
	242	extent[n] =
	243	array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
80ee04b9 TK	244
	245	if (extent[n] < 0)
	246	extent[n] = 0;
6de9cd9a DN	247	}
6de9cd9a DN	248
50dd63a9 TK	249	if (retarray->data == NULL)
50dd63a9 TK	250	{
80ee04b9 TK	251	size_t alloc_size;
80ee04b9 TK	252
50dd63a9 TK	253	for (n = 0; n < rank; n++)
	254	{
	255	retarray->dim[n].lbound = 0;
	256	retarray->dim[n].ubound = extent[n]-1;
	257	if (n == 0)
	258	retarray->dim[n].stride = 1;
	259	else
	260	retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
	261	}
	262
80ee04b9 TK	263	alloc_size = sizeof (GFC_INTEGER_4) * retarray->dim[rank-1].stride
	264	* extent[rank-1];
	265
efd4dc1a	266	retarray->offset = 0;
50dd63a9	267	retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) \| rank;
80ee04b9 TK	268
	269	if (alloc_size == 0)
	270	{
	271	/* Make sure we have a zero-sized array. */
	272	retarray->dim[0].lbound = 0;
	273	retarray->dim[0].ubound = -1;
	274	return;
	275	}
	276	else
	277	retarray->data = internal_malloc_size (alloc_size);
	278
50dd63a9 TK	279	}
	280	else
	281	{
50dd63a9 TK	282	if (rank != GFC_DESCRIPTOR_RANK (retarray))
	283	runtime_error ("rank of return array incorrect");
	284	}
	285
6de9cd9a DN	286	for (n = 0; n < rank; n++)
	287	{
	288	count[n] = 0;
	289	dstride[n] = retarray->dim[n].stride;
	290	if (extent[n] <= 0)
	291	return;
	292	}
	293
	294	dest = retarray->data;
	295	base = array->data;
	296	mbase = mask->data;
	297
	298	if (GFC_DESCRIPTOR_SIZE (mask) != 4)
	299	{
	300	/* This allows the same loop to be used for all logical types. */
	301	assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
	302	for (n = 0; n < rank; n++)
	303	mstride[n] <<= 1;
	304	mdelta <<= 1;
	305	mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
	306	}
	307
	308	while (base)
	309	{
64acfd99 JB	310	const GFC_INTEGER_4 * restrict src;
64acfd99 JB	311	const GFC_LOGICAL_4 * restrict msrc;
6de9cd9a DN	312	GFC_INTEGER_4 result;
	313	src = base;
	314	msrc = mbase;
	315	{
	316
	317	GFC_INTEGER_4 minval;
	318	minval = GFC_INTEGER_4_HUGE;
a4b9e93e	319	result = 0;
6de9cd9a DN	320	if (len <= 0)
	321	*dest = 0;
	322	else
	323	{
	324	for (n = 0; n < len; n++, src += delta, msrc += mdelta)
	325	{
	326
a4b9e93e	327	if (msrc && (src < minval \|\| !result))
6de9cd9a DN	328	{
	329	minval = *src;
	330	result = (GFC_INTEGER_4)n + 1;
	331	}
	332	}
	333	*dest = result;
	334	}
	335	}
	336	/* Advance to the next element. */
	337	count[0]++;
	338	base += sstride[0];
	339	mbase += mstride[0];
	340	dest += dstride[0];
	341	n = 0;
	342	while (count[n] == extent[n])
	343	{
	344	/* When we get to the end of a dimension, reset it and increment
	345	the next dimension. */
	346	count[n] = 0;
	347	/* We could precalculate these products, but this is a less
5d7adf7a	348	frequently used path so probably not worth it. */
6de9cd9a DN	349	base -= sstride[n] * extent[n];
	350	mbase -= mstride[n] * extent[n];
	351	dest -= dstride[n] * extent[n];
	352	n++;
	353	if (n == rank)
	354	{
	355	/* Break out of the look. */
	356	base = NULL;
	357	break;
	358	}
	359	else
	360	{
	361	count[n]++;
	362	base += sstride[n];
	363	mbase += mstride[n];
	364	dest += dstride[n];
	365	}
	366	}
	367	}
	368	}
	369
97a62038 TK	370
	371	extern void sminloc1_4_i4 (gfc_array_i4 * const restrict,
	372	gfc_array_i4 * const restrict, const index_type * const restrict,
	373	GFC_LOGICAL_4 *);
	374	export_proto(sminloc1_4_i4);
	375
	376	void
	377	sminloc1_4_i4 (gfc_array_i4 * const restrict retarray,
	378	gfc_array_i4 * const restrict array,
	379	const index_type * const restrict pdim,
	380	GFC_LOGICAL_4 * mask)
	381	{
	382	index_type rank;
	383	index_type n;
	384	index_type dstride;
	385	GFC_INTEGER_4 *dest;
	386
	387	if (*mask)
	388	{
	389	minloc1_4_i4 (retarray, array, pdim);
	390	return;
	391	}
	392	rank = GFC_DESCRIPTOR_RANK (array);
	393	if (rank <= 0)
	394	runtime_error ("Rank of array needs to be > 0");
	395
	396	if (retarray->data == NULL)
	397	{
	398	retarray->dim[0].lbound = 0;
	399	retarray->dim[0].ubound = rank-1;
	400	retarray->dim[0].stride = 1;
	401	retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) \| 1;
	402	retarray->offset = 0;
	403	retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
	404	}
	405	else
	406	{
	407	if (GFC_DESCRIPTOR_RANK (retarray) != 1)
	408	runtime_error ("rank of return array does not equal 1");
	409
	410	if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
	411	runtime_error ("dimension of return array incorrect");
97a62038 TK	412	}
	413
	414	dstride = retarray->dim[0].stride;
	415	dest = retarray->data;
	416
	417	for (n = 0; n < rank; n++)
	418	dest[n * dstride] = 0 ;
	419	}
	420
644cb69f	421	#endif