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


/* Implementation of the FINDLOC intrinsic
   Copyright (C) 2018-2024 Free Software Foundation, Inc.
   Contributed by Thomas König <tk@tkoenig.net>

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 3 of the License, or (at your option) any later version.

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.

Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.

You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
<http://www.gnu.org/licenses/>.  */

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

#if defined (HAVE_GFC_UINTEGER_4)
extern void findloc0_s4 (gfc_array_index_type * const restrict retarray,
       	    		gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *value,
			 GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value);

export_proto(findloc0_s4);

void
findloc0_s4 (gfc_array_index_type * const restrict retarray,
    	    gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *value,
	    GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type dstride;
  const GFC_UINTEGER_4 *base;
  index_type * restrict dest;
  index_type rank;
  index_type n;
  index_type sz;

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

  if (retarray->base_addr == NULL)
    {
      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
      retarray->dtype.rank = 1;
      retarray->offset = 0;
      retarray->base_addr = xmallocarray (rank, sizeof (index_type));
    }
  else
    {
      if (unlikely (compile_options.bounds_check))
	bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
				"FINDLOC");
    }

  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
  dest = retarray->base_addr;

  /* Set the return value.  */
  for (n = 0; n < rank; n++)
    dest[n * dstride] = 0;

  sz = 1;
  for (n = 0; n < rank; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
      sz *= extent[n];
      if (extent[n] <= 0)
	return;
    }

    for (n = 0; n < rank; n++)
      count[n] = 0;

  if (back)
    {
      base = array->base_addr + (sz - 1) * len_array;

      while (1)
        {
	  do
	    {
	      if (unlikely(compare_string_char4 (len_array, base, len_value, value) == 0))
	        {
		  for (n = 0; n < rank; n++)
		    dest[n * dstride] = extent[n] - count[n];

		  return;
		}
	      base -= sstride[0] * len_array;
	    } while(++count[0] != extent[0]);

	  n = 0;
	  do
	    {
	      /* 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] * len_array;
	      n++;
	      if (n >= rank)
	        return;
	      else
		{
		  count[n]++;
		  base -= sstride[n] * len_array;
		}
	    } while (count[n] == extent[n]);      
	}
    }
  else
    {
      base = array->base_addr;
      while (1)
        {
	  do
	    {
	      if (unlikely(compare_string_char4 (len_array, base, len_value, value) == 0))
	        {
		  for (n = 0; n < rank; n++)
		    dest[n * dstride] = count[n] + 1;

		  return;
		}
	      base += sstride[0] * len_array;
	    } while(++count[0] != extent[0]);

	  n = 0;
	  do
	    {
	      /* 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] * len_array;
	      n++;
	      if (n >= rank)
	        return;
	      else
		{
		  count[n]++;
		  base += sstride[n] * len_array;
		}
	    } while (count[n] == extent[n]);
	}
    }
  return;
}

extern void mfindloc0_s4 (gfc_array_index_type * const restrict retarray,
       	    		gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *value,
			 gfc_array_l1 *const restrict, GFC_LOGICAL_4 back, gfc_charlen_type len_array,
			 gfc_charlen_type len_value);
export_proto(mfindloc0_s4);

void
mfindloc0_s4 (gfc_array_index_type * const restrict retarray,
    	    gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *value,
	    gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back,
	    gfc_charlen_type len_array, gfc_charlen_type len_value)
{
  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;
  const GFC_UINTEGER_4 *base;
  index_type * restrict dest;
  GFC_LOGICAL_1 *mbase;
  index_type rank;
  index_type n;
  int mask_kind;
  index_type sz;

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

  if (retarray->base_addr == NULL)
    {
      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
      retarray->dtype.rank = 1;
      retarray->offset = 0;
      retarray->base_addr = xmallocarray (rank, sizeof (index_type));
    }
  else
    {
      if (unlikely (compile_options.bounds_check))
	{
	  bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
				  "FINDLOC");
	  bounds_equal_extents ((array_t *) mask, (array_t *) array,
				"MASK argument", "FINDLOC");
	}
    }

  mask_kind = GFC_DESCRIPTOR_SIZE (mask);

  mbase = mask->base_addr;

  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
    internal_error (NULL, "Funny sized logical array");

  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
  dest = retarray->base_addr;

  /* Set the return value.  */
  for (n = 0; n < rank; n++)
    dest[n * dstride] = 0;

  sz = 1;
  for (n = 0; n < rank; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
      sz *= extent[n];
      if (extent[n] <= 0)
	return;
    }

    for (n = 0; n < rank; n++)
      count[n] = 0;

  if (back)
    {
      base = array->base_addr + (sz - 1) * len_array;
      mbase = mbase + (sz - 1) * mask_kind;
      while (1)
        {
	  do
	    {
	      if (unlikely(*mbase && compare_string_char4 (len_array, base, len_value, value) == 0))
	        {
		  for (n = 0; n < rank; n++)
		    dest[n * dstride] = extent[n] - count[n];

		  return;
		}
	      base -= sstride[0] * len_array;
	      mbase -= mstride[0];
	    } while(++count[0] != extent[0]);

	  n = 0;
	  do
	    {
	      /* 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] * len_array;
	      mbase -= mstride[n] * extent[n];
	      n++;
	      if (n >= rank)
		return;
	      else
		{
		  count[n]++;
		  base -= sstride[n] * len_array;
		  mbase += mstride[n];
		}
	    } while (count[n] == extent[n]);      
	}
    }
  else
    {
      base = array->base_addr;
      while (1)
        {
	  do
	    {
	      if (unlikely(*mbase && compare_string_char4 (len_array, base, len_value, value) == 0))
	        {
		  for (n = 0; n < rank; n++)
		    dest[n * dstride] = count[n] + 1;

		  return;
		}
	      base += sstride[0] * len_array;
	      mbase += mstride[0];
	    } while(++count[0] != extent[0]);

	  n = 0;
	  do
	    {
	      /* 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] * len_array;
	      mbase -= mstride[n] * extent[n];
	      n++;
	      if (n >= rank)
		return;
	      else
		{
		  count[n]++;
		  base += sstride[n]* len_array;
		  mbase += mstride[n];
		}
	    } while (count[n] == extent[n]);
	}
    }
  return;
}

extern void sfindloc0_s4 (gfc_array_index_type * const restrict retarray,
       	    		gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *value,
			 GFC_LOGICAL_4 *, GFC_LOGICAL_4 back, gfc_charlen_type len_array,
			 gfc_charlen_type len_value);
export_proto(sfindloc0_s4);

void
sfindloc0_s4 (gfc_array_index_type * const restrict retarray,
    	    gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *value,
	    GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back, gfc_charlen_type len_array,
	    gfc_charlen_type len_value)
{
  index_type rank;
  index_type dstride;
  index_type * restrict dest;
  index_type n;

  if (mask == NULL || *mask)
    {
      findloc0_s4 (retarray, array, value, back, len_array, len_value);
      return;
    }

  rank = GFC_DESCRIPTOR_RANK (array);

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

  if (retarray->base_addr == NULL)
    {
      GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
      retarray->dtype.rank = 1;
      retarray->offset = 0;
      retarray->base_addr = xmallocarray (rank, sizeof (index_type));
    }
  else if (unlikely (compile_options.bounds_check))
    {
       bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
			       "FINDLOC");
    }

  dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
  dest = retarray->base_addr;
  for (n = 0; n<rank; n++)
    dest[n * dstride] = 0 ;
}

#endif
Commit	Line	Data
01ce9e31 TK	1
01ce9e31 TK	2	/* Implementation of the FINDLOC intrinsic
a945c346	3	Copyright (C) 2018-2024 Free Software Foundation, Inc.
01ce9e31 TK	4	Contributed by Thomas König <tk@tkoenig.net>
	5
	6	This file is part of the GNU Fortran 95 runtime library (libgfortran).
	7
	8	Libgfortran is free software; you can redistribute it and/or
	9	modify it under the terms of the GNU General Public
	10	License as published by the Free Software Foundation; either
	11	version 3 of the License, or (at your option) any later version.
	12
	13	Libgfortran is distributed in the hope that it will be useful,
	14	but WITHOUT ANY WARRANTY; without even the implied warranty of
	15	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	16	GNU General Public License for more details.
	17
	18	Under Section 7 of GPL version 3, you are granted additional
	19	permissions described in the GCC Runtime Library Exception, version
	20	3.1, as published by the Free Software Foundation.
	21
	22	You should have received a copy of the GNU General Public License and
	23	a copy of the GCC Runtime Library Exception along with this program;
	24	see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
	25	<http://www.gnu.org/licenses/>. */
	26
	27	#include "libgfortran.h"
	28	#include <assert.h>
	29
	30	#if defined (HAVE_GFC_UINTEGER_4)
	31	extern void findloc0_s4 (gfc_array_index_type * const restrict retarray,
	32	gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *value,
	33	GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value);
	34
	35	export_proto(findloc0_s4);
	36
	37	void
	38	findloc0_s4 (gfc_array_index_type * const restrict retarray,
	39	gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *value,
	40	GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value)
	41	{
	42	index_type count[GFC_MAX_DIMENSIONS];
	43	index_type extent[GFC_MAX_DIMENSIONS];
	44	index_type sstride[GFC_MAX_DIMENSIONS];
	45	index_type dstride;
	46	const GFC_UINTEGER_4 *base;
	47	index_type * restrict dest;
	48	index_type rank;
	49	index_type n;
	50	index_type sz;
	51
	52	rank = GFC_DESCRIPTOR_RANK (array);
	53	if (rank <= 0)
	54	runtime_error ("Rank of array needs to be > 0");
	55
	56	if (retarray->base_addr == NULL)
	57	{
	58	GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
	59	retarray->dtype.rank = 1;
	60	retarray->offset = 0;
2ea47ee9	61	retarray->base_addr = xmallocarray (rank, sizeof (index_type));
01ce9e31 TK	62	}
	63	else
	64	{
	65	if (unlikely (compile_options.bounds_check))
	66	bounds_iforeach_return ((array_t ) retarray, (array_t ) array,
	67	"FINDLOC");
	68	}
	69
	70	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
	71	dest = retarray->base_addr;
	72
	73	/* Set the return value. */
	74	for (n = 0; n < rank; n++)
	75	dest[n * dstride] = 0;
	76
	77	sz = 1;
	78	for (n = 0; n < rank; n++)
	79	{
	80	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
	81	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
	82	sz *= extent[n];
	83	if (extent[n] <= 0)
	84	return;
	85	}
	86
	87	for (n = 0; n < rank; n++)
	88	count[n] = 0;
	89
	90	if (back)
	91	{
	92	base = array->base_addr + (sz - 1) * len_array;
	93
	94	while (1)
	95	{
	96	do
	97	{
	98	if (unlikely(compare_string_char4 (len_array, base, len_value, value) == 0))
	99	{
	100	for (n = 0; n < rank; n++)
	101	dest[n * dstride] = extent[n] - count[n];
	102
	103	return;
	104	}
	105	base -= sstride[0] * len_array;
	106	} while(++count[0] != extent[0]);
	107
	108	n = 0;
	109	do
	110	{
	111	/* When we get to the end of a dimension, reset it and increment
	112	the next dimension. */
	113	count[n] = 0;
	114	/* We could precalculate these products, but this is a less
	115	frequently used path so probably not worth it. */
	116	base += sstride[n] * extent[n] * len_array;
	117	n++;
	118	if (n >= rank)
	119	return;
	120	else
	121	{
	122	count[n]++;
	123	base -= sstride[n] * len_array;
	124	}
	125	} while (count[n] == extent[n]);
126	}
127	}
128	else
129	{
130	base = array->base_addr;
131	while (1)
132	{
133	do
134	{
135	if (unlikely(compare_string_char4 (len_array, base, len_value, value) == 0))
136	{
137	for (n = 0; n < rank; n++)
138	dest[n * dstride] = count[n] + 1;
139
140	return;
141	}
142	base += sstride[0] * len_array;
143	} while(++count[0] != extent[0]);
144
145	n = 0;
146	do
147	{
148	/* When we get to the end of a dimension, reset it and increment
149	the next dimension. */
150	count[n] = 0;
151	/* We could precalculate these products, but this is a less
152	frequently used path so probably not worth it. */
153	base -= sstride[n] * extent[n] * len_array;
154	n++;
155	if (n >= rank)
156	return;
157	else
158	{
159	count[n]++;
160	base += sstride[n] * len_array;
161	}
162	} while (count[n] == extent[n]);
163	}
164	}
165	return;
166	}
167
168	extern void mfindloc0_s4 (gfc_array_index_type * const restrict retarray,
169	gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *value,
170	gfc_array_l1 *const restrict, GFC_LOGICAL_4 back, gfc_charlen_type len_array,
171	gfc_charlen_type len_value);
172	export_proto(mfindloc0_s4);
173
174	void
175	mfindloc0_s4 (gfc_array_index_type * const restrict retarray,
176	gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *value,
177	gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back,
178	gfc_charlen_type len_array, gfc_charlen_type len_value)
179	{
180	index_type count[GFC_MAX_DIMENSIONS];
181	index_type extent[GFC_MAX_DIMENSIONS];
182	index_type sstride[GFC_MAX_DIMENSIONS];
183	index_type mstride[GFC_MAX_DIMENSIONS];
184	index_type dstride;
185	const GFC_UINTEGER_4 *base;
186	index_type * restrict dest;
187	GFC_LOGICAL_1 *mbase;
188	index_type rank;
189	index_type n;
190	int mask_kind;
191	index_type sz;
192
193	rank = GFC_DESCRIPTOR_RANK (array);
194	if (rank <= 0)
195	runtime_error ("Rank of array needs to be > 0");
196
197	if (retarray->base_addr == NULL)
198	{
199	GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
200	retarray->dtype.rank = 1;
201	retarray->offset = 0;
2ea47ee9	202	retarray->base_addr = xmallocarray (rank, sizeof (index_type));
01ce9e31 TK	203	}
	204	else
	205	{
	206	if (unlikely (compile_options.bounds_check))
	207	{
	208	bounds_iforeach_return ((array_t ) retarray, (array_t ) array,
	209	"FINDLOC");
	210	bounds_equal_extents ((array_t ) mask, (array_t ) array,
	211	"MASK argument", "FINDLOC");
	212	}
	213	}
	214
	215	mask_kind = GFC_DESCRIPTOR_SIZE (mask);
	216
	217	mbase = mask->base_addr;
	218
	219	if (mask_kind == 1 \|\| mask_kind == 2 \|\| mask_kind == 4 \|\| mask_kind == 8
	220	#ifdef HAVE_GFC_LOGICAL_16
	221	\|\| mask_kind == 16
	222	#endif
	223	)
	224	mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
	225	else
	226	internal_error (NULL, "Funny sized logical array");
	227
	228	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
	229	dest = retarray->base_addr;
	230
	231	/* Set the return value. */
	232	for (n = 0; n < rank; n++)
	233	dest[n * dstride] = 0;
	234
	235	sz = 1;
	236	for (n = 0; n < rank; n++)
	237	{
	238	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
	239	mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
	240	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
	241	sz *= extent[n];
	242	if (extent[n] <= 0)
	243	return;
	244	}
	245
	246	for (n = 0; n < rank; n++)
	247	count[n] = 0;
	248
	249	if (back)
	250	{
	251	base = array->base_addr + (sz - 1) * len_array;
	252	mbase = mbase + (sz - 1) * mask_kind;
	253	while (1)
	254	{
	255	do
	256	{
	257	if (unlikely(*mbase && compare_string_char4 (len_array, base, len_value, value) == 0))
	258	{
	259	for (n = 0; n < rank; n++)
	260	dest[n * dstride] = extent[n] - count[n];
	261
	262	return;
	263	}
	264	base -= sstride[0] * len_array;
	265	mbase -= mstride[0];
	266	} while(++count[0] != extent[0]);
267
268	n = 0;
269	do
270	{
271	/* When we get to the end of a dimension, reset it and increment
272	the next dimension. */
273	count[n] = 0;
274	/* We could precalculate these products, but this is a less
275	frequently used path so probably not worth it. */
276	base += sstride[n] * extent[n] * len_array;
277	mbase -= mstride[n] * extent[n];
278	n++;
279	if (n >= rank)
280	return;
281	else
282	{
283	count[n]++;
284	base -= sstride[n] * len_array;
285	mbase += mstride[n];
286	}
287	} while (count[n] == extent[n]);
288	}
289	}
290	else
291	{
292	base = array->base_addr;
293	while (1)
294	{
295	do
296	{
297	if (unlikely(*mbase && compare_string_char4 (len_array, base, len_value, value) == 0))
298	{
299	for (n = 0; n < rank; n++)
300	dest[n * dstride] = count[n] + 1;
301
302	return;
303	}
304	base += sstride[0] * len_array;
305	mbase += mstride[0];
306	} while(++count[0] != extent[0]);
307
308	n = 0;
309	do
310	{
311	/* When we get to the end of a dimension, reset it and increment
312	the next dimension. */
313	count[n] = 0;
314	/* We could precalculate these products, but this is a less
315	frequently used path so probably not worth it. */
316	base -= sstride[n] * extent[n] * len_array;
317	mbase -= mstride[n] * extent[n];
318	n++;
319	if (n >= rank)
320	return;
321	else
322	{
323	count[n]++;
324	base += sstride[n]* len_array;
325	mbase += mstride[n];
326	}
327	} while (count[n] == extent[n]);
328	}
329	}
330	return;
331	}
332
333	extern void sfindloc0_s4 (gfc_array_index_type * const restrict retarray,
334	gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *value,
335	GFC_LOGICAL_4 *, GFC_LOGICAL_4 back, gfc_charlen_type len_array,
336	gfc_charlen_type len_value);
337	export_proto(sfindloc0_s4);
338
339	void
340	sfindloc0_s4 (gfc_array_index_type * const restrict retarray,
341	gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *value,
342	GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back, gfc_charlen_type len_array,
343	gfc_charlen_type len_value)
344	{
345	index_type rank;
346	index_type dstride;
347	index_type * restrict dest;
348	index_type n;
349
2ea47ee9	350	if (mask == NULL \|\| *mask)
01ce9e31 TK	351	{
	352	findloc0_s4 (retarray, array, value, back, len_array, len_value);
	353	return;
	354	}
	355
	356	rank = GFC_DESCRIPTOR_RANK (array);
	357
	358	if (rank <= 0)
	359	internal_error (NULL, "Rank of array needs to be > 0");
	360
	361	if (retarray->base_addr == NULL)
	362	{
	363	GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
	364	retarray->dtype.rank = 1;
	365	retarray->offset = 0;
2ea47ee9	366	retarray->base_addr = xmallocarray (rank, sizeof (index_type));
01ce9e31 TK	367	}
	368	else if (unlikely (compile_options.bounds_check))
	369	{
	370	bounds_iforeach_return ((array_t ) retarray, (array_t ) array,
	371	"FINDLOC");
	372	}
	373
	374	dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
	375	dest = retarray->base_addr;
	376	for (n = 0; n<rank; n++)
	377	dest[n * dstride] = 0 ;
	378	}
	379
	380	#endif
	381
	382
	383