[thirdparty/gcc.git] / libgfortran / generated / minloc1_8_i16.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_INTEGER_16) && defined (HAVE_GFC_INTEGER_8)


extern void minloc1_8_i16 (gfc_array_i8 * const restrict, 
	gfc_array_i16 * const restrict, const index_type * const restrict);
export_proto(minloc1_8_i16);

void
minloc1_8_i16 (gfc_array_i8 * const restrict retarray, 
	gfc_array_i16 * 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_16 * restrict base;
  GFC_INTEGER_8 * 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_8) * 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_16 * restrict src;
      GFC_INTEGER_8 result;
      src = base;
      {

  GFC_INTEGER_16 minval;
  minval = GFC_INTEGER_16_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_8)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_8_i16 (gfc_array_i8 * const restrict, 
	gfc_array_i16 * const restrict, const index_type * const restrict,
	gfc_array_l1 * const restrict);
export_proto(mminloc1_8_i16);

void
mminloc1_8_i16 (gfc_array_i8 * const restrict retarray, 
	gfc_array_i16 * const restrict array, 
	const index_type * const restrict pdim, 
	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 dstride[GFC_MAX_DIMENSIONS];
  index_type mstride[GFC_MAX_DIMENSIONS];
  GFC_INTEGER_8 * restrict dest;
  const GFC_INTEGER_16 * restrict base;
  const GFC_LOGICAL_1 * restrict mbase;
  int rank;
  int dim;
  index_type n;
  index_type len;
  index_type delta;
  index_type mdelta;
  int mask_kind;

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

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

  mbase = mask->data;

  mask_kind = GFC_DESCRIPTOR_SIZE (mask);

  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");

  delta = array->dim[dim].stride;
  mdelta = mask->dim[dim].stride * mask_kind;

  for (n = 0; n < dim; 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;

      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 * mask_kind;
      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_8) * 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;

  while (base)
    {
      const GFC_INTEGER_16 * restrict src;
      const GFC_LOGICAL_1 * restrict msrc;
      GFC_INTEGER_8 result;
      src = base;
      msrc = mbase;
      {

  GFC_INTEGER_16 minval;
  minval = GFC_INTEGER_16_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_8)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_8_i16 (gfc_array_i8 * const restrict, 
	gfc_array_i16 * const restrict, const index_type * const restrict,
	GFC_LOGICAL_4 *);
export_proto(sminloc1_8_i16);

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

  if (*mask)
    {
      minloc1_8_i16 (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_8) * 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
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_INTEGER_16) && defined (HAVE_GFC_INTEGER_8)
	38
	39
64acfd99 JB	40	extern void minloc1_8_i16 (gfc_array_i8 * const restrict,
64acfd99 JB	41	gfc_array_i16 * const restrict, const index_type * const restrict);
644cb69f FXC	42	export_proto(minloc1_8_i16);
	43
	44	void
64acfd99 JB	45	minloc1_8_i16 (gfc_array_i8 * const restrict retarray,
	46	gfc_array_i16 * const restrict array,
	47	const index_type * const restrict pdim)
644cb69f FXC	48	{
	49	index_type count[GFC_MAX_DIMENSIONS];
	50	index_type extent[GFC_MAX_DIMENSIONS];
	51	index_type sstride[GFC_MAX_DIMENSIONS];
	52	index_type dstride[GFC_MAX_DIMENSIONS];
64acfd99 JB	53	const GFC_INTEGER_16 * restrict base;
64acfd99 JB	54	GFC_INTEGER_8 * restrict dest;
644cb69f FXC	55	index_type rank;
	56	index_type n;
	57	index_type len;
	58	index_type delta;
	59	index_type dim;
	60
	61	/* Make dim zero based to avoid confusion. */
	62	dim = (*pdim) - 1;
	63	rank = GFC_DESCRIPTOR_RANK (array) - 1;
	64
644cb69f FXC	65	len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
	66	delta = array->dim[dim].stride;
	67
	68	for (n = 0; n < dim; n++)
	69	{
	70	sstride[n] = array->dim[n].stride;
	71	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
80ee04b9 TK	72
	73	if (extent[n] < 0)
	74	extent[n] = 0;
644cb69f FXC	75	}
	76	for (n = dim; n < rank; n++)
	77	{
	78	sstride[n] = array->dim[n + 1].stride;
	79	extent[n] =
	80	array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
80ee04b9 TK	81
	82	if (extent[n] < 0)
	83	extent[n] = 0;
644cb69f FXC	84	}
	85
	86	if (retarray->data == NULL)
	87	{
80ee04b9 TK	88	size_t alloc_size;
80ee04b9 TK	89
644cb69f FXC	90	for (n = 0; n < rank; n++)
	91	{
	92	retarray->dim[n].lbound = 0;
	93	retarray->dim[n].ubound = extent[n]-1;
	94	if (n == 0)
	95	retarray->dim[n].stride = 1;
	96	else
	97	retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
	98	}
	99
644cb69f FXC	100	retarray->offset = 0;
644cb69f FXC	101	retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) \| rank;
80ee04b9 TK	102
	103	alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
	104	* extent[rank-1];
	105
	106	if (alloc_size == 0)
	107	{
	108	/* Make sure we have a zero-sized array. */
	109	retarray->dim[0].lbound = 0;
	110	retarray->dim[0].ubound = -1;
	111	return;
	112	}
	113	else
	114	retarray->data = internal_malloc_size (alloc_size);
644cb69f FXC	115	}
	116	else
	117	{
644cb69f FXC	118	if (rank != GFC_DESCRIPTOR_RANK (retarray))
	119	runtime_error ("rank of return array incorrect");
	120	}
	121
	122	for (n = 0; n < rank; n++)
	123	{
	124	count[n] = 0;
	125	dstride[n] = retarray->dim[n].stride;
	126	if (extent[n] <= 0)
	127	len = 0;
	128	}
	129
	130	base = array->data;
	131	dest = retarray->data;
	132
	133	while (base)
	134	{
64acfd99	135	const GFC_INTEGER_16 * restrict src;
644cb69f FXC	136	GFC_INTEGER_8 result;
	137	src = base;
	138	{
	139
	140	GFC_INTEGER_16 minval;
	141	minval = GFC_INTEGER_16_HUGE;
a4b9e93e	142	result = 0;
644cb69f FXC	143	if (len <= 0)
	144	*dest = 0;
	145	else
	146	{
	147	for (n = 0; n < len; n++, src += delta)
	148	{
	149
a4b9e93e	150	if (*src < minval \|\| !result)
644cb69f FXC	151	{
	152	minval = *src;
	153	result = (GFC_INTEGER_8)n + 1;
	154	}
	155	}
	156	*dest = result;
	157	}
	158	}
	159	/* Advance to the next element. */
	160	count[0]++;
	161	base += sstride[0];
	162	dest += dstride[0];
	163	n = 0;
	164	while (count[n] == extent[n])
	165	{
	166	/* When we get to the end of a dimension, reset it and increment
	167	the next dimension. */
	168	count[n] = 0;
	169	/* We could precalculate these products, but this is a less
5d7adf7a	170	frequently used path so probably not worth it. */
644cb69f FXC	171	base -= sstride[n] * extent[n];
	172	dest -= dstride[n] * extent[n];
	173	n++;
	174	if (n == rank)
	175	{
	176	/* Break out of the look. */
	177	base = NULL;
	178	break;
	179	}
	180	else
	181	{
	182	count[n]++;
	183	base += sstride[n];
	184	dest += dstride[n];
	185	}
	186	}
	187	}
	188	}
	189
	190
64acfd99 JB	191	extern void mminloc1_8_i16 (gfc_array_i8 * const restrict,
64acfd99 JB	192	gfc_array_i16 * const restrict, const index_type * const restrict,
28dc6b33	193	gfc_array_l1 * const restrict);
644cb69f FXC	194	export_proto(mminloc1_8_i16);
	195
	196	void
64acfd99 JB	197	mminloc1_8_i16 (gfc_array_i8 * const restrict retarray,
	198	gfc_array_i16 * const restrict array,
	199	const index_type * const restrict pdim,
28dc6b33	200	gfc_array_l1 * const restrict mask)
644cb69f FXC	201	{
	202	index_type count[GFC_MAX_DIMENSIONS];
	203	index_type extent[GFC_MAX_DIMENSIONS];
	204	index_type sstride[GFC_MAX_DIMENSIONS];
	205	index_type dstride[GFC_MAX_DIMENSIONS];
	206	index_type mstride[GFC_MAX_DIMENSIONS];
64acfd99 JB	207	GFC_INTEGER_8 * restrict dest;
64acfd99 JB	208	const GFC_INTEGER_16 * restrict base;
28dc6b33	209	const GFC_LOGICAL_1 * restrict mbase;
644cb69f FXC	210	int rank;
	211	int dim;
	212	index_type n;
	213	index_type len;
	214	index_type delta;
	215	index_type mdelta;
28dc6b33	216	int mask_kind;
644cb69f FXC	217
	218	dim = (*pdim) - 1;
	219	rank = GFC_DESCRIPTOR_RANK (array) - 1;
	220
644cb69f FXC	221	len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
	222	if (len <= 0)
	223	return;
28dc6b33 TK	224
	225	mbase = mask->data;
	226
	227	mask_kind = GFC_DESCRIPTOR_SIZE (mask);
	228
	229	if (mask_kind == 1 \|\| mask_kind == 2 \|\| mask_kind == 4 \|\| mask_kind == 8
	230	#ifdef HAVE_GFC_LOGICAL_16
	231	\|\| mask_kind == 16
	232	#endif
	233	)
	234	mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
	235	else
	236	runtime_error ("Funny sized logical array");
	237
644cb69f	238	delta = array->dim[dim].stride;
28dc6b33	239	mdelta = mask->dim[dim].stride * mask_kind;
644cb69f FXC	240
	241	for (n = 0; n < dim; n++)
	242	{
	243	sstride[n] = array->dim[n].stride;
28dc6b33	244	mstride[n] = mask->dim[n].stride * mask_kind;
644cb69f	245	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
80ee04b9 TK	246
	247	if (extent[n] < 0)
	248	extent[n] = 0;
	249
644cb69f FXC	250	}
	251	for (n = dim; n < rank; n++)
	252	{
	253	sstride[n] = array->dim[n + 1].stride;
28dc6b33	254	mstride[n] = mask->dim[n + 1].stride * mask_kind;
644cb69f FXC	255	extent[n] =
644cb69f FXC	256	array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
80ee04b9 TK	257
	258	if (extent[n] < 0)
	259	extent[n] = 0;
644cb69f FXC	260	}
	261
	262	if (retarray->data == NULL)
	263	{
80ee04b9 TK	264	size_t alloc_size;
80ee04b9 TK	265
644cb69f FXC	266	for (n = 0; n < rank; n++)
	267	{
	268	retarray->dim[n].lbound = 0;
	269	retarray->dim[n].ubound = extent[n]-1;
	270	if (n == 0)
	271	retarray->dim[n].stride = 1;
	272	else
	273	retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
	274	}
	275
80ee04b9 TK	276	alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
	277	* extent[rank-1];
	278
644cb69f FXC	279	retarray->offset = 0;
644cb69f FXC	280	retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) \| rank;
80ee04b9 TK	281
	282	if (alloc_size == 0)
	283	{
	284	/* Make sure we have a zero-sized array. */
	285	retarray->dim[0].lbound = 0;
	286	retarray->dim[0].ubound = -1;
	287	return;
	288	}
	289	else
	290	retarray->data = internal_malloc_size (alloc_size);
	291
644cb69f FXC	292	}
	293	else
	294	{
644cb69f FXC	295	if (rank != GFC_DESCRIPTOR_RANK (retarray))
	296	runtime_error ("rank of return array incorrect");
	297	}
	298
	299	for (n = 0; n < rank; n++)
	300	{
	301	count[n] = 0;
	302	dstride[n] = retarray->dim[n].stride;
	303	if (extent[n] <= 0)
	304	return;
	305	}
	306
	307	dest = retarray->data;
	308	base = array->data;
644cb69f FXC	309
	310	while (base)
	311	{
64acfd99	312	const GFC_INTEGER_16 * restrict src;
28dc6b33	313	const GFC_LOGICAL_1 * restrict msrc;
644cb69f FXC	314	GFC_INTEGER_8 result;
	315	src = base;
	316	msrc = mbase;
	317	{
	318
	319	GFC_INTEGER_16 minval;
	320	minval = GFC_INTEGER_16_HUGE;
a4b9e93e	321	result = 0;
644cb69f FXC	322	if (len <= 0)
	323	*dest = 0;
	324	else
	325	{
	326	for (n = 0; n < len; n++, src += delta, msrc += mdelta)
	327	{
	328
a4b9e93e	329	if (msrc && (src < minval \|\| !result))
644cb69f FXC	330	{
	331	minval = *src;
	332	result = (GFC_INTEGER_8)n + 1;
	333	}
	334	}
	335	*dest = result;
	336	}
	337	}
	338	/* Advance to the next element. */
	339	count[0]++;
	340	base += sstride[0];
	341	mbase += mstride[0];
	342	dest += dstride[0];
	343	n = 0;
	344	while (count[n] == extent[n])
	345	{
	346	/* When we get to the end of a dimension, reset it and increment
	347	the next dimension. */
	348	count[n] = 0;
	349	/* We could precalculate these products, but this is a less
5d7adf7a	350	frequently used path so probably not worth it. */
644cb69f FXC	351	base -= sstride[n] * extent[n];
	352	mbase -= mstride[n] * extent[n];
	353	dest -= dstride[n] * extent[n];
	354	n++;
	355	if (n == rank)
	356	{
	357	/* Break out of the look. */
	358	base = NULL;
	359	break;
	360	}
	361	else
	362	{
	363	count[n]++;
	364	base += sstride[n];
	365	mbase += mstride[n];
	366	dest += dstride[n];
	367	}
	368	}
	369	}
	370	}
	371
97a62038 TK	372
	373	extern void sminloc1_8_i16 (gfc_array_i8 * const restrict,
	374	gfc_array_i16 * const restrict, const index_type * const restrict,
	375	GFC_LOGICAL_4 *);
	376	export_proto(sminloc1_8_i16);
	377
	378	void
	379	sminloc1_8_i16 (gfc_array_i8 * const restrict retarray,
	380	gfc_array_i16 * const restrict array,
	381	const index_type * const restrict pdim,
	382	GFC_LOGICAL_4 * mask)
	383	{
	384	index_type rank;
	385	index_type n;
	386	index_type dstride;
	387	GFC_INTEGER_8 *dest;
	388
	389	if (*mask)
	390	{
	391	minloc1_8_i16 (retarray, array, pdim);
	392	return;
	393	}
	394	rank = GFC_DESCRIPTOR_RANK (array);
	395	if (rank <= 0)
	396	runtime_error ("Rank of array needs to be > 0");
	397
	398	if (retarray->data == NULL)
	399	{
	400	retarray->dim[0].lbound = 0;
	401	retarray->dim[0].ubound = rank-1;
	402	retarray->dim[0].stride = 1;
	403	retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) \| 1;
	404	retarray->offset = 0;
	405	retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
	406	}
	407	else
	408	{
	409	if (GFC_DESCRIPTOR_RANK (retarray) != 1)
	410	runtime_error ("rank of return array does not equal 1");
	411
	412	if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
	413	runtime_error ("dimension of return array incorrect");
97a62038 TK	414	}
	415
	416	dstride = retarray->dim[0].stride;
	417	dest = retarray->data;
	418
	419	for (n = 0; n < rank; n++)
	420	dest[n * dstride] = 0 ;
	421	}
	422
644cb69f	423	#endif