libgfortran/generated/minval_r8.c

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