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 (libgfortran).
   6
   7 Libgfortran is free software; you can redistribute it and/or
   8 modify it under the terms of the GNU General Public
   9 License as published by the Free Software Foundation; either
  10 version 2 of the License, or (at your option) any later version.
  11
  12 In addition to the permissions in the GNU General Public License, the
  13 Free Software Foundation gives you unlimited permission to link the
  14 compiled version of this file into combinations with other programs,
  15 and to distribute those combinations without any restriction coming
  16 from the use of this file.  (The General Public License restrictions
  17 do apply in other respects; for example, they cover modification of
  18 the file, and distribution when not linked into a combine
  19 executable.)
  20
  21 Libgfortran is distributed in the hope that it will be useful,
  22 but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 GNU General Public License for more details.
  25
  26 You should have received a copy of the GNU General Public
  27 License along with libgfortran; see the file COPYING.  If not,
  28 write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  29 Boston, MA 02111-1307, USA.  */
  30
  31 #include "config.h"
  32 #include <stdlib.h>
  33 #include <assert.h>
  34 #include <float.h>
  35 #include "libgfortran.h"
  36
  37
  38 extern void minval_r8 (gfc_array_r8 *, gfc_array_r8 *, index_type *);
  39 export_proto(minval_r8);
  40
  41 void
  42 minval_r8 (gfc_array_r8 *retarray, gfc_array_r8 *array, index_type *pdim)
  43 {
  44   index_type count[GFC_MAX_DIMENSIONS - 1];
  45   index_type extent[GFC_MAX_DIMENSIONS - 1];
  46   index_type sstride[GFC_MAX_DIMENSIONS - 1];
  47   index_type dstride[GFC_MAX_DIMENSIONS - 1];
  48   GFC_REAL_8 *base;
  49   GFC_REAL_8 *dest;
  50   index_type rank;
  51   index_type n;
  52   index_type len;
  53   index_type delta;
  54   index_type dim;
  55
  56   /* Make dim zero based to avoid confusion.  */
  57   dim = (*pdim) - 1;
  58   rank = GFC_DESCRIPTOR_RANK (array) - 1;
  59   assert (rank == GFC_DESCRIPTOR_RANK (retarray));
  60   if (array->dim[0].stride == 0)
  61     array->dim[0].stride = 1;
  62   if (retarray->dim[0].stride == 0)
  63     retarray->dim[0].stride = 1;
  64
  65   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
  66   delta = array->dim[dim].stride;
  67
  68   for (n = 0; n < dim; n++)
  69     {
  70       sstride[n] = array->dim[n].stride;
  71       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
  72     }
  73   for (n = dim; n < rank; n++)
  74     {
  75       sstride[n] = array->dim[n + 1].stride;
  76       extent[n] =
  77         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
  78     }
  79
  80   if (retarray->data == NULL)
  81     {
  82       for (n = 0; n < rank; n++)
  83         {
  84           retarray->dim[n].lbound = 0;
  85           retarray->dim[n].ubound = extent[n]-1;
  86           if (n == 0)
  87             retarray->dim[n].stride = 1;
  88           else
  89             retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
  90         }
  91
  92       retarray->data
  93          = internal_malloc_size (sizeof (GFC_REAL_8)
  94                                  * retarray->dim[rank-1].stride
  95                                  * extent[rank-1]);
  96       retarray->base = 0;
  97     }
  98
  99   for (n = 0; n < rank; n++)
 100     {
 101       count[n] = 0;
 102       dstride[n] = retarray->dim[n].stride;
 103       if (extent[n] <= 0)
 104         len = 0;
 105     }
 106
 107   base = array->data;
 108   dest = retarray->data;
 109
 110   while (base)
 111     {
 112       GFC_REAL_8 *src;
 113       GFC_REAL_8 result;
 114       src = base;
 115       {
 116
 117   result = GFC_REAL_8_HUGE;
 118         if (len <= 0)
 119           *dest = GFC_REAL_8_HUGE;
 120         else
 121           {
 122             for (n = 0; n < len; n++, src += delta)
 123               {
 124
 125   if (*src < result)
 126     result = *src;
 127           }
 128             *dest = result;
 129           }
 130       }
 131       /* Advance to the next element.  */
 132       count[0]++;
 133       base += sstride[0];
 134       dest += dstride[0];
 135       n = 0;
 136       while (count[n] == extent[n])
 137         {
 138           /* When we get to the end of a dimension, reset it and increment
 139              the next dimension.  */
 140           count[n] = 0;
 141           /* We could precalculate these products, but this is a less
 142              frequently used path so proabably not worth it.  */
 143           base -= sstride[n] * extent[n];
 144           dest -= dstride[n] * extent[n];
 145           n++;
 146           if (n == rank)
 147             {
 148               /* Break out of the look.  */
 149               base = NULL;
 150               break;
 151             }
 152           else
 153             {
 154               count[n]++;
 155               base += sstride[n];
 156               dest += dstride[n];
 157             }
 158         }
 159     }
 160 }
 161
 162
 163 extern void mminval_r8 (gfc_array_r8 *, gfc_array_r8 *, index_type *,
 164                                                gfc_array_l4 *);
 165 export_proto(mminval_r8);
 166
 167 void
 168 mminval_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array,
 169                                   index_type *pdim, gfc_array_l4 * mask)
 170 {
 171   index_type count[GFC_MAX_DIMENSIONS - 1];
 172   index_type extent[GFC_MAX_DIMENSIONS - 1];
 173   index_type sstride[GFC_MAX_DIMENSIONS - 1];
 174   index_type dstride[GFC_MAX_DIMENSIONS - 1];
 175   index_type mstride[GFC_MAX_DIMENSIONS - 1];
 176   GFC_REAL_8 *dest;
 177   GFC_REAL_8 *base;
 178   GFC_LOGICAL_4 *mbase;
 179   int rank;
 180   int dim;
 181   index_type n;
 182   index_type len;
 183   index_type delta;
 184   index_type mdelta;
 185
 186   dim = (*pdim) - 1;
 187   rank = GFC_DESCRIPTOR_RANK (array) - 1;
 188   assert (rank == GFC_DESCRIPTOR_RANK (retarray));
 189   if (array->dim[0].stride == 0)
 190     array->dim[0].stride = 1;
 191   if (retarray->dim[0].stride == 0)
 192     retarray->dim[0].stride = 1;
 193
 194   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
 195   if (len <= 0)
 196     return;
 197   delta = array->dim[dim].stride;
 198   mdelta = mask->dim[dim].stride;
 199
 200   for (n = 0; n < dim; n++)
 201     {
 202       sstride[n] = array->dim[n].stride;
 203       mstride[n] = mask->dim[n].stride;
 204       extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
 205     }
 206   for (n = dim; n < rank; n++)
 207     {
 208       sstride[n] = array->dim[n + 1].stride;
 209       mstride[n] = mask->dim[n + 1].stride;
 210       extent[n] =
 211         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
 212     }
 213
 214   for (n = 0; n < rank; n++)
 215     {
 216       count[n] = 0;
 217       dstride[n] = retarray->dim[n].stride;
 218       if (extent[n] <= 0)
 219         return;
 220     }
 221
 222   dest = retarray->data;
 223   base = array->data;
 224   mbase = mask->data;
 225
 226   if (GFC_DESCRIPTOR_SIZE (mask) != 4)
 227     {
 228       /* This allows the same loop to be used for all logical types.  */
 229       assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
 230       for (n = 0; n < rank; n++)
 231         mstride[n] <<= 1;
 232       mdelta <<= 1;
 233       mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
 234     }
 235
 236   while (base)
 237     {
 238       GFC_REAL_8 *src;
 239       GFC_LOGICAL_4 *msrc;
 240       GFC_REAL_8 result;
 241       src = base;
 242       msrc = mbase;
 243       {
 244
 245   result = GFC_REAL_8_HUGE;
 246         if (len <= 0)
 247           *dest = GFC_REAL_8_HUGE;
 248         else
 249           {
 250             for (n = 0; n < len; n++, src += delta, msrc += mdelta)
 251               {
 252
 253   if (*msrc && *src < result)
 254     result = *src;
 255               }
 256             *dest = result;
 257           }
 258       }
 259       /* Advance to the next element.  */
 260       count[0]++;
 261       base += sstride[0];
 262       mbase += mstride[0];
 263       dest += dstride[0];
 264       n = 0;
 265       while (count[n] == extent[n])
 266         {
 267           /* When we get to the end of a dimension, reset it and increment
 268              the next dimension.  */
 269           count[n] = 0;
 270           /* We could precalculate these products, but this is a less
 271              frequently used path so proabably not worth it.  */
 272           base -= sstride[n] * extent[n];
 273           mbase -= mstride[n] * extent[n];
 274           dest -= dstride[n] * extent[n];
 275           n++;
 276           if (n == rank)
 277             {
 278               /* Break out of the look.  */
 279               base = NULL;
 280               break;
 281             }
 282           else
 283             {
 284               count[n]++;
 285               base += sstride[n];
 286               mbase += mstride[n];
 287               dest += dstride[n];
 288             }
 289         }
 290     }
 291 }
 292