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

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


#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4)


extern void maxloc0_4_r16 (gfc_array_i4 * const restrict retarray, 
	gfc_array_r16 * const restrict array);
export_proto(maxloc0_4_r16);

void
maxloc0_4_r16 (gfc_array_i4 * const restrict retarray, 
	gfc_array_r16 * 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_REAL_16 *base;
  GFC_INTEGER_4 *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_4) * rank);
    }
  else
    {
      if (compile_options.bounds_check)
	{
	  int ret_rank;
	  index_type ret_extent;

	  ret_rank = GFC_DESCRIPTOR_RANK (retarray);
	  if (ret_rank != 1)
	    runtime_error ("rank of return array in MAXLOC intrinsic"
			   " should be 1, is %d", ret_rank);

	  ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
	  if (ret_extent != rank)
	    runtime_error ("Incorrect extent in return value of"
			   " MAXLOC intrnisic: is %ld, should be %d",
			   (long int) ret_extent, rank);
	}
    }

  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_REAL_16 maxval;

  maxval = -GFC_REAL_16_HUGE;

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

  if (*base > maxval || !dest[0])
    {
      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 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 mmaxloc0_4_r16 (gfc_array_i4 * const restrict, 
	gfc_array_r16 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_4_r16);

void
mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray, 
	gfc_array_r16 * 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_4 *dest;
  const GFC_REAL_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_4) * rank);
    }
  else
    {
      if (compile_options.bounds_check)
	{
	  int ret_rank, mask_rank;
	  index_type ret_extent;
	  int n;
	  index_type array_extent, mask_extent;

	  ret_rank = GFC_DESCRIPTOR_RANK (retarray);
	  if (ret_rank != 1)
	    runtime_error ("rank of return array in MAXLOC intrinsic"
			   " should be 1, is %d", ret_rank);

	  ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
	  if (ret_extent != rank)
	    runtime_error ("Incorrect extent in return value of"
			   " MAXLOC intrnisic: is %ld, should be %d",
			   (long int) ret_extent, rank);
	
	  mask_rank = GFC_DESCRIPTOR_RANK (mask);
	  if (rank != mask_rank)
	    runtime_error ("rank of MASK argument in MAXLOC intrnisic"
	                   "should be %d, is %d", rank, mask_rank);

	  for (n=0; n<rank; n++)
	    {
	      array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
	      mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
	      if (array_extent != mask_extent)
		runtime_error ("Incorrect extent in MASK argument of"
			       " MAXLOC intrinsic in dimension %d:"
			       " is %ld, should be %ld", n + 1,
			       (long int) mask_extent, (long int) array_extent);
	    }
	}
    }

  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_REAL_16 maxval;

  maxval = -GFC_REAL_16_HUGE;

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

  if (*mbase && (*base > maxval || !dest[0]))
    {
      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 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 smaxloc0_4_r16 (gfc_array_i4 * const restrict, 
	gfc_array_r16 * const restrict, GFC_LOGICAL_4 *);
export_proto(smaxloc0_4_r16);

void
smaxloc0_4_r16 (gfc_array_i4 * const restrict retarray, 
	gfc_array_r16 * const restrict array,
	GFC_LOGICAL_4 * mask)
{
  index_type rank;
  index_type dstride;
  index_type n;
  GFC_INTEGER_4 *dest;

  if (*mask)
    {
      maxloc0_4_r16 (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_4) * rank);
    }
  else
    {
      if (compile_options.bounds_check)
	{
	  int ret_rank;
	  index_type ret_extent;

	  ret_rank = GFC_DESCRIPTOR_RANK (retarray);
	  if (ret_rank != 1)
	    runtime_error ("rank of return array in MAXLOC intrinsic"
			   " should be 1, is %d", ret_rank);

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