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