libgfortran/generated/maxloc1_8_r8.c

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