libgfortran/generated/maxval_r8.c

   1 /* Implementation of the MAXVAL 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 <float.h>
  26 #include "libgfortran.h"
  27
  28
  29 void
  30 __maxval_r8 (gfc_array_r8 * retarray, gfc_array_r8 *array, index_type *pdim)
  31 {
  32   index_type count[GFC_MAX_DIMENSIONS - 1];
  33   index_type extent[GFC_MAX_DIMENSIONS - 1];
  34   index_type sstride[GFC_MAX_DIMENSIONS - 1];
  35   index_type dstride[GFC_MAX_DIMENSIONS - 1];
  36   GFC_REAL_8 *base;
  37   GFC_REAL_8 *dest;
  38   index_type rank;
  39   index_type n;
  40   index_type len;
  41   index_type delta;
  42   index_type dim;
  43
  44   /* Make dim zero based to avoid confusion.  */
  45   dim = (*pdim) - 1;
  46   rank = GFC_DESCRIPTOR_RANK (array) - 1;
  47   assert (rank == GFC_DESCRIPTOR_RANK (retarray));
  48   if (array->dim[0].stride == 0)
  49     array->dim[0].stride = 1;
  50   if (retarray->dim[0].stride == 0)
  51     retarray->dim[0].stride = 1;
  52
  53   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
  54   delta = array->dim[dim].stride;
  55
  56   for (n = 0; n < dim; n++)
  57     {
  58       sstride[n] = array->dim[n].stride;
  59       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
  60     }
  61   for (n = dim; n < rank; n++)
  62     {
  63       sstride[n] = array->dim[n + 1].stride;
  64       extent[n] =
  65         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
  66     }
  67
  68   for (n = 0; n < rank; n++)
  69     {
  70       count[n] = 0;
  71       dstride[n] = retarray->dim[n].stride;
  72       if (extent[n] <= 0)
  73         len = 0;
  74     }
  75
  76   base = array->data;
  77   dest = retarray->data;
  78
  79   while (base)
  80     {
  81       GFC_REAL_8 *src;
  82       GFC_REAL_8 result;
  83       src = base;
  84       {
  85
  86   result = -GFC_REAL_8_HUGE;
  87         if (len <= 0)
  88           *dest = -GFC_REAL_8_HUGE;
  89         else
  90           {
  91             for (n = 0; n < len; n++, src += delta)
  92               {
  93
  94   if (*src > result)
  95     result = *src;
  96           }
  97             *dest = result;
  98           }
  99       }
 100       /* Advance to the next element.  */
 101       count[0]++;
 102       base += sstride[0];
 103       dest += dstride[0];
 104       n = 0;
 105       while (count[n] == extent[n])
 106         {
 107           /* When we get to the end of a dimension, reset it and increment
 108              the next dimension.  */
 109           count[n] = 0;
 110           /* We could precalculate these products, but this is a less
 111              frequently used path so proabably not worth it.  */
 112           base -= sstride[n] * extent[n];
 113           dest -= dstride[n] * extent[n];
 114           n++;
 115           if (n == rank)
 116             {
 117               /* Break out of the look.  */
 118               base = NULL;
 119               break;
 120             }
 121           else
 122             {
 123               count[n]++;
 124               base += sstride[n];
 125               dest += dstride[n];
 126             }
 127         }
 128     }
 129 }
 130
 131 void
 132 __mmaxval_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array, index_type *pdim, gfc_array_l4 * mask)
 133 {
 134   index_type count[GFC_MAX_DIMENSIONS - 1];
 135   index_type extent[GFC_MAX_DIMENSIONS - 1];
 136   index_type sstride[GFC_MAX_DIMENSIONS - 1];
 137   index_type dstride[GFC_MAX_DIMENSIONS - 1];
 138   index_type mstride[GFC_MAX_DIMENSIONS - 1];
 139   GFC_REAL_8 *dest;
 140   GFC_REAL_8 *base;
 141   GFC_LOGICAL_4 *mbase;
 142   int rank;
 143   int dim;
 144   index_type n;
 145   index_type len;
 146   index_type delta;
 147   index_type mdelta;
 148
 149   dim = (*pdim) - 1;
 150   rank = GFC_DESCRIPTOR_RANK (array) - 1;
 151   assert (rank == GFC_DESCRIPTOR_RANK (retarray));
 152   if (array->dim[0].stride == 0)
 153     array->dim[0].stride = 1;
 154   if (retarray->dim[0].stride == 0)
 155     retarray->dim[0].stride = 1;
 156
 157   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
 158   if (len <= 0)
 159     return;
 160   delta = array->dim[dim].stride;
 161   mdelta = mask->dim[dim].stride;
 162
 163   for (n = 0; n < dim; n++)
 164     {
 165       sstride[n] = array->dim[n].stride;
 166       mstride[n] = mask->dim[n].stride;
 167       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
 168     }
 169   for (n = dim; n < rank; n++)
 170     {
 171       sstride[n] = array->dim[n + 1].stride;
 172       mstride[n] = mask->dim[n + 1].stride;
 173       extent[n] =
 174         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
 175     }
 176
 177   for (n = 0; n < rank; n++)
 178     {
 179       count[n] = 0;
 180       dstride[n] = retarray->dim[n].stride;
 181       if (extent[n] <= 0)
 182         return;
 183     }
 184
 185   dest = retarray->data;
 186   base = array->data;
 187   mbase = mask->data;
 188
 189   if (GFC_DESCRIPTOR_SIZE (mask) != 4)
 190     {
 191       /* This allows the same loop to be used for all logical types.  */
 192       assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
 193       for (n = 0; n < rank; n++)
 194         mstride[n] <<= 1;
 195       mdelta <<= 1;
 196       mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
 197     }
 198
 199   while (base)
 200     {
 201       GFC_REAL_8 *src;
 202       GFC_LOGICAL_4 *msrc;
 203       GFC_REAL_8 result;
 204       src = base;
 205       msrc = mbase;
 206       {
 207
 208   result = -GFC_REAL_8_HUGE;
 209         if (len <= 0)
 210           *dest = -GFC_REAL_8_HUGE;
 211         else
 212           {
 213             for (n = 0; n < len; n++, src += delta, msrc += mdelta)
 214               {
 215
 216   if (*msrc && *src > result)
 217     result = *src;
 218               }
 219             *dest = result;
 220           }
 221       }
 222       /* Advance to the next element.  */
 223       count[0]++;
 224       base += sstride[0];
 225       mbase += mstride[0];
 226       dest += dstride[0];
 227       n = 0;
 228       while (count[n] == extent[n])
 229         {
 230           /* When we get to the end of a dimension, reset it and increment
 231              the next dimension.  */
 232           count[n] = 0;
 233           /* We could precalculate these products, but this is a less
 234              frequently used path so proabably not worth it.  */
 235           base -= sstride[n] * extent[n];
 236           mbase -= mstride[n] * extent[n];
 237           dest -= dstride[n] * extent[n];
 238           n++;
 239           if (n == rank)
 240             {
 241               /* Break out of the look.  */
 242               base = NULL;
 243               break;
 244             }
 245           else
 246             {
 247               count[n]++;
 248               base += sstride[n];
 249               mbase += mstride[n];
 250               dest += dstride[n];
 251             }
 252         }
 253     }
 254 }
 255