[thirdparty/gcc.git] / libgfortran / generated / minloc1_16_r8.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 <limits.h>
#include "libgfortran.h"


#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16)


extern void minloc1_16_r8 (gfc_array_i16 * const restrict, 
	gfc_array_r8 * const restrict, const index_type * const restrict);
export_proto(minloc1_16_r8);

void
minloc1_16_r8 (gfc_array_i16 * const restrict retarray, 
	gfc_array_r8 * 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_REAL_8 * restrict base;
  GFC_INTEGER_16 * 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_16) * 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_REAL_8 * restrict src;
      GFC_INTEGER_16 result;
      src = base;
      {

  GFC_REAL_8 minval;
  minval = GFC_REAL_8_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_16)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_16_r8 (gfc_array_i16 * const restrict, 
	gfc_array_r8 * const restrict, const index_type * const restrict,
	gfc_array_l4 * const restrict);
export_proto(mminloc1_16_r8);

void
mminloc1_16_r8 (gfc_array_i16 * const restrict retarray, 
	gfc_array_r8 * 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_16 * restrict dest;
  const GFC_REAL_8 * 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_16) * 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_REAL_8 * restrict src;
      const GFC_LOGICAL_4 * restrict msrc;
      GFC_INTEGER_16 result;
      src = base;
      msrc = mbase;
      {

  GFC_REAL_8 minval;
  minval = GFC_REAL_8_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_16)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_16_r8 (gfc_array_i16 * const restrict, 
	gfc_array_r8 * const restrict, const index_type * const restrict,
	GFC_LOGICAL_4 *);
export_proto(sminloc1_16_r8);

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

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