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