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