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

/* Implementation of the SUM 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 "libgfortran.h"


#if defined (HAVE_GFC_COMPLEX_16) && defined (HAVE_GFC_COMPLEX_16)


extern void sum_c16 (gfc_array_c16 * const restrict, 
	gfc_array_c16 * const restrict, const index_type * const restrict);
export_proto(sum_c16);

void
sum_c16 (gfc_array_c16 * const restrict retarray, 
	gfc_array_c16 * 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_COMPLEX_16 * restrict base;
  GFC_COMPLEX_16 * 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;

      if (extent[n] < 0)
	extent[n] = 0;
    }
  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 (extent[n] < 0)
	extent[n] = 0;
    }

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

      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->offset = 0;
      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;

      alloc_size = sizeof (GFC_COMPLEX_16) * retarray->dim[rank-1].stride
    		   * extent[rank-1];

      if (alloc_size == 0)
	{
	  /* Make sure we have a zero-sized array.  */
	  retarray->dim[0].lbound = 0;
	  retarray->dim[0].ubound = -1;
	  return;
	}
      else
	retarray->data = internal_malloc_size (alloc_size);
    }
  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_COMPLEX_16 * restrict src;
      GFC_COMPLEX_16 result;
      src = base;
      {

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

  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 msum_c16 (gfc_array_c16 * const restrict, 
	gfc_array_c16 * const restrict, const index_type * const restrict,
	gfc_array_l4 * const restrict);
export_proto(msum_c16);

void
msum_c16 (gfc_array_c16 * const restrict retarray, 
	gfc_array_c16 * 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_COMPLEX_16 * restrict dest;
  const GFC_COMPLEX_16 * 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;

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

    }
  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 (extent[n] < 0)
	extent[n] = 0;
    }

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

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

      alloc_size = sizeof (GFC_COMPLEX_16) * retarray->dim[rank-1].stride
    		   * 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.  */
	  retarray->dim[0].lbound = 0;
	  retarray->dim[0].ubound = -1;
	  return;
	}
      else
	retarray->data = internal_malloc_size (alloc_size);

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

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

  if (*msrc)
    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 ssum_c16 (gfc_array_c16 * const restrict, 
	gfc_array_c16 * const restrict, const index_type * const restrict,
	GFC_LOGICAL_4 *);
export_proto(ssum_c16);

void
ssum_c16 (gfc_array_c16 * const restrict retarray, 
	gfc_array_c16 * const restrict array, 
	const index_type * const restrict pdim, 
	GFC_LOGICAL_4 * mask)
{
  index_type rank;
  index_type n;
  index_type dstride;
  GFC_COMPLEX_16 *dest;

  if (*mask)
    {
      sum_c16 (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_COMPLEX_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 SUM 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>
	34	#include "libgfortran.h"
	35
	36
	37	#if defined (HAVE_GFC_COMPLEX_16) && defined (HAVE_GFC_COMPLEX_16)
	38
	39
64acfd99 JB	40	extern void sum_c16 (gfc_array_c16 * const restrict,
64acfd99 JB	41	gfc_array_c16 * const restrict, const index_type * const restrict);
644cb69f FXC	42	export_proto(sum_c16);
	43
	44	void
64acfd99 JB	45	sum_c16 (gfc_array_c16 * const restrict retarray,
	46	gfc_array_c16 * const restrict array,
	47	const index_type * const restrict pdim)
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[GFC_MAX_DIMENSIONS];
64acfd99 JB	53	const GFC_COMPLEX_16 * restrict base;
64acfd99 JB	54	GFC_COMPLEX_16 * restrict dest;
644cb69f FXC	55	index_type rank;
	56	index_type n;
	57	index_type len;
	58	index_type delta;
	59	index_type dim;
	60
	61	/* Make dim zero based to avoid confusion. */
	62	dim = (*pdim) - 1;
	63	rank = GFC_DESCRIPTOR_RANK (array) - 1;
	64
644cb69f FXC	65	len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
	66	delta = array->dim[dim].stride;
	67
	68	for (n = 0; n < dim; n++)
	69	{
	70	sstride[n] = array->dim[n].stride;
	71	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
80ee04b9 TK	72
	73	if (extent[n] < 0)
	74	extent[n] = 0;
644cb69f FXC	75	}
	76	for (n = dim; n < rank; n++)
	77	{
	78	sstride[n] = array->dim[n + 1].stride;
	79	extent[n] =
	80	array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
80ee04b9 TK	81
	82	if (extent[n] < 0)
	83	extent[n] = 0;
644cb69f FXC	84	}
	85
	86	if (retarray->data == NULL)
	87	{
80ee04b9 TK	88	size_t alloc_size;
80ee04b9 TK	89
644cb69f FXC	90	for (n = 0; n < rank; n++)
	91	{
	92	retarray->dim[n].lbound = 0;
	93	retarray->dim[n].ubound = extent[n]-1;
	94	if (n == 0)
	95	retarray->dim[n].stride = 1;
	96	else
	97	retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
	98	}
	99
644cb69f FXC	100	retarray->offset = 0;
644cb69f FXC	101	retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) \| rank;
80ee04b9 TK	102
	103	alloc_size = sizeof (GFC_COMPLEX_16) * retarray->dim[rank-1].stride
	104	* extent[rank-1];
	105
	106	if (alloc_size == 0)
	107	{
	108	/* Make sure we have a zero-sized array. */
	109	retarray->dim[0].lbound = 0;
	110	retarray->dim[0].ubound = -1;
	111	return;
	112	}
	113	else
	114	retarray->data = internal_malloc_size (alloc_size);
644cb69f FXC	115	}
	116	else
	117	{
644cb69f FXC	118	if (rank != GFC_DESCRIPTOR_RANK (retarray))
	119	runtime_error ("rank of return array incorrect");
	120	}
	121
	122	for (n = 0; n < rank; n++)
	123	{
	124	count[n] = 0;
	125	dstride[n] = retarray->dim[n].stride;
	126	if (extent[n] <= 0)
	127	len = 0;
	128	}
	129
	130	base = array->data;
	131	dest = retarray->data;
	132
	133	while (base)
	134	{
64acfd99	135	const GFC_COMPLEX_16 * restrict src;
644cb69f FXC	136	GFC_COMPLEX_16 result;
	137	src = base;
	138	{
	139
	140	result = 0;
	141	if (len <= 0)
	142	*dest = 0;
	143	else
	144	{
	145	for (n = 0; n < len; n++, src += delta)
	146	{
	147
	148	result += *src;
	149	}
	150	*dest = result;
	151	}
	152	}
	153	/* Advance to the next element. */
	154	count[0]++;
	155	base += sstride[0];
	156	dest += dstride[0];
	157	n = 0;
	158	while (count[n] == extent[n])
	159	{
	160	/* When we get to the end of a dimension, reset it and increment
	161	the next dimension. */
	162	count[n] = 0;
	163	/* We could precalculate these products, but this is a less
5d7adf7a	164	frequently used path so probably not worth it. */
644cb69f FXC	165	base -= sstride[n] * extent[n];
	166	dest -= dstride[n] * extent[n];
	167	n++;
	168	if (n == rank)
	169	{
	170	/* Break out of the look. */
	171	base = NULL;
	172	break;
	173	}
	174	else
	175	{
	176	count[n]++;
	177	base += sstride[n];
	178	dest += dstride[n];
	179	}
	180	}
	181	}
	182	}
	183
	184
64acfd99 JB	185	extern void msum_c16 (gfc_array_c16 * const restrict,
	186	gfc_array_c16 * const restrict, const index_type * const restrict,
	187	gfc_array_l4 * const restrict);
644cb69f FXC	188	export_proto(msum_c16);
	189
	190	void
64acfd99 JB	191	msum_c16 (gfc_array_c16 * const restrict retarray,
	192	gfc_array_c16 * const restrict array,
	193	const index_type * const restrict pdim,
	194	gfc_array_l4 * const restrict mask)
644cb69f FXC	195	{
	196	index_type count[GFC_MAX_DIMENSIONS];
	197	index_type extent[GFC_MAX_DIMENSIONS];
	198	index_type sstride[GFC_MAX_DIMENSIONS];
	199	index_type dstride[GFC_MAX_DIMENSIONS];
	200	index_type mstride[GFC_MAX_DIMENSIONS];
64acfd99 JB	201	GFC_COMPLEX_16 * restrict dest;
	202	const GFC_COMPLEX_16 * restrict base;
	203	const GFC_LOGICAL_4 * restrict mbase;
644cb69f FXC	204	int rank;
	205	int dim;
	206	index_type n;
	207	index_type len;
	208	index_type delta;
	209	index_type mdelta;
	210
	211	dim = (*pdim) - 1;
	212	rank = GFC_DESCRIPTOR_RANK (array) - 1;
	213
644cb69f FXC	214	len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
	215	if (len <= 0)
	216	return;
	217	delta = array->dim[dim].stride;
	218	mdelta = mask->dim[dim].stride;
	219
	220	for (n = 0; n < dim; n++)
	221	{
	222	sstride[n] = array->dim[n].stride;
	223	mstride[n] = mask->dim[n].stride;
	224	extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
80ee04b9 TK	225
	226	if (extent[n] < 0)
	227	extent[n] = 0;
	228
644cb69f FXC	229	}
	230	for (n = dim; n < rank; n++)
	231	{
	232	sstride[n] = array->dim[n + 1].stride;
	233	mstride[n] = mask->dim[n + 1].stride;
	234	extent[n] =
	235	array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
80ee04b9 TK	236
	237	if (extent[n] < 0)
	238	extent[n] = 0;
644cb69f FXC	239	}
	240
	241	if (retarray->data == NULL)
	242	{
80ee04b9 TK	243	size_t alloc_size;
80ee04b9 TK	244
644cb69f FXC	245	for (n = 0; n < rank; n++)
	246	{
	247	retarray->dim[n].lbound = 0;
	248	retarray->dim[n].ubound = extent[n]-1;
	249	if (n == 0)
	250	retarray->dim[n].stride = 1;
	251	else
	252	retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
	253	}
	254
80ee04b9 TK	255	alloc_size = sizeof (GFC_COMPLEX_16) * retarray->dim[rank-1].stride
	256	* extent[rank-1];
	257
644cb69f FXC	258	retarray->offset = 0;
644cb69f FXC	259	retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) \| rank;
80ee04b9 TK	260
	261	if (alloc_size == 0)
	262	{
	263	/* Make sure we have a zero-sized array. */
	264	retarray->dim[0].lbound = 0;
	265	retarray->dim[0].ubound = -1;
	266	return;
	267	}
	268	else
	269	retarray->data = internal_malloc_size (alloc_size);
	270
644cb69f FXC	271	}
	272	else
	273	{
644cb69f FXC	274	if (rank != GFC_DESCRIPTOR_RANK (retarray))
	275	runtime_error ("rank of return array incorrect");
	276	}
	277
	278	for (n = 0; n < rank; n++)
	279	{
	280	count[n] = 0;
	281	dstride[n] = retarray->dim[n].stride;
	282	if (extent[n] <= 0)
	283	return;
	284	}
	285
	286	dest = retarray->data;
	287	base = array->data;
	288	mbase = mask->data;
	289
	290	if (GFC_DESCRIPTOR_SIZE (mask) != 4)
	291	{
	292	/* This allows the same loop to be used for all logical types. */
	293	assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
	294	for (n = 0; n < rank; n++)
	295	mstride[n] <<= 1;
	296	mdelta <<= 1;
	297	mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
	298	}
	299
	300	while (base)
	301	{
64acfd99 JB	302	const GFC_COMPLEX_16 * restrict src;
64acfd99 JB	303	const GFC_LOGICAL_4 * restrict msrc;
644cb69f FXC	304	GFC_COMPLEX_16 result;
	305	src = base;
	306	msrc = mbase;
	307	{
	308
	309	result = 0;
	310	if (len <= 0)
	311	*dest = 0;
	312	else
	313	{
	314	for (n = 0; n < len; n++, src += delta, msrc += mdelta)
	315	{
	316
	317	if (*msrc)
	318	result += *src;
	319	}
	320	*dest = result;
	321	}
	322	}
	323	/* Advance to the next element. */
	324	count[0]++;
	325	base += sstride[0];
	326	mbase += mstride[0];
	327	dest += dstride[0];
	328	n = 0;
	329	while (count[n] == extent[n])
	330	{
	331	/* When we get to the end of a dimension, reset it and increment
	332	the next dimension. */
	333	count[n] = 0;
	334	/* We could precalculate these products, but this is a less
5d7adf7a	335	frequently used path so probably not worth it. */
644cb69f FXC	336	base -= sstride[n] * extent[n];
	337	mbase -= mstride[n] * extent[n];
	338	dest -= dstride[n] * extent[n];
	339	n++;
	340	if (n == rank)
	341	{
	342	/* Break out of the look. */
	343	base = NULL;
	344	break;
	345	}
	346	else
	347	{
	348	count[n]++;
	349	base += sstride[n];
	350	mbase += mstride[n];
	351	dest += dstride[n];
	352	}
	353	}
	354	}
	355	}
	356
97a62038 TK	357
	358	extern void ssum_c16 (gfc_array_c16 * const restrict,
	359	gfc_array_c16 * const restrict, const index_type * const restrict,
	360	GFC_LOGICAL_4 *);
	361	export_proto(ssum_c16);
	362
	363	void
	364	ssum_c16 (gfc_array_c16 * const restrict retarray,
	365	gfc_array_c16 * const restrict array,
	366	const index_type * const restrict pdim,
	367	GFC_LOGICAL_4 * mask)
	368	{
	369	index_type rank;
	370	index_type n;
	371	index_type dstride;
	372	GFC_COMPLEX_16 *dest;
	373
	374	if (*mask)
	375	{
	376	sum_c16 (retarray, array, pdim);
	377	return;
	378	}
	379	rank = GFC_DESCRIPTOR_RANK (array);
	380	if (rank <= 0)
	381	runtime_error ("Rank of array needs to be > 0");
	382
	383	if (retarray->data == NULL)
	384	{
	385	retarray->dim[0].lbound = 0;
	386	retarray->dim[0].ubound = rank-1;
	387	retarray->dim[0].stride = 1;
	388	retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) \| 1;
	389	retarray->offset = 0;
	390	retarray->data = internal_malloc_size (sizeof (GFC_COMPLEX_16) * rank);
	391	}
	392	else
	393	{
	394	if (GFC_DESCRIPTOR_RANK (retarray) != 1)
	395	runtime_error ("rank of return array does not equal 1");
	396
	397	if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
	398	runtime_error ("dimension of return array incorrect");
97a62038 TK	399	}
	400
	401	dstride = retarray->dim[0].stride;
	402	dest = retarray->data;
	403
	404	for (n = 0; n < rank; n++)
	405	dest[n * dstride] = 0 ;
	406	}
	407
644cb69f	408	#endif