[gcc.git] / libgfortran / generated / maxloc0_8_r4.c

/* Implementation of the MAXLOC 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"


extern void maxloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array);
export_proto(maxloc0_8_r4);

void
maxloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type dstride;
  GFC_REAL_4 *base;
  GFC_INTEGER_8 *dest;
  index_type rank;
  index_type n;

  rank = GFC_DESCRIPTOR_RANK (array);
  assert (rank > 0);
  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
  if (array->dim[0].stride == 0)
    array->dim[0].stride = 1;
  if (retarray->dim[0].stride == 0)
    retarray->dim[0].stride = 1;

  dstride = retarray->dim[0].stride;
  dest = retarray->data;
  for (n = 0; n < rank; n++)
    {
      sstride[n] = array->dim[n].stride;
      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
      count[n] = 0;
      if (extent[n] <= 0)
	{
	  /* Set the return value.  */
	  for (n = 0; n < rank; n++)
	    dest[n * dstride] = 0;
	  return;
	}
    }

  base = array->data;

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

  GFC_REAL_4 maxval;

  maxval = -GFC_REAL_4_HUGE;

  while (base)
    {
      {
        /* Implementation start.  */

  if (*base > maxval)
    {
      maxval = *base;
      for (n = 0; n < rank; n++)
        dest[n * dstride] = count[n] + 1;
    }
        /* Implementation end.  */
      }
      /* Advance to the next element.  */
      count[0]++;
      base += sstride[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];
          n++;
          if (n == rank)
            {
              /* Break out of the loop.  */
              base = NULL;
              break;
            }
          else
            {
              count[n]++;
              base += sstride[n];
            }
        }
    }
  }
}


extern void mmaxloc0_8_r4 (gfc_array_i8 *, gfc_array_r4 *, gfc_array_l4 *);
export_proto(mmaxloc0_8_r4);

void
mmaxloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array,
				  gfc_array_l4 * mask)
{
  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;
  GFC_INTEGER_8 *dest;
  GFC_REAL_4 *base;
  GFC_LOGICAL_4 *mbase;
  int rank;
  index_type n;

  rank = GFC_DESCRIPTOR_RANK (array);
  assert (rank > 0);
  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
  assert (GFC_DESCRIPTOR_RANK (mask) == rank);

  if (array->dim[0].stride == 0)
    array->dim[0].stride = 1;
  if (retarray->dim[0].stride == 0)
    retarray->dim[0].stride = 1;
  if (retarray->dim[0].stride == 0)
    retarray->dim[0].stride = 1;

  dstride = retarray->dim[0].stride;
  dest = retarray->data;
  for (n = 0; n < rank; n++)
    {
      sstride[n] = array->dim[n].stride;
      mstride[n] = mask->dim[n].stride;
      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
      count[n] = 0;
      if (extent[n] <= 0)
	{
	  /* Set the return value.  */
	  for (n = 0; n < rank; n++)
	    dest[n * dstride] = 0;
	  return;
	}
    }

  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;
      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
    }


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

  GFC_REAL_4 maxval;

  maxval = -GFC_REAL_4_HUGE;

  while (base)
    {
      {
        /* Implementation start.  */

  if (*mbase && *base > maxval)
    {
      maxval = *base;
      for (n = 0; n < rank; n++)
        dest[n * dstride] = count[n] + 1;
    }
        /* Implementation end.  */
      }
      /* Advance to the next element.  */
      count[0]++;
      base += sstride[0];
      mbase += mstride[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];
          n++;
          if (n == rank)
            {
              /* Break out of the loop.  */
              base = NULL;
              break;
            }
          else
            {
              count[n]++;
              base += sstride[n];
              mbase += mstride[n];
            }
        }
    }
  }
}
Commit	Line	Data
6de9cd9a DN	1	/* Implementation of the MAXLOC 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
	29
7d7b8bfe	30
7f68c75f RH	31	extern void maxloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array);
7f68c75f RH	32	export_proto(maxloc0_8_r4);
7d7b8bfe	33
6de9cd9a	34	void
7f68c75f	35	maxloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array)
6de9cd9a DN	36	{
	37	index_type count[GFC_MAX_DIMENSIONS];
	38	index_type extent[GFC_MAX_DIMENSIONS];
	39	index_type sstride[GFC_MAX_DIMENSIONS];
	40	index_type dstride;
	41	GFC_REAL_4 *base;
	42	GFC_INTEGER_8 *dest;
	43	index_type rank;
	44	index_type n;
	45
	46	rank = GFC_DESCRIPTOR_RANK (array);
	47	assert (rank > 0);
	48	assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
	49	assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
	50	if (array->dim[0].stride == 0)
	51	array->dim[0].stride = 1;
	52	if (retarray->dim[0].stride == 0)
	53	retarray->dim[0].stride = 1;
	54
	55	dstride = retarray->dim[0].stride;
	56	dest = retarray->data;
	57	for (n = 0; n < rank; n++)
	58	{
	59	sstride[n] = array->dim[n].stride;
	60	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
	61	count[n] = 0;
	62	if (extent[n] <= 0)
	63	{
	64	/* Set the return value. */
	65	for (n = 0; n < rank; n++)
	66	dest[n * dstride] = 0;
	67	return;
	68	}
	69	}
	70
	71	base = array->data;
	72
	73	/* Initialize the return value. */
	74	for (n = 0; n < rank; n++)
	75	dest[n * dstride] = 1;
	76	{
	77
	78	GFC_REAL_4 maxval;
	79
	80	maxval = -GFC_REAL_4_HUGE;
	81
	82	while (base)
	83	{
	84	{
	85	/* Implementation start. */
	86
	87	if (*base > maxval)
	88	{
	89	maxval = *base;
	90	for (n = 0; n < rank; n++)
	91	dest[n * dstride] = count[n] + 1;
	92	}
	93	/* Implementation end. */
	94	}
	95	/* Advance to the next element. */
	96	count[0]++;
	97	base += sstride[0];
	98	n = 0;
	99	while (count[n] == extent[n])
100	{
101	/* When we get to the end of a dimension, reset it and increment
102	the next dimension. */
103	count[n] = 0;
104	/* We could precalculate these products, but this is a less
105	frequently used path so proabably not worth it. */
106	base -= sstride[n] * extent[n];
107	n++;
108	if (n == rank)
109	{
110	/* Break out of the loop. */
111	base = NULL;
112	break;
113	}
114	else
115	{
116	count[n]++;
117	base += sstride[n];
118	}
119	}
120	}
121	}
122	}
123
7d7b8bfe	124
7f68c75f RH	125	extern void mmaxloc0_8_r4 (gfc_array_i8 , gfc_array_r4 , gfc_array_l4 *);
7f68c75f RH	126	export_proto(mmaxloc0_8_r4);
7d7b8bfe	127
6de9cd9a	128	void
7f68c75f RH	129	mmaxloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array,
7f68c75f RH	130	gfc_array_l4 * mask)
6de9cd9a DN	131	{
	132	index_type count[GFC_MAX_DIMENSIONS];
	133	index_type extent[GFC_MAX_DIMENSIONS];
	134	index_type sstride[GFC_MAX_DIMENSIONS];
	135	index_type mstride[GFC_MAX_DIMENSIONS];
	136	index_type dstride;
	137	GFC_INTEGER_8 *dest;
	138	GFC_REAL_4 *base;
	139	GFC_LOGICAL_4 *mbase;
	140	int rank;
	141	index_type n;
	142
	143	rank = GFC_DESCRIPTOR_RANK (array);
	144	assert (rank > 0);
	145	assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
	146	assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
	147	assert (GFC_DESCRIPTOR_RANK (mask) == rank);
	148
	149	if (array->dim[0].stride == 0)
	150	array->dim[0].stride = 1;
	151	if (retarray->dim[0].stride == 0)
	152	retarray->dim[0].stride = 1;
	153	if (retarray->dim[0].stride == 0)
	154	retarray->dim[0].stride = 1;
	155
	156	dstride = retarray->dim[0].stride;
	157	dest = retarray->data;
	158	for (n = 0; n < rank; n++)
	159	{
	160	sstride[n] = array->dim[n].stride;
	161	mstride[n] = mask->dim[n].stride;
	162	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
	163	count[n] = 0;
	164	if (extent[n] <= 0)
	165	{
	166	/* Set the return value. */
	167	for (n = 0; n < rank; n++)
	168	dest[n * dstride] = 0;
	169	return;
	170	}
	171	}
	172
	173	base = array->data;
	174	mbase = mask->data;
	175
	176	if (GFC_DESCRIPTOR_SIZE (mask) != 4)
	177	{
	178	/* This allows the same loop to be used for all logical types. */
	179	assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
	180	for (n = 0; n < rank; n++)
	181	mstride[n] <<= 1;
	182	mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
	183	}
	184
	185
	186	/* Initialize the return value. */
	187	for (n = 0; n < rank; n++)
	188	dest[n * dstride] = 1;
	189	{
	190
	191	GFC_REAL_4 maxval;
	192
	193	maxval = -GFC_REAL_4_HUGE;
	194
195	while (base)
196	{
197	{
198	/* Implementation start. */
199
200	if (mbase && base > maxval)
201	{
202	maxval = *base;
203	for (n = 0; n < rank; n++)
204	dest[n * dstride] = count[n] + 1;
205	}
206	/* Implementation end. */
207	}
208	/* Advance to the next element. */
209	count[0]++;
210	base += sstride[0];
211	mbase += mstride[0];
212	n = 0;
213	while (count[n] == extent[n])
214	{
215	/* When we get to the end of a dimension, reset it and increment
216	the next dimension. */
217	count[n] = 0;
218	/* We could precalculate these products, but this is a less
219	frequently used path so proabably not worth it. */
220	base -= sstride[n] * extent[n];
221	mbase -= mstride[n] * extent[n];
222	n++;
223	if (n == rank)
224	{
225	/* Break out of the loop. */
226	base = NULL;
227	break;
228	}
229	else
230	{
231	count[n]++;
232	base += sstride[n];
233	mbase += mstride[n];
234	}
235	}
236	}
237	}
238	}