libgfortran/generated/minloc0_8_r8.c

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