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