[thirdparty/gcc.git] / libgfortran / generated / maxloc0_8_i4.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_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array);
export_proto_np(__maxloc0_8_i4);

void
__maxloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type dstride;
  GFC_INTEGER_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_INTEGER_4 maxval;

  maxval = -GFC_INTEGER_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_i4 (gfc_array_i8 *, gfc_array_i4 *, gfc_array_l4 *);
export_proto_np(__mmaxloc0_8_i4);

void
__mmaxloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *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_INTEGER_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_INTEGER_4 maxval;

  maxval = -GFC_INTEGER_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 RH	30
	31	extern void __maxloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array);
	32	export_proto_np(__maxloc0_8_i4);
	33
6de9cd9a DN	34	void
	35	__maxloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array)
	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_INTEGER_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_INTEGER_4 maxval;
	79
	80	maxval = -GFC_INTEGER_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 RH	124
	125	extern void __mmaxloc0_8_i4 (gfc_array_i8 , gfc_array_i4 , gfc_array_l4 *);
	126	export_proto_np(__mmaxloc0_8_i4);
	127
6de9cd9a DN	128	void
	129	__mmaxloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 array, gfc_array_l4 mask)
	130	{
	131	index_type count[GFC_MAX_DIMENSIONS];
	132	index_type extent[GFC_MAX_DIMENSIONS];
	133	index_type sstride[GFC_MAX_DIMENSIONS];
	134	index_type mstride[GFC_MAX_DIMENSIONS];
	135	index_type dstride;
	136	GFC_INTEGER_8 *dest;
	137	GFC_INTEGER_4 *base;
	138	GFC_LOGICAL_4 *mbase;
	139	int rank;
	140	index_type n;
	141
	142	rank = GFC_DESCRIPTOR_RANK (array);
	143	assert (rank > 0);
	144	assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
	145	assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
	146	assert (GFC_DESCRIPTOR_RANK (mask) == rank);
	147
	148	if (array->dim[0].stride == 0)
	149	array->dim[0].stride = 1;
	150	if (retarray->dim[0].stride == 0)
	151	retarray->dim[0].stride = 1;
	152	if (retarray->dim[0].stride == 0)
	153	retarray->dim[0].stride = 1;
	154
	155	dstride = retarray->dim[0].stride;
	156	dest = retarray->data;
	157	for (n = 0; n < rank; n++)
	158	{
	159	sstride[n] = array->dim[n].stride;
	160	mstride[n] = mask->dim[n].stride;
	161	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
	162	count[n] = 0;
	163	if (extent[n] <= 0)
	164	{
	165	/* Set the return value. */
	166	for (n = 0; n < rank; n++)
	167	dest[n * dstride] = 0;
	168	return;
	169	}
	170	}
	171
	172	base = array->data;
	173	mbase = mask->data;
	174
	175	if (GFC_DESCRIPTOR_SIZE (mask) != 4)
	176	{
	177	/* This allows the same loop to be used for all logical types. */
	178	assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
	179	for (n = 0; n < rank; n++)
	180	mstride[n] <<= 1;
	181	mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
	182	}
	183
	184
	185	/* Initialize the return value. */
	186	for (n = 0; n < rank; n++)
	187	dest[n * dstride] = 1;
	188	{
	189
	190	GFC_INTEGER_4 maxval;
	191
192	maxval = -GFC_INTEGER_4_HUGE;
193
194	while (base)
195	{
196	{
197	/* Implementation start. */
198
199	if (mbase && base > maxval)
200	{
201	maxval = *base;
202	for (n = 0; n < rank; n++)
203	dest[n * dstride] = count[n] + 1;
204	}
205	/* Implementation end. */
206	}
207	/* Advance to the next element. */
208	count[0]++;
209	base += sstride[0];
210	mbase += mstride[0];
211	n = 0;
212	while (count[n] == extent[n])
213	{
214	/* When we get to the end of a dimension, reset it and increment
215	the next dimension. */
216	count[n] = 0;
217	/* We could precalculate these products, but this is a less
218	frequently used path so proabably not worth it. */
219	base -= sstride[n] * extent[n];
220	mbase -= mstride[n] * extent[n];
221	n++;
222	if (n == rank)
223	{
224	/* Break out of the loop. */
225	base = NULL;
226	break;
227	}
228	else
229	{
230	count[n]++;
231	base += sstride[n];
232	mbase += mstride[n];
233	}
234	}
235	}
236	}
237	}