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

/* Implementation of the MAXVAL 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 <float.h>
#include "libgfortran.h"


#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_REAL_8)


extern void maxval_r8 (gfc_array_r8 * const restrict, 
	gfc_array_r8 * const restrict, const index_type * const restrict);
export_proto(maxval_r8);

void
maxval_r8 (gfc_array_r8 * const restrict retarray, 
	gfc_array_r8 * 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_REAL_8 * restrict base;
  GFC_REAL_8 * restrict 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;

  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_size (sizeof (GFC_REAL_8)
		 		 * retarray->dim[rank-1].stride
				 * extent[rank-1]);
      retarray->offset = 0;
      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
    }
  else
    {
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
	runtime_error ("rank of return array incorrect");
    }

  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)
    {
      const GFC_REAL_8 * restrict src;
      GFC_REAL_8 result;
      src = base;
      {

  result = -GFC_REAL_8_HUGE;
        if (len <= 0)
	  *dest = -GFC_REAL_8_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.  */
              base = NULL;
              break;
            }
          else
            {
              count[n]++;
              base += sstride[n];
              dest += dstride[n];
            }
        }
    }
}


extern void mmaxval_r8 (gfc_array_r8 * const restrict, 
	gfc_array_r8 * const restrict, const index_type * const restrict,
	gfc_array_l4 * const restrict);
export_proto(mmaxval_r8);

void
mmaxval_r8 (gfc_array_r8 * const restrict retarray, 
	gfc_array_r8 * const restrict array, 
	const index_type * const restrict pdim, 
	gfc_array_l4 * 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_REAL_8 * restrict dest;
  const GFC_REAL_8 * restrict base;
  const GFC_LOGICAL_4 * restrict 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;

  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;
    }

  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_size (sizeof (GFC_REAL_8)
		 		 * retarray->dim[rank-1].stride
				 * extent[rank-1]);
      retarray->offset = 0;
      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
    }
  else
    {
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
	runtime_error ("rank of return array incorrect");
    }

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

  result = -GFC_REAL_8_HUGE;
        if (len <= 0)
	  *dest = -GFC_REAL_8_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 smaxval_r8 (gfc_array_r8 * const restrict, 
	gfc_array_r8 * const restrict, const index_type * const restrict,
	GFC_LOGICAL_4 *);
export_proto(smaxval_r8);

void
smaxval_r8 (gfc_array_r8 * const restrict retarray, 
	gfc_array_r8 * const restrict array, 
	const index_type * const restrict pdim, 
	GFC_LOGICAL_4 * mask)
{
  index_type rank;
  index_type n;
  index_type dstride;
  GFC_REAL_8 *dest;

  if (*mask)
    {
      maxval_r8 (retarray, array, pdim);
      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_REAL_8) * 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] = -GFC_REAL_8_HUGE ;
}

#endif
Commit	Line	Data
6de9cd9a DN	1	/* Implementation of the MAXVAL intrinsic
	2	Copyright 2002 Free Software Foundation, Inc.
	3	Contributed by Paul Brook <paul@nowt.org>
	4
57dea9f6	5	This file is part of the GNU Fortran 95 runtime library (libgfortran).
6de9cd9a DN	6
6de9cd9a DN	7	Libgfortran is free software; you can redistribute it and/or
57dea9f6	8	modify it under the terms of the GNU General Public
6de9cd9a	9	License as published by the Free Software Foundation; either
57dea9f6 TM	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.)
6de9cd9a DN	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
57dea9f6	24	GNU General Public License for more details.
6de9cd9a	25
57dea9f6 TM	26	You should have received a copy of the GNU General Public
57dea9f6 TM	27	License along with libgfortran; see the file COPYING. If not,
fe2ae685 KC	28	write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
fe2ae685 KC	29	Boston, MA 02110-1301, USA. */
6de9cd9a DN	30
	31	#include "config.h"
	32	#include <stdlib.h>
	33	#include <assert.h>
	34	#include <float.h>
	35	#include "libgfortran.h"
	36
7d7b8bfe	37
644cb69f FXC	38	#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_REAL_8)
	39
	40
64acfd99 JB	41	extern void maxval_r8 (gfc_array_r8 * const restrict,
64acfd99 JB	42	gfc_array_r8 * const restrict, const index_type * const restrict);
7f68c75f	43	export_proto(maxval_r8);
7d7b8bfe	44
6de9cd9a	45	void
64acfd99 JB	46	maxval_r8 (gfc_array_r8 * const restrict retarray,
	47	gfc_array_r8 * const restrict array,
	48	const index_type * const restrict pdim)
6de9cd9a	49	{
e33e218b TK	50	index_type count[GFC_MAX_DIMENSIONS];
	51	index_type extent[GFC_MAX_DIMENSIONS];
	52	index_type sstride[GFC_MAX_DIMENSIONS];
	53	index_type dstride[GFC_MAX_DIMENSIONS];
64acfd99 JB	54	const GFC_REAL_8 * restrict base;
64acfd99 JB	55	GFC_REAL_8 * restrict dest;
6de9cd9a DN	56	index_type rank;
	57	index_type n;
	58	index_type len;
	59	index_type delta;
	60	index_type dim;
	61
	62	/* Make dim zero based to avoid confusion. */
	63	dim = (*pdim) - 1;
	64	rank = GFC_DESCRIPTOR_RANK (array) - 1;
e33e218b	65
6de9cd9a DN	66	len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
	67	delta = array->dim[dim].stride;
	68
	69	for (n = 0; n < dim; n++)
	70	{
	71	sstride[n] = array->dim[n].stride;
	72	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
	73	}
	74	for (n = dim; n < rank; n++)
	75	{
	76	sstride[n] = array->dim[n + 1].stride;
	77	extent[n] =
	78	array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
	79	}
	80
6c167c45 VL	81	if (retarray->data == NULL)
	82	{
	83	for (n = 0; n < rank; n++)
	84	{
	85	retarray->dim[n].lbound = 0;
	86	retarray->dim[n].ubound = extent[n]-1;
	87	if (n == 0)
	88	retarray->dim[n].stride = 1;
	89	else
	90	retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
	91	}
	92
07d3cebe RH	93	retarray->data
	94	= internal_malloc_size (sizeof (GFC_REAL_8)
	95	* retarray->dim[rank-1].stride
	96	* extent[rank-1]);
efd4dc1a	97	retarray->offset = 0;
50dd63a9	98	retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) \| rank;
6c167c45	99	}
50dd63a9 TK	100	else
50dd63a9 TK	101	{
50dd63a9 TK	102	if (rank != GFC_DESCRIPTOR_RANK (retarray))
	103	runtime_error ("rank of return array incorrect");
	104	}
	105
6de9cd9a DN	106	for (n = 0; n < rank; n++)
	107	{
	108	count[n] = 0;
	109	dstride[n] = retarray->dim[n].stride;
	110	if (extent[n] <= 0)
	111	len = 0;
	112	}
	113
	114	base = array->data;
	115	dest = retarray->data;
	116
	117	while (base)
	118	{
64acfd99	119	const GFC_REAL_8 * restrict src;
6de9cd9a DN	120	GFC_REAL_8 result;
	121	src = base;
	122	{
	123
	124	result = -GFC_REAL_8_HUGE;
	125	if (len <= 0)
	126	*dest = -GFC_REAL_8_HUGE;
	127	else
	128	{
	129	for (n = 0; n < len; n++, src += delta)
	130	{
	131
	132	if (*src > result)
	133	result = *src;
	134	}
	135	*dest = result;
	136	}
	137	}
	138	/* Advance to the next element. */
	139	count[0]++;
	140	base += sstride[0];
	141	dest += dstride[0];
	142	n = 0;
	143	while (count[n] == extent[n])
	144	{
	145	/* When we get to the end of a dimension, reset it and increment
	146	the next dimension. */
	147	count[n] = 0;
	148	/* We could precalculate these products, but this is a less
5d7adf7a	149	frequently used path so probably not worth it. */
6de9cd9a DN	150	base -= sstride[n] * extent[n];
	151	dest -= dstride[n] * extent[n];
	152	n++;
	153	if (n == rank)
	154	{
	155	/* Break out of the look. */
	156	base = NULL;
	157	break;
	158	}
	159	else
	160	{
	161	count[n]++;
	162	base += sstride[n];
	163	dest += dstride[n];
	164	}
	165	}
	166	}
	167	}
	168
7d7b8bfe	169
64acfd99 JB	170	extern void mmaxval_r8 (gfc_array_r8 * const restrict,
	171	gfc_array_r8 * const restrict, const index_type * const restrict,
	172	gfc_array_l4 * const restrict);
7f68c75f	173	export_proto(mmaxval_r8);
7d7b8bfe	174
6de9cd9a	175	void
64acfd99 JB	176	mmaxval_r8 (gfc_array_r8 * const restrict retarray,
	177	gfc_array_r8 * const restrict array,
	178	const index_type * const restrict pdim,
	179	gfc_array_l4 * const restrict mask)
6de9cd9a	180	{
e33e218b TK	181	index_type count[GFC_MAX_DIMENSIONS];
	182	index_type extent[GFC_MAX_DIMENSIONS];
	183	index_type sstride[GFC_MAX_DIMENSIONS];
	184	index_type dstride[GFC_MAX_DIMENSIONS];
	185	index_type mstride[GFC_MAX_DIMENSIONS];
64acfd99 JB	186	GFC_REAL_8 * restrict dest;
	187	const GFC_REAL_8 * restrict base;
	188	const GFC_LOGICAL_4 * restrict mbase;
6de9cd9a DN	189	int rank;
	190	int dim;
	191	index_type n;
	192	index_type len;
	193	index_type delta;
	194	index_type mdelta;
	195
	196	dim = (*pdim) - 1;
	197	rank = GFC_DESCRIPTOR_RANK (array) - 1;
e33e218b	198
6de9cd9a DN	199	len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
	200	if (len <= 0)
	201	return;
	202	delta = array->dim[dim].stride;
	203	mdelta = mask->dim[dim].stride;
	204
	205	for (n = 0; n < dim; n++)
	206	{
	207	sstride[n] = array->dim[n].stride;
	208	mstride[n] = mask->dim[n].stride;
	209	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
	210	}
	211	for (n = dim; n < rank; n++)
	212	{
	213	sstride[n] = array->dim[n + 1].stride;
	214	mstride[n] = mask->dim[n + 1].stride;
	215	extent[n] =
	216	array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
	217	}
	218
50dd63a9 TK	219	if (retarray->data == NULL)
	220	{
	221	for (n = 0; n < rank; n++)
	222	{
	223	retarray->dim[n].lbound = 0;
	224	retarray->dim[n].ubound = extent[n]-1;
	225	if (n == 0)
	226	retarray->dim[n].stride = 1;
	227	else
	228	retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
	229	}
	230
	231	retarray->data
	232	= internal_malloc_size (sizeof (GFC_REAL_8)
	233	* retarray->dim[rank-1].stride
	234	* extent[rank-1]);
efd4dc1a	235	retarray->offset = 0;
50dd63a9 TK	236	retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) \| rank;
	237	}
	238	else
	239	{
50dd63a9 TK	240	if (rank != GFC_DESCRIPTOR_RANK (retarray))
	241	runtime_error ("rank of return array incorrect");
	242	}
	243
6de9cd9a DN	244	for (n = 0; n < rank; n++)
	245	{
	246	count[n] = 0;
	247	dstride[n] = retarray->dim[n].stride;
	248	if (extent[n] <= 0)
	249	return;
	250	}
	251
	252	dest = retarray->data;
	253	base = array->data;
	254	mbase = mask->data;
	255
	256	if (GFC_DESCRIPTOR_SIZE (mask) != 4)
	257	{
	258	/* This allows the same loop to be used for all logical types. */
	259	assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
	260	for (n = 0; n < rank; n++)
	261	mstride[n] <<= 1;
	262	mdelta <<= 1;
	263	mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
	264	}
	265
	266	while (base)
	267	{
64acfd99 JB	268	const GFC_REAL_8 * restrict src;
64acfd99 JB	269	const GFC_LOGICAL_4 * restrict msrc;
6de9cd9a DN	270	GFC_REAL_8 result;
	271	src = base;
	272	msrc = mbase;
	273	{
	274
	275	result = -GFC_REAL_8_HUGE;
	276	if (len <= 0)
	277	*dest = -GFC_REAL_8_HUGE;
	278	else
	279	{
	280	for (n = 0; n < len; n++, src += delta, msrc += mdelta)
	281	{
	282
	283	if (msrc && src > result)
	284	result = *src;
	285	}
	286	*dest = result;
	287	}
	288	}
	289	/* Advance to the next element. */
	290	count[0]++;
	291	base += sstride[0];
	292	mbase += mstride[0];
	293	dest += dstride[0];
	294	n = 0;
	295	while (count[n] == extent[n])
	296	{
	297	/* When we get to the end of a dimension, reset it and increment
	298	the next dimension. */
	299	count[n] = 0;
	300	/* We could precalculate these products, but this is a less
5d7adf7a	301	frequently used path so probably not worth it. */
6de9cd9a DN	302	base -= sstride[n] * extent[n];
	303	mbase -= mstride[n] * extent[n];
	304	dest -= dstride[n] * extent[n];
	305	n++;
	306	if (n == rank)
	307	{
	308	/* Break out of the look. */
	309	base = NULL;
	310	break;
	311	}
	312	else
	313	{
	314	count[n]++;
	315	base += sstride[n];
	316	mbase += mstride[n];
	317	dest += dstride[n];
	318	}
	319	}
	320	}
	321	}
	322
97a62038 TK	323
	324	extern void smaxval_r8 (gfc_array_r8 * const restrict,
	325	gfc_array_r8 * const restrict, const index_type * const restrict,
	326	GFC_LOGICAL_4 *);
	327	export_proto(smaxval_r8);
	328
	329	void
	330	smaxval_r8 (gfc_array_r8 * const restrict retarray,
	331	gfc_array_r8 * const restrict array,
	332	const index_type * const restrict pdim,
	333	GFC_LOGICAL_4 * mask)
	334	{
	335	index_type rank;
	336	index_type n;
	337	index_type dstride;
	338	GFC_REAL_8 *dest;
	339
	340	if (*mask)
	341	{
	342	maxval_r8 (retarray, array, pdim);
	343	return;
	344	}
	345	rank = GFC_DESCRIPTOR_RANK (array);
	346	if (rank <= 0)
	347	runtime_error ("Rank of array needs to be > 0");
	348
	349	if (retarray->data == NULL)
	350	{
	351	retarray->dim[0].lbound = 0;
	352	retarray->dim[0].ubound = rank-1;
	353	retarray->dim[0].stride = 1;
	354	retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) \| 1;
	355	retarray->offset = 0;
	356	retarray->data = internal_malloc_size (sizeof (GFC_REAL_8) * rank);
	357	}
	358	else
	359	{
	360	if (GFC_DESCRIPTOR_RANK (retarray) != 1)
	361	runtime_error ("rank of return array does not equal 1");
	362
	363	if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
	364	runtime_error ("dimension of return array incorrect");
97a62038 TK	365	}
	366
	367	dstride = retarray->dim[0].stride;
	368	dest = retarray->data;
	369
	370	for (n = 0; n < rank; n++)
	371	dest[n * dstride] = -GFC_REAL_8_HUGE ;
	372	}
	373
644cb69f	374	#endif