* Makefile.am: Remove references to types.m4.
[official-gcc.git] / libgfortran / generated / minloc0_8_i4.c
blob962ee836255fac224329d2ae276efc82e1c0d1d2
1 /* Implementation of the MINLOC intrinsic
2 Copyright 2002 Free Software Foundation, Inc.
3 Contributed by Paul Brook <paul@nowt.org>
5 This file is part of the GNU Fortran 95 runtime library (libgfor).
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.
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.
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. */
22 #include "config.h"
23 #include <stdlib.h>
24 #include <assert.h>
25 #include <float.h>
26 #include <limits.h>
27 #include "libgfortran.h"
30 void
31 __minloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array)
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_INTEGER_4 *base;
38 GFC_INTEGER_8 *dest;
39 index_type rank;
40 index_type n;
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;
51 dstride = retarray->dim[0].stride;
52 dest = retarray->data;
53 for (n = 0; n < rank; n++)
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)
60 /* Set the return value. */
61 for (n = 0; n < rank; n++)
62 dest[n * dstride] = 0;
63 return;
67 base = array->data;
69 /* Initialize the return value. */
70 for (n = 0; n < rank; n++)
71 dest[n * dstride] = 1;
74 GFC_INTEGER_4 minval;
76 minval = GFC_INTEGER_4_HUGE;
78 while (base)
81 /* Implementation start. */
83 if (*base < minval)
85 minval = *base;
86 for (n = 0; n < rank; n++)
87 dest[n * dstride] = count[n] + 1;
89 /* Implementation end. */
91 /* Advance to the next element. */
92 count[0]++;
93 base += sstride[0];
94 n = 0;
95 while (count[n] == extent[n])
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)
106 /* Break out of the loop. */
107 base = NULL;
108 break;
110 else
112 count[n]++;
113 base += sstride[n];
120 void
121 __mminloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array, gfc_array_l4 * mask)
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_8 *dest;
129 GFC_INTEGER_4 *base;
130 GFC_LOGICAL_4 *mbase;
131 int rank;
132 index_type n;
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);
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;
147 dstride = retarray->dim[0].stride;
148 dest = retarray->data;
149 for (n = 0; n < rank; n++)
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)
157 /* Set the return value. */
158 for (n = 0; n < rank; n++)
159 dest[n * dstride] = 0;
160 return;
164 base = array->data;
165 mbase = mask->data;
167 if (GFC_DESCRIPTOR_SIZE (mask) != 4)
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));
177 /* Initialize the return value. */
178 for (n = 0; n < rank; n++)
179 dest[n * dstride] = 1;
182 GFC_INTEGER_4 minval;
184 minval = GFC_INTEGER_4_HUGE;
186 while (base)
189 /* Implementation start. */
191 if (*mbase && *base < minval)
193 minval = *base;
194 for (n = 0; n < rank; n++)
195 dest[n * dstride] = count[n] + 1;
197 /* Implementation end. */
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])
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)
216 /* Break out of the loop. */
217 base = NULL;
218 break;
220 else
222 count[n]++;
223 base += sstride[n];
224 mbase += mstride[n];