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