libgfortran/generated/sum_c4.c

   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 (libgfor).
   6
   7 Libgfortran is free software; you can redistribute it and/or
   8 modify it under the terms of the GNU Lesser General Public
   9 License as published by the Free Software Foundation; either
  10 version 2.1 of the License, or (at your option) any later version.
  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 Lesser General Public License for more details.
  16
  17 You should have received a copy of the GNU Lesser General Public
  18 License along with libgfor; see the file COPYING.LIB.  If not,
  19 write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 Boston, MA 02111-1307, USA.  */
  21
  22 #include "config.h"
  23 #include <stdlib.h>
  24 #include <assert.h>
  25 #include "libgfortran.h"
  26
  27 void
  28 __sum_c4 (gfc_array_c4 * retarray, gfc_array_c4 *array, index_type *pdim)
  29 {
  30   index_type count[GFC_MAX_DIMENSIONS - 1];
  31   index_type extent[GFC_MAX_DIMENSIONS - 1];
  32   index_type sstride[GFC_MAX_DIMENSIONS - 1];
  33   index_type dstride[GFC_MAX_DIMENSIONS - 1];
  34   GFC_COMPLEX_4 *base;
  35   GFC_COMPLEX_4 *dest;
  36   index_type rank;
  37   index_type n;
  38   index_type len;
  39   index_type delta;
  40   index_type dim;
  41
  42   /* Make dim zero based to avoid confusion.  */
  43   dim = (*pdim) - 1;
  44   rank = GFC_DESCRIPTOR_RANK (array) - 1;
  45   assert (rank == GFC_DESCRIPTOR_RANK (retarray));
  46   if (array->dim[0].stride == 0)
  47     array->dim[0].stride = 1;
  48   if (retarray->dim[0].stride == 0)
  49     retarray->dim[0].stride = 1;
  50
  51   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
  52   delta = array->dim[dim].stride;
  53
  54   for (n = 0; n < dim; n++)
  55     {
  56       sstride[n] = array->dim[n].stride;
  57       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
  58     }
  59   for (n = dim; n < rank; n++)
  60     {
  61       sstride[n] = array->dim[n + 1].stride;
  62       extent[n] =
  63         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
  64     }
  65
  66   if (retarray->data == NULL)
  67     {
  68       for (n = 0; n < rank; n++)
  69         {
  70           retarray->dim[n].lbound = 0;
  71           retarray->dim[n].ubound = extent[n]-1;
  72           if (n == 0)
  73             retarray->dim[n].stride = 1;
  74           else
  75             retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
  76         }
  77
  78       retarray->data
  79          = internal_malloc_size (sizeof (GFC_COMPLEX_4)
  80                                  * retarray->dim[rank-1].stride
  81                                  * extent[rank-1]);
  82       retarray->base = 0;
  83     }
  84
  85   for (n = 0; n < rank; n++)
  86     {
  87       count[n] = 0;
  88       dstride[n] = retarray->dim[n].stride;
  89       if (extent[n] <= 0)
  90         len = 0;
  91     }
  92
  93   base = array->data;
  94   dest = retarray->data;
  95
  96   while (base)
  97     {
  98       GFC_COMPLEX_4 *src;
  99       GFC_COMPLEX_4 result;
 100       src = base;
 101       {
 102
 103   result = 0;
 104         if (len <= 0)
 105           *dest = 0;
 106         else
 107           {
 108             for (n = 0; n < len; n++, src += delta)
 109               {
 110
 111   result += *src;
 112           }
 113             *dest = result;
 114           }
 115       }
 116       /* Advance to the next element.  */
 117       count[0]++;
 118       base += sstride[0];
 119       dest += dstride[0];
 120       n = 0;
 121       while (count[n] == extent[n])
 122         {
 123           /* When we get to the end of a dimension, reset it and increment
 124              the next dimension.  */
 125           count[n] = 0;
 126           /* We could precalculate these products, but this is a less
 127              frequently used path so proabably not worth it.  */
 128           base -= sstride[n] * extent[n];
 129           dest -= dstride[n] * extent[n];
 130           n++;
 131           if (n == rank)
 132             {
 133               /* Break out of the look.  */
 134               base = NULL;
 135               break;
 136             }
 137           else
 138             {
 139               count[n]++;
 140               base += sstride[n];
 141               dest += dstride[n];
 142             }
 143         }
 144     }
 145 }
 146
 147 void
 148 __msum_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array, index_type *pdim, gfc_array_l4 * mask)
 149 {
 150   index_type count[GFC_MAX_DIMENSIONS - 1];
 151   index_type extent[GFC_MAX_DIMENSIONS - 1];
 152   index_type sstride[GFC_MAX_DIMENSIONS - 1];
 153   index_type dstride[GFC_MAX_DIMENSIONS - 1];
 154   index_type mstride[GFC_MAX_DIMENSIONS - 1];
 155   GFC_COMPLEX_4 *dest;
 156   GFC_COMPLEX_4 *base;
 157   GFC_LOGICAL_4 *mbase;
 158   int rank;
 159   int dim;
 160   index_type n;
 161   index_type len;
 162   index_type delta;
 163   index_type mdelta;
 164
 165   dim = (*pdim) - 1;
 166   rank = GFC_DESCRIPTOR_RANK (array) - 1;
 167   assert (rank == GFC_DESCRIPTOR_RANK (retarray));
 168   if (array->dim[0].stride == 0)
 169     array->dim[0].stride = 1;
 170   if (retarray->dim[0].stride == 0)
 171     retarray->dim[0].stride = 1;
 172
 173   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
 174   if (len <= 0)
 175     return;
 176   delta = array->dim[dim].stride;
 177   mdelta = mask->dim[dim].stride;
 178
 179   for (n = 0; n < dim; n++)
 180     {
 181       sstride[n] = array->dim[n].stride;
 182       mstride[n] = mask->dim[n].stride;
 183       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
 184     }
 185   for (n = dim; n < rank; n++)
 186     {
 187       sstride[n] = array->dim[n + 1].stride;
 188       mstride[n] = mask->dim[n + 1].stride;
 189       extent[n] =
 190         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
 191     }
 192
 193   for (n = 0; n < rank; n++)
 194     {
 195       count[n] = 0;
 196       dstride[n] = retarray->dim[n].stride;
 197       if (extent[n] <= 0)
 198         return;
 199     }
 200
 201   dest = retarray->data;
 202   base = array->data;
 203   mbase = mask->data;
 204
 205   if (GFC_DESCRIPTOR_SIZE (mask) != 4)
 206     {
 207       /* This allows the same loop to be used for all logical types.  */
 208       assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
 209       for (n = 0; n < rank; n++)
 210         mstride[n] <<= 1;
 211       mdelta <<= 1;
 212       mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
 213     }
 214
 215   while (base)
 216     {
 217       GFC_COMPLEX_4 *src;
 218       GFC_LOGICAL_4 *msrc;
 219       GFC_COMPLEX_4 result;
 220       src = base;
 221       msrc = mbase;
 222       {
 223
 224   result = 0;
 225         if (len <= 0)
 226           *dest = 0;
 227         else
 228           {
 229             for (n = 0; n < len; n++, src += delta, msrc += mdelta)
 230               {
 231
 232   if (*msrc)
 233     result += *src;
 234               }
 235             *dest = result;
 236           }
 237       }
 238       /* Advance to the next element.  */
 239       count[0]++;
 240       base += sstride[0];
 241       mbase += mstride[0];
 242       dest += dstride[0];
 243       n = 0;
 244       while (count[n] == extent[n])
 245         {
 246           /* When we get to the end of a dimension, reset it and increment
 247              the next dimension.  */
 248           count[n] = 0;
 249           /* We could precalculate these products, but this is a less
 250              frequently used path so proabably not worth it.  */
 251           base -= sstride[n] * extent[n];
 252           mbase -= mstride[n] * extent[n];
 253           dest -= dstride[n] * extent[n];
 254           n++;
 255           if (n == rank)
 256             {
 257               /* Break out of the look.  */
 258               base = NULL;
 259               break;
 260             }
 261           else
 262             {
 263               count[n]++;
 264               base += sstride[n];
 265               mbase += mstride[n];
 266               dest += dstride[n];
 267             }
 268         }
 269     }
 270 }