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

/* Implementation of the MINVAL intrinsic
   Copyright 2002, 2007, 2009 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 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 <stdlib.h>
#include <assert.h>


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


extern void minval_i16 (gfc_array_i16 * const restrict, 
	gfc_array_i16 * const restrict, const index_type * const restrict);
export_proto(minval_i16);

void
minval_i16 (gfc_array_i16 * const restrict retarray, 
	gfc_array_i16 * const restrict array, 
	const index_type * const restrict pdim)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type dstride[GFC_MAX_DIMENSIONS];
  const GFC_INTEGER_16 * restrict base;
  GFC_INTEGER_16 * restrict dest;
  index_type rank;
  index_type n;
  index_type len;
  index_type delta;
  index_type dim;
  int continue_loop;

  /* Make dim zero based to avoid confusion.  */
  dim = (*pdim) - 1;
  rank = GFC_DESCRIPTOR_RANK (array) - 1;

  len = GFC_DESCRIPTOR_EXTENT(array,dim);
  if (len < 0)
    len = 0;
  delta = GFC_DESCRIPTOR_STRIDE(array,dim);

  for (n = 0; n < dim; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);

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

      if (extent[n] < 0)
	extent[n] = 0;
    }

  if (retarray->data == NULL)
    {
      size_t alloc_size, str;

      for (n = 0; n < rank; n++)
        {
          if (n == 0)
	    str = 1;
          else
            str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];

	  GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);

        }

      retarray->offset = 0;
      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;

      alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
    		   * extent[rank-1];

      if (alloc_size == 0)
	{
	  /* Make sure we have a zero-sized array.  */
	  GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
	  return;

	}
      else
	retarray->data = internal_malloc_size (alloc_size);
    }
  else
    {
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
	runtime_error ("rank of return array incorrect in"
		       " MINVAL intrinsic: is %ld, should be %ld",
		       (long int) (GFC_DESCRIPTOR_RANK (retarray)),
		       (long int) rank);

      if (unlikely (compile_options.bounds_check))
	{
	  for (n=0; n < rank; n++)
	    {
	      index_type ret_extent;

	      ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
	      if (extent[n] != ret_extent)
		runtime_error ("Incorrect extent in return value of"
			       " MINVAL intrinsic in dimension %ld:"
			       " is %ld, should be %ld", (long int) n + 1,
			       (long int) ret_extent, (long int) extent[n]);
	    }
	}
    }

  for (n = 0; n < rank; n++)
    {
      count[n] = 0;
      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
      if (extent[n] <= 0)
        len = 0;
    }

  base = array->data;
  dest = retarray->data;

  continue_loop = 1;
  while (continue_loop)
    {
      const GFC_INTEGER_16 * restrict src;
      GFC_INTEGER_16 result;
      src = base;
      {

  result = GFC_INTEGER_16_HUGE;
        if (len <= 0)
	  *dest = GFC_INTEGER_16_HUGE;
	else
	  {
	    for (n = 0; n < len; n++, src += delta)
	      {

  if (*src < result)
    result = *src;
          }
	    *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 probably not worth it.  */
          base -= sstride[n] * extent[n];
          dest -= dstride[n] * extent[n];
          n++;
          if (n == rank)
            {
              /* Break out of the look.  */
	      continue_loop = 0;
	      break;
            }
          else
            {
              count[n]++;
              base += sstride[n];
              dest += dstride[n];
            }
        }
    }
}


extern void mminval_i16 (gfc_array_i16 * const restrict, 
	gfc_array_i16 * const restrict, const index_type * const restrict,
	gfc_array_l1 * const restrict);
export_proto(mminval_i16);

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

  dim = (*pdim) - 1;
  rank = GFC_DESCRIPTOR_RANK (array) - 1;

  len = GFC_DESCRIPTOR_EXTENT(array,dim);
  if (len <= 0)
    return;

  mbase = mask->data;

  mask_kind = GFC_DESCRIPTOR_SIZE (mask);

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

  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
  mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);

  for (n = 0; n < dim; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);

      if (extent[n] < 0)
	extent[n] = 0;

    }
  for (n = dim; n < rank; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);

      if (extent[n] < 0)
	extent[n] = 0;
    }

  if (retarray->data == NULL)
    {
      size_t alloc_size, str;

      for (n = 0; n < rank; n++)
        {
          if (n == 0)
            str = 1;
          else
            str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];

	  GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);

        }

      alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
    		   * extent[rank-1];

      retarray->offset = 0;
      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;

      if (alloc_size == 0)
	{
	  /* Make sure we have a zero-sized array.  */
	  GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
	  return;
	}
      else
	retarray->data = internal_malloc_size (alloc_size);

    }
  else
    {
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
	runtime_error ("rank of return array incorrect in MINVAL intrinsic");

      if (unlikely (compile_options.bounds_check))
	{
	  for (n=0; n < rank; n++)
	    {
	      index_type ret_extent;

	      ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
	      if (extent[n] != ret_extent)
		runtime_error ("Incorrect extent in return value of"
			       " MINVAL intrinsic in dimension %ld:"
			       " is %ld, should be %ld", (long int) n + 1,
			       (long int) ret_extent, (long int) extent[n]);
	    }
          for (n=0; n<= rank; n++)
            {
              index_type mask_extent, array_extent;

	      array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
	      mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
	      if (array_extent != mask_extent)
		runtime_error ("Incorrect extent in MASK argument of"
			       " MINVAL intrinsic in dimension %ld:"
			       " is %ld, should be %ld", (long int) n + 1,
			       (long int) mask_extent, (long int) array_extent);
	    }
	}
    }

  for (n = 0; n < rank; n++)
    {
      count[n] = 0;
      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
      if (extent[n] <= 0)
        return;
    }

  dest = retarray->data;
  base = array->data;

  while (base)
    {
      const GFC_INTEGER_16 * restrict src;
      const GFC_LOGICAL_1 * restrict msrc;
      GFC_INTEGER_16 result;
      src = base;
      msrc = mbase;
      {

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

  if (*msrc && *src < result)
    result = *src;
              }
	    *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 probably 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];
            }
        }
    }
}


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

void
sminval_i16 (gfc_array_i16 * const restrict retarray, 
	gfc_array_i16 * const restrict array, 
	const index_type * const restrict pdim, 
	GFC_LOGICAL_4 * mask)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type dstride[GFC_MAX_DIMENSIONS];
  GFC_INTEGER_16 * restrict dest;
  index_type rank;
  index_type n;
  index_type dim;


  if (*mask)
    {
      minval_i16 (retarray, array, pdim);
      return;
    }
  /* Make dim zero based to avoid confusion.  */
  dim = (*pdim) - 1;
  rank = GFC_DESCRIPTOR_RANK (array) - 1;

  for (n = 0; n < dim; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);

      if (extent[n] <= 0)
	extent[n] = 0;
    }

  for (n = dim; n < rank; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
      extent[n] =
        GFC_DESCRIPTOR_EXTENT(array,n + 1);

      if (extent[n] <= 0)
        extent[n] = 0;
    }

  if (retarray->data == NULL)
    {
      size_t alloc_size, str;

      for (n = 0; n < rank; n++)
        {
          if (n == 0)
            str = 1;
          else
            str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];

	  GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);

        }

      retarray->offset = 0;
      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;

      alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
    		   * extent[rank-1];

      if (alloc_size == 0)
	{
	  /* Make sure we have a zero-sized array.  */
	  GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
	  return;
	}
      else
	retarray->data = internal_malloc_size (alloc_size);
    }
  else
    {
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
	runtime_error ("rank of return array incorrect in"
		       " MINVAL intrinsic: is %ld, should be %ld",
		       (long int) (GFC_DESCRIPTOR_RANK (retarray)),
		       (long int) rank);

      if (unlikely (compile_options.bounds_check))
	{
	  for (n=0; n < rank; n++)
	    {
	      index_type ret_extent;

	      ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
	      if (extent[n] != ret_extent)
		runtime_error ("Incorrect extent in return value of"
			       " MINVAL intrinsic in dimension %ld:"
			       " is %ld, should be %ld", (long int) n + 1,
			       (long int) ret_extent, (long int) extent[n]);
	    }
	}
    }

  for (n = 0; n < rank; n++)
    {
      count[n] = 0;
      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
    }

  dest = retarray->data;

  while(1)
    {
      *dest = GFC_INTEGER_16_HUGE;
      count[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 probably not worth it.  */
          dest -= dstride[n] * extent[n];
          n++;
          if (n == rank)
	    return;
          else
            {
              count[n]++;
              dest += dstride[n];
            }
      	}
    }
}

#endif
Commit	Line	Data
644cb69f	1	/* Implementation of the MINVAL intrinsic
748086b7	2	Copyright 2002, 2007, 2009 Free Software Foundation, Inc.
644cb69f FXC	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
748086b7	10	version 3 of the License, or (at your option) any later version.
644cb69f FXC	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 General Public License for more details.
	16
748086b7 JJ	17	Under Section 7 of GPL version 3, you are granted additional
	18	permissions described in the GCC Runtime Library Exception, version
	19	3.1, as published by the Free Software Foundation.
	20
	21	You should have received a copy of the GNU General Public License and
	22	a copy of the GCC Runtime Library Exception along with this program;
	23	see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
	24	<http://www.gnu.org/licenses/>. */
644cb69f	25
36ae8a61	26	#include "libgfortran.h"
644cb69f FXC	27	#include <stdlib.h>
644cb69f FXC	28	#include <assert.h>
644cb69f FXC	29
	30
	31	#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
	32
	33
64acfd99 JB	34	extern void minval_i16 (gfc_array_i16 * const restrict,
64acfd99 JB	35	gfc_array_i16 * const restrict, const index_type * const restrict);
644cb69f FXC	36	export_proto(minval_i16);
	37
	38	void
64acfd99 JB	39	minval_i16 (gfc_array_i16 * const restrict retarray,
	40	gfc_array_i16 * const restrict array,
	41	const index_type * const restrict pdim)
644cb69f FXC	42	{
	43	index_type count[GFC_MAX_DIMENSIONS];
	44	index_type extent[GFC_MAX_DIMENSIONS];
	45	index_type sstride[GFC_MAX_DIMENSIONS];
	46	index_type dstride[GFC_MAX_DIMENSIONS];
64acfd99 JB	47	const GFC_INTEGER_16 * restrict base;
64acfd99 JB	48	GFC_INTEGER_16 * restrict dest;
644cb69f FXC	49	index_type rank;
	50	index_type n;
	51	index_type len;
	52	index_type delta;
	53	index_type dim;
da96f5ab	54	int continue_loop;
644cb69f FXC	55
	56	/* Make dim zero based to avoid confusion. */
	57	dim = (*pdim) - 1;
	58	rank = GFC_DESCRIPTOR_RANK (array) - 1;
	59
dfb55fdc	60	len = GFC_DESCRIPTOR_EXTENT(array,dim);
da96f5ab TK	61	if (len < 0)
da96f5ab TK	62	len = 0;
dfb55fdc	63	delta = GFC_DESCRIPTOR_STRIDE(array,dim);
644cb69f FXC	64
	65	for (n = 0; n < dim; n++)
	66	{
dfb55fdc TK	67	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
dfb55fdc TK	68	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
80ee04b9 TK	69
	70	if (extent[n] < 0)
	71	extent[n] = 0;
644cb69f FXC	72	}
	73	for (n = dim; n < rank; n++)
	74	{
dfb55fdc TK	75	sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
dfb55fdc TK	76	extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
80ee04b9 TK	77
	78	if (extent[n] < 0)
	79	extent[n] = 0;
644cb69f FXC	80	}
	81
	82	if (retarray->data == NULL)
	83	{
dfb55fdc	84	size_t alloc_size, str;
80ee04b9	85
644cb69f FXC	86	for (n = 0; n < rank; n++)
644cb69f FXC	87	{
644cb69f	88	if (n == 0)
dfb55fdc	89	str = 1;
644cb69f	90	else
dfb55fdc TK	91	str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
	92
	93	GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
	94
644cb69f FXC	95	}
644cb69f FXC	96
644cb69f FXC	97	retarray->offset = 0;
644cb69f FXC	98	retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) \| rank;
80ee04b9	99
dfb55fdc	100	alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
80ee04b9 TK	101	* extent[rank-1];
	102
	103	if (alloc_size == 0)
	104	{
	105	/* Make sure we have a zero-sized array. */
dfb55fdc	106	GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
80ee04b9	107	return;
dfb55fdc	108
80ee04b9 TK	109	}
	110	else
	111	retarray->data = internal_malloc_size (alloc_size);
644cb69f FXC	112	}
	113	else
	114	{
644cb69f	115	if (rank != GFC_DESCRIPTOR_RANK (retarray))
fd6590f8	116	runtime_error ("rank of return array incorrect in"
ccacefc7 TK	117	" MINVAL intrinsic: is %ld, should be %ld",
	118	(long int) (GFC_DESCRIPTOR_RANK (retarray)),
	119	(long int) rank);
fd6590f8	120
9731c4a3	121	if (unlikely (compile_options.bounds_check))
fd6590f8 TK	122	{
	123	for (n=0; n < rank; n++)
	124	{
	125	index_type ret_extent;
	126
dfb55fdc	127	ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
fd6590f8 TK	128	if (extent[n] != ret_extent)
fd6590f8 TK	129	runtime_error ("Incorrect extent in return value of"
ccacefc7 TK	130	" MINVAL intrinsic in dimension %ld:"
ccacefc7 TK	131	" is %ld, should be %ld", (long int) n + 1,
fd6590f8 TK	132	(long int) ret_extent, (long int) extent[n]);
	133	}
	134	}
644cb69f FXC	135	}
	136
	137	for (n = 0; n < rank; n++)
	138	{
	139	count[n] = 0;
dfb55fdc	140	dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
644cb69f FXC	141	if (extent[n] <= 0)
	142	len = 0;
	143	}
	144
	145	base = array->data;
	146	dest = retarray->data;
	147
da96f5ab TK	148	continue_loop = 1;
da96f5ab TK	149	while (continue_loop)
644cb69f	150	{
64acfd99	151	const GFC_INTEGER_16 * restrict src;
644cb69f FXC	152	GFC_INTEGER_16 result;
	153	src = base;
	154	{
	155
	156	result = GFC_INTEGER_16_HUGE;
	157	if (len <= 0)
	158	*dest = GFC_INTEGER_16_HUGE;
	159	else
	160	{
	161	for (n = 0; n < len; n++, src += delta)
	162	{
	163
	164	if (*src < result)
	165	result = *src;
	166	}
	167	*dest = result;
	168	}
	169	}
	170	/* Advance to the next element. */
	171	count[0]++;
	172	base += sstride[0];
	173	dest += dstride[0];
	174	n = 0;
	175	while (count[n] == extent[n])
	176	{
	177	/* When we get to the end of a dimension, reset it and increment
	178	the next dimension. */
	179	count[n] = 0;
	180	/* We could precalculate these products, but this is a less
5d7adf7a	181	frequently used path so probably not worth it. */
644cb69f FXC	182	base -= sstride[n] * extent[n];
	183	dest -= dstride[n] * extent[n];
	184	n++;
	185	if (n == rank)
	186	{
	187	/* Break out of the look. */
da96f5ab TK	188	continue_loop = 0;
da96f5ab TK	189	break;
644cb69f FXC	190	}
	191	else
	192	{
	193	count[n]++;
	194	base += sstride[n];
	195	dest += dstride[n];
	196	}
	197	}
	198	}
	199	}
	200
	201
64acfd99 JB	202	extern void mminval_i16 (gfc_array_i16 * const restrict,
64acfd99 JB	203	gfc_array_i16 * const restrict, const index_type * const restrict,
28dc6b33	204	gfc_array_l1 * const restrict);
644cb69f FXC	205	export_proto(mminval_i16);
	206
	207	void
64acfd99 JB	208	mminval_i16 (gfc_array_i16 * const restrict retarray,
	209	gfc_array_i16 * const restrict array,
	210	const index_type * const restrict pdim,
28dc6b33	211	gfc_array_l1 * const restrict mask)
644cb69f FXC	212	{
	213	index_type count[GFC_MAX_DIMENSIONS];
	214	index_type extent[GFC_MAX_DIMENSIONS];
	215	index_type sstride[GFC_MAX_DIMENSIONS];
	216	index_type dstride[GFC_MAX_DIMENSIONS];
	217	index_type mstride[GFC_MAX_DIMENSIONS];
64acfd99 JB	218	GFC_INTEGER_16 * restrict dest;
64acfd99 JB	219	const GFC_INTEGER_16 * restrict base;
28dc6b33	220	const GFC_LOGICAL_1 * restrict mbase;
644cb69f FXC	221	int rank;
	222	int dim;
	223	index_type n;
	224	index_type len;
	225	index_type delta;
	226	index_type mdelta;
28dc6b33	227	int mask_kind;
644cb69f FXC	228
	229	dim = (*pdim) - 1;
	230	rank = GFC_DESCRIPTOR_RANK (array) - 1;
	231
dfb55fdc	232	len = GFC_DESCRIPTOR_EXTENT(array,dim);
644cb69f FXC	233	if (len <= 0)
644cb69f FXC	234	return;
28dc6b33 TK	235
	236	mbase = mask->data;
	237
	238	mask_kind = GFC_DESCRIPTOR_SIZE (mask);
	239
	240	if (mask_kind == 1 \|\| mask_kind == 2 \|\| mask_kind == 4 \|\| mask_kind == 8
	241	#ifdef HAVE_GFC_LOGICAL_16
	242	\|\| mask_kind == 16
	243	#endif
	244	)
	245	mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
	246	else
	247	runtime_error ("Funny sized logical array");
	248
dfb55fdc TK	249	delta = GFC_DESCRIPTOR_STRIDE(array,dim);
dfb55fdc TK	250	mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
644cb69f FXC	251
	252	for (n = 0; n < dim; n++)
	253	{
dfb55fdc TK	254	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
	255	mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
	256	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
80ee04b9 TK	257
	258	if (extent[n] < 0)
	259	extent[n] = 0;
	260
644cb69f FXC	261	}
	262	for (n = dim; n < rank; n++)
	263	{
dfb55fdc TK	264	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
	265	mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
	266	extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
80ee04b9 TK	267
	268	if (extent[n] < 0)
	269	extent[n] = 0;
644cb69f FXC	270	}
	271
	272	if (retarray->data == NULL)
	273	{
dfb55fdc	274	size_t alloc_size, str;
80ee04b9	275
644cb69f FXC	276	for (n = 0; n < rank; n++)
644cb69f FXC	277	{
644cb69f	278	if (n == 0)
dfb55fdc	279	str = 1;
644cb69f	280	else
dfb55fdc TK	281	str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
	282
	283	GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
	284
644cb69f FXC	285	}
644cb69f FXC	286
dfb55fdc	287	alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
80ee04b9 TK	288	* extent[rank-1];
80ee04b9 TK	289
644cb69f FXC	290	retarray->offset = 0;
644cb69f FXC	291	retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) \| rank;
80ee04b9 TK	292
	293	if (alloc_size == 0)
	294	{
	295	/* Make sure we have a zero-sized array. */
dfb55fdc	296	GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
80ee04b9 TK	297	return;
	298	}
	299	else
	300	retarray->data = internal_malloc_size (alloc_size);
	301
644cb69f FXC	302	}
	303	else
	304	{
644cb69f	305	if (rank != GFC_DESCRIPTOR_RANK (retarray))
fd6590f8 TK	306	runtime_error ("rank of return array incorrect in MINVAL intrinsic");
fd6590f8 TK	307
9731c4a3	308	if (unlikely (compile_options.bounds_check))
fd6590f8 TK	309	{
	310	for (n=0; n < rank; n++)
	311	{
	312	index_type ret_extent;
	313
dfb55fdc	314	ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
fd6590f8 TK	315	if (extent[n] != ret_extent)
fd6590f8 TK	316	runtime_error ("Incorrect extent in return value of"
ccacefc7 TK	317	" MINVAL intrinsic in dimension %ld:"
ccacefc7 TK	318	" is %ld, should be %ld", (long int) n + 1,
fd6590f8 TK	319	(long int) ret_extent, (long int) extent[n]);
	320	}
	321	for (n=0; n<= rank; n++)
	322	{
	323	index_type mask_extent, array_extent;
	324
dfb55fdc TK	325	array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
dfb55fdc TK	326	mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
fd6590f8 TK	327	if (array_extent != mask_extent)
fd6590f8 TK	328	runtime_error ("Incorrect extent in MASK argument of"
ccacefc7 TK	329	" MINVAL intrinsic in dimension %ld:"
ccacefc7 TK	330	" is %ld, should be %ld", (long int) n + 1,
fd6590f8 TK	331	(long int) mask_extent, (long int) array_extent);
	332	}
	333	}
644cb69f FXC	334	}
	335
	336	for (n = 0; n < rank; n++)
	337	{
	338	count[n] = 0;
dfb55fdc	339	dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
644cb69f FXC	340	if (extent[n] <= 0)
	341	return;
	342	}
	343
	344	dest = retarray->data;
	345	base = array->data;
644cb69f FXC	346
	347	while (base)
	348	{
64acfd99	349	const GFC_INTEGER_16 * restrict src;
28dc6b33	350	const GFC_LOGICAL_1 * restrict msrc;
644cb69f FXC	351	GFC_INTEGER_16 result;
	352	src = base;
	353	msrc = mbase;
	354	{
	355
	356	result = GFC_INTEGER_16_HUGE;
	357	if (len <= 0)
	358	*dest = GFC_INTEGER_16_HUGE;
	359	else
	360	{
	361	for (n = 0; n < len; n++, src += delta, msrc += mdelta)
	362	{
	363
	364	if (msrc && src < result)
	365	result = *src;
	366	}
	367	*dest = result;
	368	}
	369	}
	370	/* Advance to the next element. */
	371	count[0]++;
	372	base += sstride[0];
	373	mbase += mstride[0];
	374	dest += dstride[0];
	375	n = 0;
	376	while (count[n] == extent[n])
	377	{
	378	/* When we get to the end of a dimension, reset it and increment
	379	the next dimension. */
	380	count[n] = 0;
	381	/* We could precalculate these products, but this is a less
5d7adf7a	382	frequently used path so probably not worth it. */
644cb69f FXC	383	base -= sstride[n] * extent[n];
	384	mbase -= mstride[n] * extent[n];
	385	dest -= dstride[n] * extent[n];
	386	n++;
	387	if (n == rank)
	388	{
	389	/* Break out of the look. */
	390	base = NULL;
	391	break;
	392	}
	393	else
	394	{
	395	count[n]++;
	396	base += sstride[n];
	397	mbase += mstride[n];
	398	dest += dstride[n];
	399	}
	400	}
	401	}
	402	}
	403
97a62038 TK	404
	405	extern void sminval_i16 (gfc_array_i16 * const restrict,
	406	gfc_array_i16 * const restrict, const index_type * const restrict,
	407	GFC_LOGICAL_4 *);
	408	export_proto(sminval_i16);
	409
	410	void
	411	sminval_i16 (gfc_array_i16 * const restrict retarray,
	412	gfc_array_i16 * const restrict array,
	413	const index_type * const restrict pdim,
	414	GFC_LOGICAL_4 * mask)
	415	{
802367d7 TK	416	index_type count[GFC_MAX_DIMENSIONS];
	417	index_type extent[GFC_MAX_DIMENSIONS];
	418	index_type sstride[GFC_MAX_DIMENSIONS];
	419	index_type dstride[GFC_MAX_DIMENSIONS];
	420	GFC_INTEGER_16 * restrict dest;
97a62038 TK	421	index_type rank;
97a62038 TK	422	index_type n;
802367d7 TK	423	index_type dim;
802367d7 TK	424
97a62038 TK	425
	426	if (*mask)
	427	{
	428	minval_i16 (retarray, array, pdim);
	429	return;
	430	}
802367d7 TK	431	/* Make dim zero based to avoid confusion. */
	432	dim = (*pdim) - 1;
	433	rank = GFC_DESCRIPTOR_RANK (array) - 1;
	434
	435	for (n = 0; n < dim; n++)
	436	{
dfb55fdc TK	437	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
dfb55fdc TK	438	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
802367d7 TK	439
	440	if (extent[n] <= 0)
	441	extent[n] = 0;
	442	}
	443
	444	for (n = dim; n < rank; n++)
	445	{
dfb55fdc	446	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
802367d7	447	extent[n] =
dfb55fdc	448	GFC_DESCRIPTOR_EXTENT(array,n + 1);
802367d7 TK	449
	450	if (extent[n] <= 0)
	451	extent[n] = 0;
	452	}
97a62038 TK	453
	454	if (retarray->data == NULL)
	455	{
dfb55fdc	456	size_t alloc_size, str;
802367d7 TK	457
	458	for (n = 0; n < rank; n++)
	459	{
802367d7	460	if (n == 0)
dfb55fdc	461	str = 1;
802367d7	462	else
dfb55fdc TK	463	str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
	464
	465	GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
	466
802367d7 TK	467	}
802367d7 TK	468
97a62038	469	retarray->offset = 0;
802367d7 TK	470	retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) \| rank;
802367d7 TK	471
dfb55fdc	472	alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
802367d7 TK	473	* extent[rank-1];
	474
	475	if (alloc_size == 0)
	476	{
	477	/* Make sure we have a zero-sized array. */
dfb55fdc	478	GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
802367d7 TK	479	return;
	480	}
	481	else
	482	retarray->data = internal_malloc_size (alloc_size);
97a62038 TK	483	}
	484	else
	485	{
802367d7 TK	486	if (rank != GFC_DESCRIPTOR_RANK (retarray))
	487	runtime_error ("rank of return array incorrect in"
	488	" MINVAL intrinsic: is %ld, should be %ld",
	489	(long int) (GFC_DESCRIPTOR_RANK (retarray)),
	490	(long int) rank);
	491
9731c4a3	492	if (unlikely (compile_options.bounds_check))
fd6590f8	493	{
802367d7 TK	494	for (n=0; n < rank; n++)
	495	{
	496	index_type ret_extent;
97a62038	497
dfb55fdc	498	ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
802367d7 TK	499	if (extent[n] != ret_extent)
	500	runtime_error ("Incorrect extent in return value of"
	501	" MINVAL intrinsic in dimension %ld:"
	502	" is %ld, should be %ld", (long int) n + 1,
	503	(long int) ret_extent, (long int) extent[n]);
	504	}
fd6590f8 TK	505	}
fd6590f8 TK	506	}
97a62038	507
802367d7 TK	508	for (n = 0; n < rank; n++)
	509	{
	510	count[n] = 0;
dfb55fdc	511	dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
802367d7 TK	512	}
	513
	514	dest = retarray->data;
	515
	516	while(1)
	517	{
	518	*dest = GFC_INTEGER_16_HUGE;
	519	count[0]++;
	520	dest += dstride[0];
	521	n = 0;
	522	while (count[n] == extent[n])
	523	{
	524	/* When we get to the end of a dimension, reset it and increment
	525	the next dimension. */
	526	count[n] = 0;
	527	/* We could precalculate these products, but this is a less
	528	frequently used path so probably not worth it. */
	529	dest -= dstride[n] * extent[n];
	530	n++;
	531	if (n == rank)
	532	return;
	533	else
	534	{
	535	count[n]++;
	536	dest += dstride[n];
	537	}
	538	}
	539	}
97a62038 TK	540	}
97a62038 TK	541
644cb69f	542	#endif