[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 (libgfor).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 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 Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with libgfor; see the file COPYING.LIB.  If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

#include "config.h"
#include <stdlib.h>
#include <assert.h>
#include <float.h>
#include <limits.h>
#include "libgfortran.h"

void
__minloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array, index_type *pdim)
{
  index_type count[GFC_MAX_DIMENSIONS - 1];
  index_type extent[GFC_MAX_DIMENSIONS - 1];
  index_type sstride[GFC_MAX_DIMENSIONS - 1];
  index_type dstride[GFC_MAX_DIMENSIONS - 1];
  GFC_INTEGER_4 *base;
  GFC_INTEGER_4 *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;
  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
  if (array->dim[0].stride == 0)
    array->dim[0].stride = 1;
  if (retarray->dim[0].stride == 0)
    retarray->dim[0].stride = 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;
    }
  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 (retarray->data == NULL)
    {
      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->data = internal_malloc (sizeof (GFC_INTEGER_4) * 
                                        (retarray->dim[rank-1].stride * extent[rank-1]));
      retarray->base = 0;
    }
          
  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)
    {
      GFC_INTEGER_4 *src;
      GFC_INTEGER_4 result;
      src = base;
      {

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

  if (*src < minval)
    {
      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 proabably 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];
            }
        }
    }
}

void
__mminloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, index_type *pdim, gfc_array_l4 * mask)
{
  index_type count[GFC_MAX_DIMENSIONS - 1];
  index_type extent[GFC_MAX_DIMENSIONS - 1];
  index_type sstride[GFC_MAX_DIMENSIONS - 1];
  index_type dstride[GFC_MAX_DIMENSIONS - 1];
  index_type mstride[GFC_MAX_DIMENSIONS - 1];
  GFC_INTEGER_4 *dest;
  GFC_INTEGER_4 *base;
  GFC_LOGICAL_4 *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;
  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
  if (array->dim[0].stride == 0)
    array->dim[0].stride = 1;
  if (retarray->dim[0].stride == 0)
    retarray->dim[0].stride = 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;
    }
  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;
    }

  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)
    {
      GFC_INTEGER_4 *src;
      GFC_LOGICAL_4 *msrc;
      GFC_INTEGER_4 result;
      src = base;
      msrc = mbase;
      {

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

  if (*msrc && *src < minval)
    {
      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 proabably 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];
            }
        }
    }
}
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
	5	This file is part of the GNU Fortran 95 runtime library (libgfor).
	6
	7	Libgfortran is free software; you can redistribute it and/or
	8	modify it under the terms of the GNU Lesser General Public
	9	License as published by the Free Software Foundation; either
	10	version 2.1 of the License, or (at your option) any later version.
	11
	12	Libgfortran is distributed in the hope that it will be useful,
	13	but WITHOUT ANY WARRANTY; without even the implied warranty of
	14	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	15	GNU Lesser General Public License for more details.
	16
	17	You should have received a copy of the GNU Lesser General Public
	18	License along with libgfor; see the file COPYING.LIB. If not,
	19	write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
	20	Boston, MA 02111-1307, USA. */
	21
	22	#include "config.h"
	23	#include <stdlib.h>
	24	#include <assert.h>
	25	#include <float.h>
	26	#include <limits.h>
	27	#include "libgfortran.h"
	28
6de9cd9a DN	29	void
	30	__minloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 array, index_type pdim)
	31	{
	32	index_type count[GFC_MAX_DIMENSIONS - 1];
	33	index_type extent[GFC_MAX_DIMENSIONS - 1];
	34	index_type sstride[GFC_MAX_DIMENSIONS - 1];
	35	index_type dstride[GFC_MAX_DIMENSIONS - 1];
	36	GFC_INTEGER_4 *base;
	37	GFC_INTEGER_4 *dest;
	38	index_type rank;
	39	index_type n;
	40	index_type len;
	41	index_type delta;
	42	index_type dim;
	43
	44	/* Make dim zero based to avoid confusion. */
	45	dim = (*pdim) - 1;
	46	rank = GFC_DESCRIPTOR_RANK (array) - 1;
	47	assert (rank == GFC_DESCRIPTOR_RANK (retarray));
	48	if (array->dim[0].stride == 0)
	49	array->dim[0].stride = 1;
	50	if (retarray->dim[0].stride == 0)
	51	retarray->dim[0].stride = 1;
	52
	53	len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
	54	delta = array->dim[dim].stride;
	55
	56	for (n = 0; n < dim; n++)
	57	{
	58	sstride[n] = array->dim[n].stride;
	59	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
	60	}
	61	for (n = dim; n < rank; n++)
	62	{
	63	sstride[n] = array->dim[n + 1].stride;
	64	extent[n] =
	65	array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
	66	}
	67
6c167c45 VL	68	if (retarray->data == NULL)
	69	{
	70	for (n = 0; n < rank; n++)
	71	{
	72	retarray->dim[n].lbound = 0;
	73	retarray->dim[n].ubound = extent[n]-1;
	74	if (n == 0)
	75	retarray->dim[n].stride = 1;
	76	else
	77	retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
	78	}
	79
	80	retarray->data = internal_malloc (sizeof (GFC_INTEGER_4) *
	81	(retarray->dim[rank-1].stride * extent[rank-1]));
	82	retarray->base = 0;
	83	}
	84
6de9cd9a DN	85	for (n = 0; n < rank; n++)
	86	{
	87	count[n] = 0;
	88	dstride[n] = retarray->dim[n].stride;
	89	if (extent[n] <= 0)
	90	len = 0;
	91	}
	92
	93	base = array->data;
	94	dest = retarray->data;
	95
	96	while (base)
	97	{
	98	GFC_INTEGER_4 *src;
	99	GFC_INTEGER_4 result;
	100	src = base;
	101	{
	102
	103	GFC_INTEGER_4 minval;
	104	minval = GFC_INTEGER_4_HUGE;
	105	result = 1;
	106	if (len <= 0)
	107	*dest = 0;
	108	else
	109	{
	110	for (n = 0; n < len; n++, src += delta)
	111	{
	112
	113	if (*src < minval)
	114	{
	115	minval = *src;
	116	result = (GFC_INTEGER_4)n + 1;
	117	}
	118	}
	119	*dest = result;
	120	}
	121	}
	122	/* Advance to the next element. */
	123	count[0]++;
	124	base += sstride[0];
	125	dest += dstride[0];
	126	n = 0;
	127	while (count[n] == extent[n])
	128	{
	129	/* When we get to the end of a dimension, reset it and increment
	130	the next dimension. */
	131	count[n] = 0;
	132	/* We could precalculate these products, but this is a less
	133	frequently used path so proabably not worth it. */
	134	base -= sstride[n] * extent[n];
	135	dest -= dstride[n] * extent[n];
	136	n++;
	137	if (n == rank)
	138	{
	139	/* Break out of the look. */
	140	base = NULL;
	141	break;
	142	}
	143	else
	144	{
	145	count[n]++;
	146	base += sstride[n];
	147	dest += dstride[n];
	148	}
149	}
150	}
151	}
152
153	void
154	__mminloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, index_type pdim, gfc_array_l4 mask)
155	{
156	index_type count[GFC_MAX_DIMENSIONS - 1];
157	index_type extent[GFC_MAX_DIMENSIONS - 1];
158	index_type sstride[GFC_MAX_DIMENSIONS - 1];
159	index_type dstride[GFC_MAX_DIMENSIONS - 1];
160	index_type mstride[GFC_MAX_DIMENSIONS - 1];
161	GFC_INTEGER_4 *dest;
162	GFC_INTEGER_4 *base;
163	GFC_LOGICAL_4 *mbase;
164	int rank;
165	int dim;
166	index_type n;
167	index_type len;
168	index_type delta;
169	index_type mdelta;
170
171	dim = (*pdim) - 1;
172	rank = GFC_DESCRIPTOR_RANK (array) - 1;
173	assert (rank == GFC_DESCRIPTOR_RANK (retarray));
174	if (array->dim[0].stride == 0)
175	array->dim[0].stride = 1;
176	if (retarray->dim[0].stride == 0)
177	retarray->dim[0].stride = 1;
178
179	len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
180	if (len <= 0)
181	return;
182	delta = array->dim[dim].stride;
183	mdelta = mask->dim[dim].stride;
184
185	for (n = 0; n < dim; n++)
186	{
187	sstride[n] = array->dim[n].stride;
188	mstride[n] = mask->dim[n].stride;
189	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
190	}
191	for (n = dim; n < rank; n++)
192	{
193	sstride[n] = array->dim[n + 1].stride;
194	mstride[n] = mask->dim[n + 1].stride;
195	extent[n] =
196	array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
197	}
198
199	for (n = 0; n < rank; n++)
200	{
201	count[n] = 0;
202	dstride[n] = retarray->dim[n].stride;
203	if (extent[n] <= 0)
204	return;
205	}
206
207	dest = retarray->data;
208	base = array->data;
209	mbase = mask->data;
210
211	if (GFC_DESCRIPTOR_SIZE (mask) != 4)
212	{
213	/* This allows the same loop to be used for all logical types. */
214	assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
215	for (n = 0; n < rank; n++)
216	mstride[n] <<= 1;
217	mdelta <<= 1;
218	mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
219	}
220
221	while (base)
222	{
223	GFC_INTEGER_4 *src;
224	GFC_LOGICAL_4 *msrc;
225	GFC_INTEGER_4 result;
226	src = base;
227	msrc = mbase;
228	{
229
230	GFC_INTEGER_4 minval;
231	minval = GFC_INTEGER_4_HUGE;
232	result = 1;
233	if (len <= 0)
234	*dest = 0;
235	else
236	{
237	for (n = 0; n < len; n++, src += delta, msrc += mdelta)
238	{
239
240	if (msrc && src < minval)
241	{
242	minval = *src;
243	result = (GFC_INTEGER_4)n + 1;
244	}
245	}
246	*dest = result;
247	}
248	}
249	/* Advance to the next element. */
250	count[0]++;
251	base += sstride[0];
252	mbase += mstride[0];
253	dest += dstride[0];
254	n = 0;
255	while (count[n] == extent[n])
256	{
257	/* When we get to the end of a dimension, reset it and increment
258	the next dimension. */
259	count[n] = 0;
260	/* We could precalculate these products, but this is a less
261	frequently used path so proabably not worth it. */
262	base -= sstride[n] * extent[n];
263	mbase -= mstride[n] * extent[n];
264	dest -= dstride[n] * extent[n];
265	n++;
266	if (n == rank)
267	{
268	/* Break out of the look. */
269	base = NULL;
270	break;
271	}
272	else
273	{
274	count[n]++;
275	base += sstride[n];
276	mbase += mstride[n];
277	dest += dstride[n];
278	}
279	}
280	}
281	}
282