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


extern void minloc1_8_i2 (gfc_array_i8 * const restrict, 
	gfc_array_i2 * const restrict, const index_type * const restrict);
export_proto(minloc1_8_i2);

void
minloc1_8_i2 (gfc_array_i8 * const restrict retarray, 
	gfc_array_i2 * 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_2 * 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_2 * restrict src;
      GFC_INTEGER_8 result;
      src = base;
      {

  GFC_INTEGER_2 minval;
  minval = GFC_INTEGER_2_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_i2 (gfc_array_i8 * const restrict, 
	gfc_array_i2 * const restrict, const index_type * const restrict,
	gfc_array_l1 * const restrict);
export_proto(mminloc1_8_i2);

void
mminloc1_8_i2 (gfc_array_i8 * const restrict retarray, 
	gfc_array_i2 * 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_2 * 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_2 * restrict src;
      const GFC_LOGICAL_1 * restrict msrc;
      GFC_INTEGER_8 result;
      src = base;
      msrc = mbase;
      {

  GFC_INTEGER_2 minval;
  minval = GFC_INTEGER_2_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_i2 (gfc_array_i8 * const restrict, 
	gfc_array_i2 * const restrict, const index_type * const restrict,
	GFC_LOGICAL_4 *);
export_proto(sminloc1_8_i2);

void
sminloc1_8_i2 (gfc_array_i8 * const restrict retarray, 
	gfc_array_i2 * 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_i2 (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
567c915b	1	/* Implementation of the MINLOC intrinsic
36ae8a61	2	Copyright 2002, 2007 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
	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"
567c915b TK	32	#include <stdlib.h>
567c915b TK	33	#include <assert.h>
567c915b	34	#include <limits.h>
567c915b TK	35
	36
	37	#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_8)
	38
	39
	40	extern void minloc1_8_i2 (gfc_array_i8 * const restrict,
	41	gfc_array_i2 * const restrict, const index_type * const restrict);
	42	export_proto(minloc1_8_i2);
	43
	44	void
	45	minloc1_8_i2 (gfc_array_i8 * const restrict retarray,
	46	gfc_array_i2 * const restrict array,
	47	const index_type * const restrict pdim)
	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];
	53	const GFC_INTEGER_2 * restrict base;
	54	GFC_INTEGER_8 * restrict dest;
	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
	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;
	72
	73	if (extent[n] < 0)
	74	extent[n] = 0;
	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;
	81
	82	if (extent[n] < 0)
	83	extent[n] = 0;
	84	}
	85
	86	if (retarray->data == NULL)
	87	{
	88	size_t alloc_size;
	89
	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
100	retarray->offset = 0;
101	retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) \| rank;
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);
115	}
116	else
117	{
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	{
135	const GFC_INTEGER_2 * restrict src;
136	GFC_INTEGER_8 result;
137	src = base;
138	{
139
140	GFC_INTEGER_2 minval;
141	minval = GFC_INTEGER_2_HUGE;
142	result = 0;
143	if (len <= 0)
144	*dest = 0;
145	else
146	{
147	for (n = 0; n < len; n++, src += delta)
148	{
149
150	if (*src < minval \|\| !result)
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
170	frequently used path so probably not worth it. */
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
191	extern void mminloc1_8_i2 (gfc_array_i8 * const restrict,
192	gfc_array_i2 * const restrict, const index_type * const restrict,
28dc6b33	193	gfc_array_l1 * const restrict);
567c915b TK	194	export_proto(mminloc1_8_i2);
	195
	196	void
	197	mminloc1_8_i2 (gfc_array_i8 * const restrict retarray,
	198	gfc_array_i2 * const restrict array,
	199	const index_type * const restrict pdim,
28dc6b33	200	gfc_array_l1 * const restrict mask)
567c915b TK	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];
	207	GFC_INTEGER_8 * restrict dest;
	208	const GFC_INTEGER_2 * restrict base;
28dc6b33	209	const GFC_LOGICAL_1 * restrict mbase;
567c915b TK	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;
567c915b TK	217
	218	dim = (*pdim) - 1;
	219	rank = GFC_DESCRIPTOR_RANK (array) - 1;
	220
	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
567c915b	238	delta = array->dim[dim].stride;
28dc6b33	239	mdelta = mask->dim[dim].stride * mask_kind;
567c915b TK	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;
567c915b TK	245	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
	246
	247	if (extent[n] < 0)
	248	extent[n] = 0;
	249
	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;
567c915b TK	255	extent[n] =
	256	array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
	257
	258	if (extent[n] < 0)
	259	extent[n] = 0;
	260	}
	261
	262	if (retarray->data == NULL)
	263	{
	264	size_t alloc_size;
	265
	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
	276	alloc_size = sizeof (GFC_INTEGER_8) * retarray->dim[rank-1].stride
	277	* extent[rank-1];
	278
	279	retarray->offset = 0;
	280	retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) \| rank;
	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
	292	}
	293	else
	294	{
	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;
567c915b TK	309
	310	while (base)
	311	{
	312	const GFC_INTEGER_2 * restrict src;
28dc6b33	313	const GFC_LOGICAL_1 * restrict msrc;
567c915b TK	314	GFC_INTEGER_8 result;
	315	src = base;
	316	msrc = mbase;
	317	{
	318
	319	GFC_INTEGER_2 minval;
	320	minval = GFC_INTEGER_2_HUGE;
	321	result = 0;
	322	if (len <= 0)
	323	*dest = 0;
	324	else
	325	{
	326	for (n = 0; n < len; n++, src += delta, msrc += mdelta)
	327	{
	328
	329	if (msrc && (src < minval \|\| !result))
	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
	350	frequently used path so probably not worth it. */
	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
	372
	373	extern void sminloc1_8_i2 (gfc_array_i8 * const restrict,
	374	gfc_array_i2 * const restrict, const index_type * const restrict,
	375	GFC_LOGICAL_4 *);
	376	export_proto(sminloc1_8_i2);
	377
378	void
379	sminloc1_8_i2 (gfc_array_i8 * const restrict retarray,
380	gfc_array_i2 * 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_i2 (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");
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
423	#endif