[thirdparty/gcc.git] / libgfortran / generated / minloc0_16_i16.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 (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 "config.h"
#include <stdlib.h>
#include <assert.h>
#include <limits.h>
#include "libgfortran.h"


#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)


extern void minloc0_16_i16 (gfc_array_i16 * const restrict retarray, 
	gfc_array_i16 * const restrict array);
export_proto(minloc0_16_i16);

void
minloc0_16_i16 (gfc_array_i16 * const restrict retarray, 
	gfc_array_i16 * const restrict array)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type dstride;
  const GFC_INTEGER_16 *base;
  GFC_INTEGER_16 *dest;
  index_type rank;
  index_type n;

  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_16) * 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++)
    {
      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] = 0;
  {

  GFC_INTEGER_16 minval;

  minval = GFC_INTEGER_16_HUGE;

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

  if (*base < minval || !dest[0])
    {
      minval = *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 probably 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 mminloc0_16_i16 (gfc_array_i16 * const restrict, 
	gfc_array_i16 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_16_i16);

void
mminloc0_16_i16 (gfc_array_i16 * const restrict retarray, 
	gfc_array_i16 * const restrict array,
	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 mstride[GFC_MAX_DIMENSIONS];
  index_type dstride;
  GFC_INTEGER_16 *dest;
  const GFC_INTEGER_16 *base;
  GFC_LOGICAL_1 *mbase;
  int rank;
  index_type n;
  int mask_kind;

  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_16) * 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");
    }

  mask_kind = GFC_DESCRIPTOR_SIZE (mask);

  mbase = mask->data;

  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");

  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 * mask_kind;
      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] = 0;
  {

  GFC_INTEGER_16 minval;

  minval = GFC_INTEGER_16_HUGE;

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

  if (*mbase && (*base < minval || !dest[0]))
    {
      minval = *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 probably 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];
            }
        }
    }
  }
}


extern void sminloc0_16_i16 (gfc_array_i16 * const restrict, 
	gfc_array_i16 * const restrict, GFC_LOGICAL_4 *);
export_proto(sminloc0_16_i16);

void
sminloc0_16_i16 (gfc_array_i16 * const restrict retarray, 
	gfc_array_i16 * const restrict array,
	GFC_LOGICAL_4 * mask)
{
  index_type rank;
  index_type dstride;
  index_type n;
  GFC_INTEGER_16 *dest;

  if (*mask)
    {
      minloc0_16_i16 (retarray, array);
      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_16) * 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
644cb69f FXC	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 (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
	31	#include "config.h"
	32	#include <stdlib.h>
	33	#include <assert.h>
644cb69f FXC	34	#include <limits.h>
	35	#include "libgfortran.h"
	36
	37
	38	#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
	39
	40
64acfd99 JB	41	extern void minloc0_16_i16 (gfc_array_i16 * const restrict retarray,
64acfd99 JB	42	gfc_array_i16 * const restrict array);
644cb69f FXC	43	export_proto(minloc0_16_i16);
	44
	45	void
64acfd99 JB	46	minloc0_16_i16 (gfc_array_i16 * const restrict retarray,
64acfd99 JB	47	gfc_array_i16 * const restrict array)
644cb69f FXC	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;
64acfd99	53	const GFC_INTEGER_16 *base;
644cb69f FXC	54	GFC_INTEGER_16 *dest;
	55	index_type rank;
	56	index_type n;
	57
	58	rank = GFC_DESCRIPTOR_RANK (array);
	59	if (rank <= 0)
	60	runtime_error ("Rank of array needs to be > 0");
	61
	62	if (retarray->data == NULL)
	63	{
	64	retarray->dim[0].lbound = 0;
	65	retarray->dim[0].ubound = rank-1;
	66	retarray->dim[0].stride = 1;
	67	retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) \| 1;
	68	retarray->offset = 0;
	69	retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
	70	}
	71	else
	72	{
	73	if (GFC_DESCRIPTOR_RANK (retarray) != 1)
	74	runtime_error ("rank of return array does not equal 1");
	75
	76	if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
	77	runtime_error ("dimension of return array incorrect");
644cb69f FXC	78	}
644cb69f FXC	79
644cb69f FXC	80	dstride = retarray->dim[0].stride;
	81	dest = retarray->data;
	82	for (n = 0; n < rank; n++)
	83	{
	84	sstride[n] = array->dim[n].stride;
	85	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
	86	count[n] = 0;
	87	if (extent[n] <= 0)
	88	{
	89	/* Set the return value. */
	90	for (n = 0; n < rank; n++)
	91	dest[n * dstride] = 0;
	92	return;
	93	}
	94	}
	95
	96	base = array->data;
	97
	98	/* Initialize the return value. */
	99	for (n = 0; n < rank; n++)
a4b9e93e	100	dest[n * dstride] = 0;
644cb69f FXC	101	{
	102
	103	GFC_INTEGER_16 minval;
	104
	105	minval = GFC_INTEGER_16_HUGE;
	106
	107	while (base)
	108	{
	109	{
	110	/* Implementation start. */
	111
a4b9e93e	112	if (*base < minval \|\| !dest[0])
644cb69f FXC	113	{
	114	minval = *base;
	115	for (n = 0; n < rank; n++)
	116	dest[n * dstride] = count[n] + 1;
	117	}
	118	/* Implementation end. */
	119	}
	120	/* Advance to the next element. */
	121	count[0]++;
	122	base += sstride[0];
	123	n = 0;
	124	while (count[n] == extent[n])
	125	{
	126	/* When we get to the end of a dimension, reset it and increment
	127	the next dimension. */
	128	count[n] = 0;
	129	/* We could precalculate these products, but this is a less
5d7adf7a	130	frequently used path so probably not worth it. */
644cb69f FXC	131	base -= sstride[n] * extent[n];
	132	n++;
	133	if (n == rank)
	134	{
	135	/* Break out of the loop. */
	136	base = NULL;
	137	break;
	138	}
	139	else
	140	{
	141	count[n]++;
	142	base += sstride[n];
	143	}
	144	}
	145	}
	146	}
	147	}
	148
	149
64acfd99	150	extern void mminloc0_16_i16 (gfc_array_i16 * const restrict,
28dc6b33	151	gfc_array_i16 * const restrict, gfc_array_l1 * const restrict);
644cb69f FXC	152	export_proto(mminloc0_16_i16);
	153
	154	void
64acfd99 JB	155	mminloc0_16_i16 (gfc_array_i16 * const restrict retarray,
64acfd99 JB	156	gfc_array_i16 * const restrict array,
28dc6b33	157	gfc_array_l1 * const restrict mask)
644cb69f FXC	158	{
	159	index_type count[GFC_MAX_DIMENSIONS];
	160	index_type extent[GFC_MAX_DIMENSIONS];
	161	index_type sstride[GFC_MAX_DIMENSIONS];
	162	index_type mstride[GFC_MAX_DIMENSIONS];
	163	index_type dstride;
	164	GFC_INTEGER_16 *dest;
64acfd99	165	const GFC_INTEGER_16 *base;
28dc6b33	166	GFC_LOGICAL_1 *mbase;
644cb69f FXC	167	int rank;
644cb69f FXC	168	index_type n;
28dc6b33	169	int mask_kind;
644cb69f FXC	170
	171	rank = GFC_DESCRIPTOR_RANK (array);
	172	if (rank <= 0)
	173	runtime_error ("Rank of array needs to be > 0");
	174
	175	if (retarray->data == NULL)
	176	{
	177	retarray->dim[0].lbound = 0;
	178	retarray->dim[0].ubound = rank-1;
	179	retarray->dim[0].stride = 1;
	180	retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) \| 1;
	181	retarray->offset = 0;
	182	retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
	183	}
	184	else
	185	{
	186	if (GFC_DESCRIPTOR_RANK (retarray) != 1)
	187	runtime_error ("rank of return array does not equal 1");
	188
	189	if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
	190	runtime_error ("dimension of return array incorrect");
644cb69f FXC	191	}
644cb69f FXC	192
28dc6b33 TK	193	mask_kind = GFC_DESCRIPTOR_SIZE (mask);
	194
	195	mbase = mask->data;
	196
	197	if (mask_kind == 1 \|\| mask_kind == 2 \|\| mask_kind == 4 \|\| mask_kind == 8
	198	#ifdef HAVE_GFC_LOGICAL_16
	199	\|\| mask_kind == 16
	200	#endif
	201	)
	202	mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
	203	else
	204	runtime_error ("Funny sized logical array");
	205
644cb69f FXC	206	dstride = retarray->dim[0].stride;
	207	dest = retarray->data;
	208	for (n = 0; n < rank; n++)
	209	{
	210	sstride[n] = array->dim[n].stride;
28dc6b33	211	mstride[n] = mask->dim[n].stride * mask_kind;
644cb69f FXC	212	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
	213	count[n] = 0;
	214	if (extent[n] <= 0)
	215	{
	216	/* Set the return value. */
	217	for (n = 0; n < rank; n++)
	218	dest[n * dstride] = 0;
	219	return;
	220	}
	221	}
	222
	223	base = array->data;
644cb69f FXC	224
	225	/* Initialize the return value. */
	226	for (n = 0; n < rank; n++)
a4b9e93e	227	dest[n * dstride] = 0;
644cb69f FXC	228	{
	229
	230	GFC_INTEGER_16 minval;
	231
	232	minval = GFC_INTEGER_16_HUGE;
	233
	234	while (base)
	235	{
	236	{
	237	/* Implementation start. */
	238
a4b9e93e	239	if (mbase && (base < minval \|\| !dest[0]))
644cb69f FXC	240	{
	241	minval = *base;
	242	for (n = 0; n < rank; n++)
	243	dest[n * dstride] = count[n] + 1;
	244	}
	245	/* Implementation end. */
	246	}
	247	/* Advance to the next element. */
	248	count[0]++;
	249	base += sstride[0];
	250	mbase += mstride[0];
	251	n = 0;
	252	while (count[n] == extent[n])
	253	{
	254	/* When we get to the end of a dimension, reset it and increment
	255	the next dimension. */
	256	count[n] = 0;
	257	/* We could precalculate these products, but this is a less
5d7adf7a	258	frequently used path so probably not worth it. */
644cb69f FXC	259	base -= sstride[n] * extent[n];
	260	mbase -= mstride[n] * extent[n];
	261	n++;
	262	if (n == rank)
	263	{
	264	/* Break out of the loop. */
	265	base = NULL;
	266	break;
	267	}
	268	else
	269	{
	270	count[n]++;
	271	base += sstride[n];
	272	mbase += mstride[n];
	273	}
	274	}
	275	}
	276	}
	277	}
	278
97a62038 TK	279
	280	extern void sminloc0_16_i16 (gfc_array_i16 * const restrict,
	281	gfc_array_i16 * const restrict, GFC_LOGICAL_4 *);
	282	export_proto(sminloc0_16_i16);
	283
	284	void
	285	sminloc0_16_i16 (gfc_array_i16 * const restrict retarray,
	286	gfc_array_i16 * const restrict array,
	287	GFC_LOGICAL_4 * mask)
	288	{
	289	index_type rank;
	290	index_type dstride;
	291	index_type n;
	292	GFC_INTEGER_16 *dest;
	293
	294	if (*mask)
	295	{
	296	minloc0_16_i16 (retarray, array);
	297	return;
	298	}
	299
	300	rank = GFC_DESCRIPTOR_RANK (array);
	301
	302	if (rank <= 0)
	303	runtime_error ("Rank of array needs to be > 0");
	304
	305	if (retarray->data == NULL)
	306	{
	307	retarray->dim[0].lbound = 0;
	308	retarray->dim[0].ubound = rank-1;
	309	retarray->dim[0].stride = 1;
	310	retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) \| 1;
	311	retarray->offset = 0;
	312	retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
	313	}
	314	else
	315	{
	316	if (GFC_DESCRIPTOR_RANK (retarray) != 1)
	317	runtime_error ("rank of return array does not equal 1");
	318
	319	if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
	320	runtime_error ("dimension of return array incorrect");
97a62038 TK	321	}
	322
	323	dstride = retarray->dim[0].stride;
	324	dest = retarray->data;
	325	for (n = 0; n<rank; n++)
	326	dest[n * dstride] = 0 ;
	327	}
644cb69f	328	#endif