re PR libfortran/32972 (performance of pack/unpack)

2007-08-24  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/32972
	* iresolve.c:  Don't convert array masks.

2007-08-24  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/32972
	* libgfortran.h:  Remove GFOR_POINTER_L8_TO_L4 macro.
	Add GFOR_POINTER_TO_L1 macro.
	* m4/iforeach.m4(`m'name`'rtype_qual`_'atype_code):
	Change argument 'mask' to gfc_array_l1.  Adjust prototype.
	Change mask pointer to GFC_LOGICAL_1.  Multiply strides
	by kind of mask
	* m4/ifunction.m4:  Likewise.
	* intrinsics/pack_generic.c(pack_internal):  Likewise.
	* intrinsics/unpack_generic.c(unpack_internal):  Likewise.
	* m4/matmull.m4:  Switch to GFC_LOGICAL_1.  Multiply strides by
	kind of logical arguments a and b.
	* generated/matmul_l16.c: Regenerated.
	* generated/matmul_l4.c: Regenerated.
	* generated/matmul_l8.c: Regenerated.
	* generated/maxloc0_16_i1.c: Regenerated.
	* generated/maxloc0_16_i16.c: Regenerated.
	* generated/maxloc0_16_i2.c: Regenerated.
	* generated/maxloc0_16_i4.c: Regenerated.
	* generated/maxloc0_16_i8.c: Regenerated.
	* generated/maxloc0_16_r10.c: Regenerated.
	* generated/maxloc0_16_r16.c: Regenerated.
	* generated/maxloc0_16_r4.c: Regenerated.
	* generated/maxloc0_16_r8.c: Regenerated.
	* generated/maxloc0_4_i1.c: Regenerated.
	* generated/maxloc0_4_i16.c: Regenerated.
	* generated/maxloc0_4_i2.c: Regenerated.
	* generated/maxloc0_4_i4.c: Regenerated.
	* generated/maxloc0_4_i8.c: Regenerated.
	* generated/maxloc0_4_r10.c: Regenerated.
	* generated/maxloc0_4_r16.c: Regenerated.
	* generated/maxloc0_4_r4.c: Regenerated.
	* generated/maxloc0_4_r8.c: Regenerated.
	* generated/maxloc0_8_i1.c: Regenerated.
	* generated/maxloc0_8_i16.c: Regenerated.
	* generated/maxloc0_8_i2.c: Regenerated.
	* generated/maxloc0_8_i4.c: Regenerated.
	* generated/maxloc0_8_i8.c: Regenerated.
	* generated/maxloc0_8_r10.c: Regenerated.
	* generated/maxloc0_8_r16.c: Regenerated.
	* generated/maxloc0_8_r4.c: Regenerated.
	* generated/maxloc0_8_r8.c: Regenerated.
	* generated/maxloc1_16_i1.c: Regenerated.
	* generated/maxloc1_16_i16.c: Regenerated.
	* generated/maxloc1_16_i2.c: Regenerated.
	* generated/maxloc1_16_i4.c: Regenerated.
	* generated/maxloc1_16_i8.c: Regenerated.
	* generated/maxloc1_16_r10.c: Regenerated.
	* generated/maxloc1_16_r16.c: Regenerated.
	* generated/maxloc1_16_r4.c: Regenerated.
	* generated/maxloc1_16_r8.c: Regenerated.
	* generated/maxloc1_4_i1.c: Regenerated.
	* generated/maxloc1_4_i16.c: Regenerated.
	* generated/maxloc1_4_i2.c: Regenerated.
	* generated/maxloc1_4_i4.c: Regenerated.
	* generated/maxloc1_4_i8.c: Regenerated.
	* generated/maxloc1_4_r10.c: Regenerated.
	* generated/maxloc1_4_r16.c: Regenerated.
	* generated/maxloc1_4_r4.c: Regenerated.
	* generated/maxloc1_4_r8.c: Regenerated.
	* generated/maxloc1_8_i1.c: Regenerated.
	* generated/maxloc1_8_i16.c: Regenerated.
	* generated/maxloc1_8_i2.c: Regenerated.
	* generated/maxloc1_8_i4.c: Regenerated.
	* generated/maxloc1_8_i8.c: Regenerated.
	* generated/maxloc1_8_r10.c: Regenerated.
	* generated/maxloc1_8_r16.c: Regenerated.
	* generated/maxloc1_8_r4.c: Regenerated.
	* generated/maxloc1_8_r8.c: Regenerated.
	* generated/maxval_i1.c: Regenerated.
	* generated/maxval_i16.c: Regenerated.
	* generated/maxval_i2.c: Regenerated.
	* generated/maxval_i4.c: Regenerated.
	* generated/maxval_i8.c: Regenerated.
	* generated/maxval_r10.c: Regenerated.
	* generated/maxval_r16.c: Regenerated.
	* generated/maxval_r4.c: Regenerated.
	* generated/maxval_r8.c: Regenerated.
	* generated/minloc0_16_i1.c: Regenerated.
	* generated/minloc0_16_i16.c: Regenerated.
	* generated/minloc0_16_i2.c: Regenerated.
	* generated/minloc0_16_i4.c: Regenerated.
	* generated/minloc0_16_i8.c: Regenerated.
	* generated/minloc0_16_r10.c: Regenerated.
	* generated/minloc0_16_r16.c: Regenerated.
	* generated/minloc0_16_r4.c: Regenerated.
	* generated/minloc0_16_r8.c: Regenerated.
	* generated/minloc0_4_i1.c: Regenerated.
	* generated/minloc0_4_i16.c: Regenerated.
	* generated/minloc0_4_i2.c: Regenerated.
	* generated/minloc0_4_i4.c: Regenerated.
	* generated/minloc0_4_i8.c: Regenerated.
	* generated/minloc0_4_r10.c: Regenerated.
	* generated/minloc0_4_r16.c: Regenerated.
	* generated/minloc0_4_r4.c: Regenerated.
	* generated/minloc0_4_r8.c: Regenerated.
	* generated/minloc0_8_i1.c: Regenerated.
	* generated/minloc0_8_i16.c: Regenerated.
	* generated/minloc0_8_i2.c: Regenerated.
	* generated/minloc0_8_i4.c: Regenerated.
	* generated/minloc0_8_i8.c: Regenerated.
	* generated/minloc0_8_r10.c: Regenerated.
	* generated/minloc0_8_r16.c: Regenerated.
	* generated/minloc0_8_r4.c: Regenerated.
	* generated/minloc0_8_r8.c: Regenerated.
	* generated/minloc1_16_i1.c: Regenerated.
	* generated/minloc1_16_i16.c: Regenerated.
	* generated/minloc1_16_i2.c: Regenerated.
	* generated/minloc1_16_i4.c: Regenerated.
	* generated/minloc1_16_i8.c: Regenerated.
	* generated/minloc1_16_r10.c: Regenerated.
	* generated/minloc1_16_r16.c: Regenerated.
	* generated/minloc1_16_r4.c: Regenerated.
	* generated/minloc1_16_r8.c: Regenerated.
	* generated/minloc1_4_i1.c: Regenerated.
	* generated/minloc1_4_i16.c: Regenerated.
	* generated/minloc1_4_i2.c: Regenerated.
	* generated/minloc1_4_i4.c: Regenerated.
	* generated/minloc1_4_i8.c: Regenerated.
	* generated/minloc1_4_r10.c: Regenerated.
	* generated/minloc1_4_r16.c: Regenerated.
	* generated/minloc1_4_r4.c: Regenerated.
	* generated/minloc1_4_r8.c: Regenerated.
	* generated/minloc1_8_i1.c: Regenerated.
	* generated/minloc1_8_i16.c: Regenerated.
	* generated/minloc1_8_i2.c: Regenerated.
	* generated/minloc1_8_i4.c: Regenerated.
	* generated/minloc1_8_i8.c: Regenerated.
	* generated/minloc1_8_r10.c: Regenerated.
	* generated/minloc1_8_r16.c: Regenerated.
	* generated/minloc1_8_r4.c: Regenerated.
	* generated/minloc1_8_r8.c: Regenerated.
	* generated/minval_i1.c: Regenerated.
	* generated/minval_i16.c: Regenerated.
	* generated/minval_i2.c: Regenerated.
	* generated/minval_i4.c: Regenerated.
	* generated/minval_i8.c: Regenerated.
	* generated/minval_r10.c: Regenerated.
	* generated/minval_r16.c: Regenerated.
	* generated/minval_r4.c: Regenerated.
	* generated/minval_r8.c: Regenerated.
	* generated/product_c10.c: Regenerated.
	* generated/product_c16.c: Regenerated.
	* generated/product_c4.c: Regenerated.
	* generated/product_c8.c: Regenerated.
	* generated/product_i1.c: Regenerated.
	* generated/product_i16.c: Regenerated.
	* generated/product_i2.c: Regenerated.
	* generated/product_i4.c: Regenerated.
	* generated/product_i8.c: Regenerated.
	* generated/product_r10.c: Regenerated.
	* generated/product_r16.c: Regenerated.
	* generated/product_r4.c: Regenerated.
	* generated/product_r8.c: Regenerated.
	* generated/sum_c10.c: Regenerated.
	* generated/sum_c16.c: Regenerated.
	* generated/sum_c4.c: Regenerated.
	* generated/sum_c8.c: Regenerated.
	* generated/sum_i1.c: Regenerated.
	* generated/sum_i16.c: Regenerated.
	* generated/sum_i2.c: Regenerated.
	* generated/sum_i4.c: Regenerated.
	* generated/sum_i8.c: Regenerated.
	* generated/sum_r10.c: Regenerated.
	* generated/sum_r16.c: Regenerated.
	* generated/sum_r4.c: Regenerated.
	* generated/sum_r8.c: Regenerated.

From-SVN: r127774
This commit is contained in:
Thomas Koenig 2007-08-24 16:16:16 +00:00
parent c6a8035acf
commit 28dc6b33c4
164 changed files with 3544 additions and 2741 deletions

View File

@ -1,3 +1,8 @@
2007-08-24 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/32972
* iresolve.c: Don't convert array masks.
2007-08-24 Tobias Burnus <burnus@net-b.de> 2007-08-24 Tobias Burnus <burnus@net-b.de>
PR fortran/33139 PR fortran/33139

View File

@ -77,32 +77,18 @@ check_charlen_present (gfc_expr *source)
static void static void
resolve_mask_arg (gfc_expr *mask) resolve_mask_arg (gfc_expr *mask)
{ {
int newkind;
/* The mask can be kind 4 or 8 for the array case. /* The mask can be any kind for an array.
For the scalar case, coerce it to kind=4 unconditionally For the scalar case, coerce it to kind=4 unconditionally
(because this is the only kind we have a library function (because this is the only kind we have a library function
for). */ for). */
newkind = 0; if (mask->rank == 0 && mask->ts.kind != 4)
if (mask->rank == 0)
{
if (mask->ts.kind != 4)
newkind = 4;
}
else
{
if (mask->ts.kind < 4)
newkind = gfc_default_logical_kind;
}
if (newkind)
{ {
gfc_typespec ts; gfc_typespec ts;
ts.type = BT_LOGICAL; ts.type = BT_LOGICAL;
ts.kind = newkind; ts.kind = 4;
gfc_convert_type (mask, &ts, 2); gfc_convert_type (mask, &ts, 2);
} }
} }

View File

@ -1,3 +1,173 @@
2007-08-24 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/32972
* libgfortran.h: Remove GFOR_POINTER_L8_TO_L4 macro.
Add GFOR_POINTER_TO_L1 macro.
* m4/iforeach.m4(`m'name`'rtype_qual`_'atype_code):
Change argument 'mask' to gfc_array_l1. Adjust prototype.
Change mask pointer to GFC_LOGICAL_1. Multiply strides
by kind of mask
* m4/ifunction.m4: Likewise.
* intrinsics/pack_generic.c(pack_internal): Likewise.
* intrinsics/unpack_generic.c(unpack_internal): Likewise.
* m4/matmull.m4: Switch to GFC_LOGICAL_1. Multiply strides by
kind of logical arguments a and b.
* generated/matmul_l16.c: Regenerated.
* generated/matmul_l4.c: Regenerated.
* generated/matmul_l8.c: Regenerated.
* generated/maxloc0_16_i1.c: Regenerated.
* generated/maxloc0_16_i16.c: Regenerated.
* generated/maxloc0_16_i2.c: Regenerated.
* generated/maxloc0_16_i4.c: Regenerated.
* generated/maxloc0_16_i8.c: Regenerated.
* generated/maxloc0_16_r10.c: Regenerated.
* generated/maxloc0_16_r16.c: Regenerated.
* generated/maxloc0_16_r4.c: Regenerated.
* generated/maxloc0_16_r8.c: Regenerated.
* generated/maxloc0_4_i1.c: Regenerated.
* generated/maxloc0_4_i16.c: Regenerated.
* generated/maxloc0_4_i2.c: Regenerated.
* generated/maxloc0_4_i4.c: Regenerated.
* generated/maxloc0_4_i8.c: Regenerated.
* generated/maxloc0_4_r10.c: Regenerated.
* generated/maxloc0_4_r16.c: Regenerated.
* generated/maxloc0_4_r4.c: Regenerated.
* generated/maxloc0_4_r8.c: Regenerated.
* generated/maxloc0_8_i1.c: Regenerated.
* generated/maxloc0_8_i16.c: Regenerated.
* generated/maxloc0_8_i2.c: Regenerated.
* generated/maxloc0_8_i4.c: Regenerated.
* generated/maxloc0_8_i8.c: Regenerated.
* generated/maxloc0_8_r10.c: Regenerated.
* generated/maxloc0_8_r16.c: Regenerated.
* generated/maxloc0_8_r4.c: Regenerated.
* generated/maxloc0_8_r8.c: Regenerated.
* generated/maxloc1_16_i1.c: Regenerated.
* generated/maxloc1_16_i16.c: Regenerated.
* generated/maxloc1_16_i2.c: Regenerated.
* generated/maxloc1_16_i4.c: Regenerated.
* generated/maxloc1_16_i8.c: Regenerated.
* generated/maxloc1_16_r10.c: Regenerated.
* generated/maxloc1_16_r16.c: Regenerated.
* generated/maxloc1_16_r4.c: Regenerated.
* generated/maxloc1_16_r8.c: Regenerated.
* generated/maxloc1_4_i1.c: Regenerated.
* generated/maxloc1_4_i16.c: Regenerated.
* generated/maxloc1_4_i2.c: Regenerated.
* generated/maxloc1_4_i4.c: Regenerated.
* generated/maxloc1_4_i8.c: Regenerated.
* generated/maxloc1_4_r10.c: Regenerated.
* generated/maxloc1_4_r16.c: Regenerated.
* generated/maxloc1_4_r4.c: Regenerated.
* generated/maxloc1_4_r8.c: Regenerated.
* generated/maxloc1_8_i1.c: Regenerated.
* generated/maxloc1_8_i16.c: Regenerated.
* generated/maxloc1_8_i2.c: Regenerated.
* generated/maxloc1_8_i4.c: Regenerated.
* generated/maxloc1_8_i8.c: Regenerated.
* generated/maxloc1_8_r10.c: Regenerated.
* generated/maxloc1_8_r16.c: Regenerated.
* generated/maxloc1_8_r4.c: Regenerated.
* generated/maxloc1_8_r8.c: Regenerated.
* generated/maxval_i1.c: Regenerated.
* generated/maxval_i16.c: Regenerated.
* generated/maxval_i2.c: Regenerated.
* generated/maxval_i4.c: Regenerated.
* generated/maxval_i8.c: Regenerated.
* generated/maxval_r10.c: Regenerated.
* generated/maxval_r16.c: Regenerated.
* generated/maxval_r4.c: Regenerated.
* generated/maxval_r8.c: Regenerated.
* generated/minloc0_16_i1.c: Regenerated.
* generated/minloc0_16_i16.c: Regenerated.
* generated/minloc0_16_i2.c: Regenerated.
* generated/minloc0_16_i4.c: Regenerated.
* generated/minloc0_16_i8.c: Regenerated.
* generated/minloc0_16_r10.c: Regenerated.
* generated/minloc0_16_r16.c: Regenerated.
* generated/minloc0_16_r4.c: Regenerated.
* generated/minloc0_16_r8.c: Regenerated.
* generated/minloc0_4_i1.c: Regenerated.
* generated/minloc0_4_i16.c: Regenerated.
* generated/minloc0_4_i2.c: Regenerated.
* generated/minloc0_4_i4.c: Regenerated.
* generated/minloc0_4_i8.c: Regenerated.
* generated/minloc0_4_r10.c: Regenerated.
* generated/minloc0_4_r16.c: Regenerated.
* generated/minloc0_4_r4.c: Regenerated.
* generated/minloc0_4_r8.c: Regenerated.
* generated/minloc0_8_i1.c: Regenerated.
* generated/minloc0_8_i16.c: Regenerated.
* generated/minloc0_8_i2.c: Regenerated.
* generated/minloc0_8_i4.c: Regenerated.
* generated/minloc0_8_i8.c: Regenerated.
* generated/minloc0_8_r10.c: Regenerated.
* generated/minloc0_8_r16.c: Regenerated.
* generated/minloc0_8_r4.c: Regenerated.
* generated/minloc0_8_r8.c: Regenerated.
* generated/minloc1_16_i1.c: Regenerated.
* generated/minloc1_16_i16.c: Regenerated.
* generated/minloc1_16_i2.c: Regenerated.
* generated/minloc1_16_i4.c: Regenerated.
* generated/minloc1_16_i8.c: Regenerated.
* generated/minloc1_16_r10.c: Regenerated.
* generated/minloc1_16_r16.c: Regenerated.
* generated/minloc1_16_r4.c: Regenerated.
* generated/minloc1_16_r8.c: Regenerated.
* generated/minloc1_4_i1.c: Regenerated.
* generated/minloc1_4_i16.c: Regenerated.
* generated/minloc1_4_i2.c: Regenerated.
* generated/minloc1_4_i4.c: Regenerated.
* generated/minloc1_4_i8.c: Regenerated.
* generated/minloc1_4_r10.c: Regenerated.
* generated/minloc1_4_r16.c: Regenerated.
* generated/minloc1_4_r4.c: Regenerated.
* generated/minloc1_4_r8.c: Regenerated.
* generated/minloc1_8_i1.c: Regenerated.
* generated/minloc1_8_i16.c: Regenerated.
* generated/minloc1_8_i2.c: Regenerated.
* generated/minloc1_8_i4.c: Regenerated.
* generated/minloc1_8_i8.c: Regenerated.
* generated/minloc1_8_r10.c: Regenerated.
* generated/minloc1_8_r16.c: Regenerated.
* generated/minloc1_8_r4.c: Regenerated.
* generated/minloc1_8_r8.c: Regenerated.
* generated/minval_i1.c: Regenerated.
* generated/minval_i16.c: Regenerated.
* generated/minval_i2.c: Regenerated.
* generated/minval_i4.c: Regenerated.
* generated/minval_i8.c: Regenerated.
* generated/minval_r10.c: Regenerated.
* generated/minval_r16.c: Regenerated.
* generated/minval_r4.c: Regenerated.
* generated/minval_r8.c: Regenerated.
* generated/product_c10.c: Regenerated.
* generated/product_c16.c: Regenerated.
* generated/product_c4.c: Regenerated.
* generated/product_c8.c: Regenerated.
* generated/product_i1.c: Regenerated.
* generated/product_i16.c: Regenerated.
* generated/product_i2.c: Regenerated.
* generated/product_i4.c: Regenerated.
* generated/product_i8.c: Regenerated.
* generated/product_r10.c: Regenerated.
* generated/product_r16.c: Regenerated.
* generated/product_r4.c: Regenerated.
* generated/product_r8.c: Regenerated.
* generated/sum_c10.c: Regenerated.
* generated/sum_c16.c: Regenerated.
* generated/sum_c4.c: Regenerated.
* generated/sum_c8.c: Regenerated.
* generated/sum_i1.c: Regenerated.
* generated/sum_i16.c: Regenerated.
* generated/sum_i2.c: Regenerated.
* generated/sum_i4.c: Regenerated.
* generated/sum_i8.c: Regenerated.
* generated/sum_r10.c: Regenerated.
* generated/sum_r16.c: Regenerated.
* generated/sum_r4.c: Regenerated.
* generated/sum_r8.c: Regenerated.
2007-08-23 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> 2007-08-23 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR libfortran/23138 PR libfortran/23138

View File

@ -39,15 +39,15 @@ Boston, MA 02110-1301, USA. */
Either a or b can be rank 1. In this case x or y is 1. */ Either a or b can be rank 1. In this case x or y is 1. */
extern void matmul_l16 (gfc_array_l16 * const restrict, extern void matmul_l16 (gfc_array_l16 * const restrict,
gfc_array_l4 * const restrict, gfc_array_l4 * const restrict); gfc_array_l1 * const restrict, gfc_array_l1 * const restrict);
export_proto(matmul_l16); export_proto(matmul_l16);
void void
matmul_l16 (gfc_array_l16 * const restrict retarray, matmul_l16 (gfc_array_l16 * const restrict retarray,
gfc_array_l4 * const restrict a, gfc_array_l4 * const restrict b) gfc_array_l1 * const restrict a, gfc_array_l1 * const restrict b)
{ {
const GFC_INTEGER_4 * restrict abase; const GFC_LOGICAL_1 * restrict abase;
const GFC_INTEGER_4 * restrict bbase; const GFC_LOGICAL_1 * restrict bbase;
GFC_LOGICAL_16 * restrict dest; GFC_LOGICAL_16 * restrict dest;
index_type rxstride; index_type rxstride;
index_type rystride; index_type rystride;
@ -57,9 +57,11 @@ matmul_l16 (gfc_array_l16 * const restrict retarray,
index_type ystride; index_type ystride;
index_type x; index_type x;
index_type y; index_type y;
int a_kind;
int b_kind;
const GFC_INTEGER_4 * restrict pa; const GFC_LOGICAL_1 * restrict pa;
const GFC_INTEGER_4 * restrict pb; const GFC_LOGICAL_1 * restrict pb;
index_type astride; index_type astride;
index_type bstride; index_type bstride;
index_type count; index_type count;
@ -99,17 +101,29 @@ matmul_l16 (gfc_array_l16 * const restrict retarray,
} }
abase = a->data; abase = a->data;
if (GFC_DESCRIPTOR_SIZE (a) != 4) a_kind = GFC_DESCRIPTOR_SIZE (a);
{
assert (GFC_DESCRIPTOR_SIZE (a) == 8); if (a_kind == 1 || a_kind == 2 || a_kind == 4 || a_kind == 8
abase = GFOR_POINTER_L8_TO_L4 (abase); #ifdef HAVE_GFC_LOGICAL_16
} || a_kind == 16
#endif
)
abase = GFOR_POINTER_TO_L1 (abase, a_kind);
else
internal_error (NULL, "Funny sized logical array");
bbase = b->data; bbase = b->data;
if (GFC_DESCRIPTOR_SIZE (b) != 4) b_kind = GFC_DESCRIPTOR_SIZE (b);
{
assert (GFC_DESCRIPTOR_SIZE (b) == 8); if (b_kind == 1 || b_kind == 2 || b_kind == 4 || b_kind == 8
bbase = GFOR_POINTER_L8_TO_L4 (bbase); #ifdef HAVE_GFC_LOGICAL_16
} || b_kind == 16
#endif
)
bbase = GFOR_POINTER_TO_L1 (bbase, b_kind);
else
internal_error (NULL, "Funny sized logical array");
dest = retarray->data; dest = retarray->data;
@ -128,7 +142,7 @@ matmul_l16 (gfc_array_l16 * const restrict retarray,
one. */ one. */
if (GFC_DESCRIPTOR_RANK (a) == 1) if (GFC_DESCRIPTOR_RANK (a) == 1)
{ {
astride = a->dim[0].stride; astride = a->dim[0].stride * a_kind;
count = a->dim[0].ubound + 1 - a->dim[0].lbound; count = a->dim[0].ubound + 1 - a->dim[0].lbound;
xstride = 0; xstride = 0;
rxstride = 0; rxstride = 0;
@ -136,14 +150,14 @@ matmul_l16 (gfc_array_l16 * const restrict retarray,
} }
else else
{ {
astride = a->dim[1].stride; astride = a->dim[1].stride * a_kind;
count = a->dim[1].ubound + 1 - a->dim[1].lbound; count = a->dim[1].ubound + 1 - a->dim[1].lbound;
xstride = a->dim[0].stride; xstride = a->dim[0].stride;
xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
} }
if (GFC_DESCRIPTOR_RANK (b) == 1) if (GFC_DESCRIPTOR_RANK (b) == 1)
{ {
bstride = b->dim[0].stride; bstride = b->dim[0].stride * b_kind;
assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
ystride = 0; ystride = 0;
rystride = 0; rystride = 0;
@ -151,7 +165,7 @@ matmul_l16 (gfc_array_l16 * const restrict retarray,
} }
else else
{ {
bstride = b->dim[0].stride; bstride = b->dim[0].stride * b_kind;
assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
ystride = b->dim[1].stride; ystride = b->dim[1].stride;
ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
@ -189,3 +203,4 @@ matmul_l16 (gfc_array_l16 * const restrict retarray,
} }
#endif #endif

View File

@ -39,15 +39,15 @@ Boston, MA 02110-1301, USA. */
Either a or b can be rank 1. In this case x or y is 1. */ Either a or b can be rank 1. In this case x or y is 1. */
extern void matmul_l4 (gfc_array_l4 * const restrict, extern void matmul_l4 (gfc_array_l4 * const restrict,
gfc_array_l4 * const restrict, gfc_array_l4 * const restrict); gfc_array_l1 * const restrict, gfc_array_l1 * const restrict);
export_proto(matmul_l4); export_proto(matmul_l4);
void void
matmul_l4 (gfc_array_l4 * const restrict retarray, matmul_l4 (gfc_array_l4 * const restrict retarray,
gfc_array_l4 * const restrict a, gfc_array_l4 * const restrict b) gfc_array_l1 * const restrict a, gfc_array_l1 * const restrict b)
{ {
const GFC_INTEGER_4 * restrict abase; const GFC_LOGICAL_1 * restrict abase;
const GFC_INTEGER_4 * restrict bbase; const GFC_LOGICAL_1 * restrict bbase;
GFC_LOGICAL_4 * restrict dest; GFC_LOGICAL_4 * restrict dest;
index_type rxstride; index_type rxstride;
index_type rystride; index_type rystride;
@ -57,9 +57,11 @@ matmul_l4 (gfc_array_l4 * const restrict retarray,
index_type ystride; index_type ystride;
index_type x; index_type x;
index_type y; index_type y;
int a_kind;
int b_kind;
const GFC_INTEGER_4 * restrict pa; const GFC_LOGICAL_1 * restrict pa;
const GFC_INTEGER_4 * restrict pb; const GFC_LOGICAL_1 * restrict pb;
index_type astride; index_type astride;
index_type bstride; index_type bstride;
index_type count; index_type count;
@ -99,17 +101,29 @@ matmul_l4 (gfc_array_l4 * const restrict retarray,
} }
abase = a->data; abase = a->data;
if (GFC_DESCRIPTOR_SIZE (a) != 4) a_kind = GFC_DESCRIPTOR_SIZE (a);
{
assert (GFC_DESCRIPTOR_SIZE (a) == 8); if (a_kind == 1 || a_kind == 2 || a_kind == 4 || a_kind == 8
abase = GFOR_POINTER_L8_TO_L4 (abase); #ifdef HAVE_GFC_LOGICAL_16
} || a_kind == 16
#endif
)
abase = GFOR_POINTER_TO_L1 (abase, a_kind);
else
internal_error (NULL, "Funny sized logical array");
bbase = b->data; bbase = b->data;
if (GFC_DESCRIPTOR_SIZE (b) != 4) b_kind = GFC_DESCRIPTOR_SIZE (b);
{
assert (GFC_DESCRIPTOR_SIZE (b) == 8); if (b_kind == 1 || b_kind == 2 || b_kind == 4 || b_kind == 8
bbase = GFOR_POINTER_L8_TO_L4 (bbase); #ifdef HAVE_GFC_LOGICAL_16
} || b_kind == 16
#endif
)
bbase = GFOR_POINTER_TO_L1 (bbase, b_kind);
else
internal_error (NULL, "Funny sized logical array");
dest = retarray->data; dest = retarray->data;
@ -128,7 +142,7 @@ matmul_l4 (gfc_array_l4 * const restrict retarray,
one. */ one. */
if (GFC_DESCRIPTOR_RANK (a) == 1) if (GFC_DESCRIPTOR_RANK (a) == 1)
{ {
astride = a->dim[0].stride; astride = a->dim[0].stride * a_kind;
count = a->dim[0].ubound + 1 - a->dim[0].lbound; count = a->dim[0].ubound + 1 - a->dim[0].lbound;
xstride = 0; xstride = 0;
rxstride = 0; rxstride = 0;
@ -136,14 +150,14 @@ matmul_l4 (gfc_array_l4 * const restrict retarray,
} }
else else
{ {
astride = a->dim[1].stride; astride = a->dim[1].stride * a_kind;
count = a->dim[1].ubound + 1 - a->dim[1].lbound; count = a->dim[1].ubound + 1 - a->dim[1].lbound;
xstride = a->dim[0].stride; xstride = a->dim[0].stride;
xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
} }
if (GFC_DESCRIPTOR_RANK (b) == 1) if (GFC_DESCRIPTOR_RANK (b) == 1)
{ {
bstride = b->dim[0].stride; bstride = b->dim[0].stride * b_kind;
assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
ystride = 0; ystride = 0;
rystride = 0; rystride = 0;
@ -151,7 +165,7 @@ matmul_l4 (gfc_array_l4 * const restrict retarray,
} }
else else
{ {
bstride = b->dim[0].stride; bstride = b->dim[0].stride * b_kind;
assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
ystride = b->dim[1].stride; ystride = b->dim[1].stride;
ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
@ -189,3 +203,4 @@ matmul_l4 (gfc_array_l4 * const restrict retarray,
} }
#endif #endif

View File

@ -39,15 +39,15 @@ Boston, MA 02110-1301, USA. */
Either a or b can be rank 1. In this case x or y is 1. */ Either a or b can be rank 1. In this case x or y is 1. */
extern void matmul_l8 (gfc_array_l8 * const restrict, extern void matmul_l8 (gfc_array_l8 * const restrict,
gfc_array_l4 * const restrict, gfc_array_l4 * const restrict); gfc_array_l1 * const restrict, gfc_array_l1 * const restrict);
export_proto(matmul_l8); export_proto(matmul_l8);
void void
matmul_l8 (gfc_array_l8 * const restrict retarray, matmul_l8 (gfc_array_l8 * const restrict retarray,
gfc_array_l4 * const restrict a, gfc_array_l4 * const restrict b) gfc_array_l1 * const restrict a, gfc_array_l1 * const restrict b)
{ {
const GFC_INTEGER_4 * restrict abase; const GFC_LOGICAL_1 * restrict abase;
const GFC_INTEGER_4 * restrict bbase; const GFC_LOGICAL_1 * restrict bbase;
GFC_LOGICAL_8 * restrict dest; GFC_LOGICAL_8 * restrict dest;
index_type rxstride; index_type rxstride;
index_type rystride; index_type rystride;
@ -57,9 +57,11 @@ matmul_l8 (gfc_array_l8 * const restrict retarray,
index_type ystride; index_type ystride;
index_type x; index_type x;
index_type y; index_type y;
int a_kind;
int b_kind;
const GFC_INTEGER_4 * restrict pa; const GFC_LOGICAL_1 * restrict pa;
const GFC_INTEGER_4 * restrict pb; const GFC_LOGICAL_1 * restrict pb;
index_type astride; index_type astride;
index_type bstride; index_type bstride;
index_type count; index_type count;
@ -99,17 +101,29 @@ matmul_l8 (gfc_array_l8 * const restrict retarray,
} }
abase = a->data; abase = a->data;
if (GFC_DESCRIPTOR_SIZE (a) != 4) a_kind = GFC_DESCRIPTOR_SIZE (a);
{
assert (GFC_DESCRIPTOR_SIZE (a) == 8); if (a_kind == 1 || a_kind == 2 || a_kind == 4 || a_kind == 8
abase = GFOR_POINTER_L8_TO_L4 (abase); #ifdef HAVE_GFC_LOGICAL_16
} || a_kind == 16
#endif
)
abase = GFOR_POINTER_TO_L1 (abase, a_kind);
else
internal_error (NULL, "Funny sized logical array");
bbase = b->data; bbase = b->data;
if (GFC_DESCRIPTOR_SIZE (b) != 4) b_kind = GFC_DESCRIPTOR_SIZE (b);
{
assert (GFC_DESCRIPTOR_SIZE (b) == 8); if (b_kind == 1 || b_kind == 2 || b_kind == 4 || b_kind == 8
bbase = GFOR_POINTER_L8_TO_L4 (bbase); #ifdef HAVE_GFC_LOGICAL_16
} || b_kind == 16
#endif
)
bbase = GFOR_POINTER_TO_L1 (bbase, b_kind);
else
internal_error (NULL, "Funny sized logical array");
dest = retarray->data; dest = retarray->data;
@ -128,7 +142,7 @@ matmul_l8 (gfc_array_l8 * const restrict retarray,
one. */ one. */
if (GFC_DESCRIPTOR_RANK (a) == 1) if (GFC_DESCRIPTOR_RANK (a) == 1)
{ {
astride = a->dim[0].stride; astride = a->dim[0].stride * a_kind;
count = a->dim[0].ubound + 1 - a->dim[0].lbound; count = a->dim[0].ubound + 1 - a->dim[0].lbound;
xstride = 0; xstride = 0;
rxstride = 0; rxstride = 0;
@ -136,14 +150,14 @@ matmul_l8 (gfc_array_l8 * const restrict retarray,
} }
else else
{ {
astride = a->dim[1].stride; astride = a->dim[1].stride * a_kind;
count = a->dim[1].ubound + 1 - a->dim[1].lbound; count = a->dim[1].ubound + 1 - a->dim[1].lbound;
xstride = a->dim[0].stride; xstride = a->dim[0].stride;
xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
} }
if (GFC_DESCRIPTOR_RANK (b) == 1) if (GFC_DESCRIPTOR_RANK (b) == 1)
{ {
bstride = b->dim[0].stride; bstride = b->dim[0].stride * b_kind;
assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
ystride = 0; ystride = 0;
rystride = 0; rystride = 0;
@ -151,7 +165,7 @@ matmul_l8 (gfc_array_l8 * const restrict retarray,
} }
else else
{ {
bstride = b->dim[0].stride; bstride = b->dim[0].stride * b_kind;
assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
ystride = b->dim[1].stride; ystride = b->dim[1].stride;
ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
@ -189,3 +203,4 @@ matmul_l8 (gfc_array_l8 * const restrict retarray,
} }
#endif #endif

View File

@ -148,13 +148,13 @@ maxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
extern void mmaxloc0_16_i1 (gfc_array_i16 * const restrict, extern void mmaxloc0_16_i1 (gfc_array_i16 * const restrict,
gfc_array_i1 * const restrict, gfc_array_l4 * const restrict); gfc_array_i1 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_16_i1); export_proto(mmaxloc0_16_i1);
void void
mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray, mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
gfc_array_i1 * const restrict array, gfc_array_i1 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_16 *dest; GFC_INTEGER_16 *dest;
const GFC_INTEGER_1 *base; const GFC_INTEGER_1 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
extern void mmaxloc0_16_i16 (gfc_array_i16 * const restrict, extern void mmaxloc0_16_i16 (gfc_array_i16 * const restrict,
gfc_array_i16 * const restrict, gfc_array_l4 * const restrict); gfc_array_i16 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_16_i16); export_proto(mmaxloc0_16_i16);
void void
mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray, mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
gfc_array_i16 * const restrict array, gfc_array_i16 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_16 *dest; GFC_INTEGER_16 *dest;
const GFC_INTEGER_16 *base; const GFC_INTEGER_16 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
extern void mmaxloc0_16_i2 (gfc_array_i16 * const restrict, extern void mmaxloc0_16_i2 (gfc_array_i16 * const restrict,
gfc_array_i2 * const restrict, gfc_array_l4 * const restrict); gfc_array_i2 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_16_i2); export_proto(mmaxloc0_16_i2);
void void
mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray, mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
gfc_array_i2 * const restrict array, gfc_array_i2 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_16 *dest; GFC_INTEGER_16 *dest;
const GFC_INTEGER_2 *base; const GFC_INTEGER_2 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
extern void mmaxloc0_16_i4 (gfc_array_i16 * const restrict, extern void mmaxloc0_16_i4 (gfc_array_i16 * const restrict,
gfc_array_i4 * const restrict, gfc_array_l4 * const restrict); gfc_array_i4 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_16_i4); export_proto(mmaxloc0_16_i4);
void void
mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray, mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
gfc_array_i4 * const restrict array, gfc_array_i4 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_16 *dest; GFC_INTEGER_16 *dest;
const GFC_INTEGER_4 *base; const GFC_INTEGER_4 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
extern void mmaxloc0_16_i8 (gfc_array_i16 * const restrict, extern void mmaxloc0_16_i8 (gfc_array_i16 * const restrict,
gfc_array_i8 * const restrict, gfc_array_l4 * const restrict); gfc_array_i8 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_16_i8); export_proto(mmaxloc0_16_i8);
void void
mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray, mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
gfc_array_i8 * const restrict array, gfc_array_i8 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_16 *dest; GFC_INTEGER_16 *dest;
const GFC_INTEGER_8 *base; const GFC_INTEGER_8 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
extern void mmaxloc0_16_r10 (gfc_array_i16 * const restrict, extern void mmaxloc0_16_r10 (gfc_array_i16 * const restrict,
gfc_array_r10 * const restrict, gfc_array_l4 * const restrict); gfc_array_r10 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_16_r10); export_proto(mmaxloc0_16_r10);
void void
mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray, mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
gfc_array_r10 * const restrict array, gfc_array_r10 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_16 *dest; GFC_INTEGER_16 *dest;
const GFC_REAL_10 *base; const GFC_REAL_10 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
extern void mmaxloc0_16_r16 (gfc_array_i16 * const restrict, extern void mmaxloc0_16_r16 (gfc_array_i16 * const restrict,
gfc_array_r16 * const restrict, gfc_array_l4 * const restrict); gfc_array_r16 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_16_r16); export_proto(mmaxloc0_16_r16);
void void
mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray, mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
gfc_array_r16 * const restrict array, gfc_array_r16 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_16 *dest; GFC_INTEGER_16 *dest;
const GFC_REAL_16 *base; const GFC_REAL_16 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
extern void mmaxloc0_16_r4 (gfc_array_i16 * const restrict, extern void mmaxloc0_16_r4 (gfc_array_i16 * const restrict,
gfc_array_r4 * const restrict, gfc_array_l4 * const restrict); gfc_array_r4 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_16_r4); export_proto(mmaxloc0_16_r4);
void void
mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray, mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
gfc_array_r4 * const restrict array, gfc_array_r4 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_16 *dest; GFC_INTEGER_16 *dest;
const GFC_REAL_4 *base; const GFC_REAL_4 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
extern void mmaxloc0_16_r8 (gfc_array_i16 * const restrict, extern void mmaxloc0_16_r8 (gfc_array_i16 * const restrict,
gfc_array_r8 * const restrict, gfc_array_l4 * const restrict); gfc_array_r8 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_16_r8); export_proto(mmaxloc0_16_r8);
void void
mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray, mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
gfc_array_r8 * const restrict array, gfc_array_r8 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_16 *dest; GFC_INTEGER_16 *dest;
const GFC_REAL_8 *base; const GFC_REAL_8 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
extern void mmaxloc0_4_i1 (gfc_array_i4 * const restrict, extern void mmaxloc0_4_i1 (gfc_array_i4 * const restrict,
gfc_array_i1 * const restrict, gfc_array_l4 * const restrict); gfc_array_i1 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_4_i1); export_proto(mmaxloc0_4_i1);
void void
mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray, mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
gfc_array_i1 * const restrict array, gfc_array_i1 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_4 *dest; GFC_INTEGER_4 *dest;
const GFC_INTEGER_1 *base; const GFC_INTEGER_1 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
extern void mmaxloc0_4_i16 (gfc_array_i4 * const restrict, extern void mmaxloc0_4_i16 (gfc_array_i4 * const restrict,
gfc_array_i16 * const restrict, gfc_array_l4 * const restrict); gfc_array_i16 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_4_i16); export_proto(mmaxloc0_4_i16);
void void
mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray, mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
gfc_array_i16 * const restrict array, gfc_array_i16 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_4 *dest; GFC_INTEGER_4 *dest;
const GFC_INTEGER_16 *base; const GFC_INTEGER_16 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
extern void mmaxloc0_4_i2 (gfc_array_i4 * const restrict, extern void mmaxloc0_4_i2 (gfc_array_i4 * const restrict,
gfc_array_i2 * const restrict, gfc_array_l4 * const restrict); gfc_array_i2 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_4_i2); export_proto(mmaxloc0_4_i2);
void void
mmaxloc0_4_i2 (gfc_array_i4 * const restrict retarray, mmaxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
gfc_array_i2 * const restrict array, gfc_array_i2 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_4 *dest; GFC_INTEGER_4 *dest;
const GFC_INTEGER_2 *base; const GFC_INTEGER_2 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
extern void mmaxloc0_4_i4 (gfc_array_i4 * const restrict, extern void mmaxloc0_4_i4 (gfc_array_i4 * const restrict,
gfc_array_i4 * const restrict, gfc_array_l4 * const restrict); gfc_array_i4 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_4_i4); export_proto(mmaxloc0_4_i4);
void void
mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray, mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
gfc_array_i4 * const restrict array, gfc_array_i4 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_4 *dest; GFC_INTEGER_4 *dest;
const GFC_INTEGER_4 *base; const GFC_INTEGER_4 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
extern void mmaxloc0_4_i8 (gfc_array_i4 * const restrict, extern void mmaxloc0_4_i8 (gfc_array_i4 * const restrict,
gfc_array_i8 * const restrict, gfc_array_l4 * const restrict); gfc_array_i8 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_4_i8); export_proto(mmaxloc0_4_i8);
void void
mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray, mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
gfc_array_i8 * const restrict array, gfc_array_i8 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_4 *dest; GFC_INTEGER_4 *dest;
const GFC_INTEGER_8 *base; const GFC_INTEGER_8 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
extern void mmaxloc0_4_r10 (gfc_array_i4 * const restrict, extern void mmaxloc0_4_r10 (gfc_array_i4 * const restrict,
gfc_array_r10 * const restrict, gfc_array_l4 * const restrict); gfc_array_r10 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_4_r10); export_proto(mmaxloc0_4_r10);
void void
mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray, mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
gfc_array_r10 * const restrict array, gfc_array_r10 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_4 *dest; GFC_INTEGER_4 *dest;
const GFC_REAL_10 *base; const GFC_REAL_10 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
extern void mmaxloc0_4_r16 (gfc_array_i4 * const restrict, extern void mmaxloc0_4_r16 (gfc_array_i4 * const restrict,
gfc_array_r16 * const restrict, gfc_array_l4 * const restrict); gfc_array_r16 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_4_r16); export_proto(mmaxloc0_4_r16);
void void
mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray, mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
gfc_array_r16 * const restrict array, gfc_array_r16 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_4 *dest; GFC_INTEGER_4 *dest;
const GFC_REAL_16 *base; const GFC_REAL_16 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
extern void mmaxloc0_4_r4 (gfc_array_i4 * const restrict, extern void mmaxloc0_4_r4 (gfc_array_i4 * const restrict,
gfc_array_r4 * const restrict, gfc_array_l4 * const restrict); gfc_array_r4 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_4_r4); export_proto(mmaxloc0_4_r4);
void void
mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray, mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
gfc_array_r4 * const restrict array, gfc_array_r4 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_4 *dest; GFC_INTEGER_4 *dest;
const GFC_REAL_4 *base; const GFC_REAL_4 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
extern void mmaxloc0_4_r8 (gfc_array_i4 * const restrict, extern void mmaxloc0_4_r8 (gfc_array_i4 * const restrict,
gfc_array_r8 * const restrict, gfc_array_l4 * const restrict); gfc_array_r8 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_4_r8); export_proto(mmaxloc0_4_r8);
void void
mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray, mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
gfc_array_r8 * const restrict array, gfc_array_r8 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_4 *dest; GFC_INTEGER_4 *dest;
const GFC_REAL_8 *base; const GFC_REAL_8 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
extern void mmaxloc0_8_i1 (gfc_array_i8 * const restrict, extern void mmaxloc0_8_i1 (gfc_array_i8 * const restrict,
gfc_array_i1 * const restrict, gfc_array_l4 * const restrict); gfc_array_i1 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_8_i1); export_proto(mmaxloc0_8_i1);
void void
mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray, mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
gfc_array_i1 * const restrict array, gfc_array_i1 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_8 *dest; GFC_INTEGER_8 *dest;
const GFC_INTEGER_1 *base; const GFC_INTEGER_1 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
extern void mmaxloc0_8_i16 (gfc_array_i8 * const restrict, extern void mmaxloc0_8_i16 (gfc_array_i8 * const restrict,
gfc_array_i16 * const restrict, gfc_array_l4 * const restrict); gfc_array_i16 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_8_i16); export_proto(mmaxloc0_8_i16);
void void
mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray, mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
gfc_array_i16 * const restrict array, gfc_array_i16 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_8 *dest; GFC_INTEGER_8 *dest;
const GFC_INTEGER_16 *base; const GFC_INTEGER_16 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_8_i2 (gfc_array_i8 * const restrict retarray,
extern void mmaxloc0_8_i2 (gfc_array_i8 * const restrict, extern void mmaxloc0_8_i2 (gfc_array_i8 * const restrict,
gfc_array_i2 * const restrict, gfc_array_l4 * const restrict); gfc_array_i2 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_8_i2); export_proto(mmaxloc0_8_i2);
void void
mmaxloc0_8_i2 (gfc_array_i8 * const restrict retarray, mmaxloc0_8_i2 (gfc_array_i8 * const restrict retarray,
gfc_array_i2 * const restrict array, gfc_array_i2 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_8_i2 (gfc_array_i8 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_8 *dest; GFC_INTEGER_8 *dest;
const GFC_INTEGER_2 *base; const GFC_INTEGER_2 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_8_i2 (gfc_array_i8 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_8_i2 (gfc_array_i8 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_8_i4 (gfc_array_i8 * const restrict retarray,
extern void mmaxloc0_8_i4 (gfc_array_i8 * const restrict, extern void mmaxloc0_8_i4 (gfc_array_i8 * const restrict,
gfc_array_i4 * const restrict, gfc_array_l4 * const restrict); gfc_array_i4 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_8_i4); export_proto(mmaxloc0_8_i4);
void void
mmaxloc0_8_i4 (gfc_array_i8 * const restrict retarray, mmaxloc0_8_i4 (gfc_array_i8 * const restrict retarray,
gfc_array_i4 * const restrict array, gfc_array_i4 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_8_i4 (gfc_array_i8 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_8 *dest; GFC_INTEGER_8 *dest;
const GFC_INTEGER_4 *base; const GFC_INTEGER_4 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_8_i4 (gfc_array_i8 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_8_i4 (gfc_array_i8 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_8_i8 (gfc_array_i8 * const restrict retarray,
extern void mmaxloc0_8_i8 (gfc_array_i8 * const restrict, extern void mmaxloc0_8_i8 (gfc_array_i8 * const restrict,
gfc_array_i8 * const restrict, gfc_array_l4 * const restrict); gfc_array_i8 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_8_i8); export_proto(mmaxloc0_8_i8);
void void
mmaxloc0_8_i8 (gfc_array_i8 * const restrict retarray, mmaxloc0_8_i8 (gfc_array_i8 * const restrict retarray,
gfc_array_i8 * const restrict array, gfc_array_i8 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_8_i8 (gfc_array_i8 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_8 *dest; GFC_INTEGER_8 *dest;
const GFC_INTEGER_8 *base; const GFC_INTEGER_8 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_8_i8 (gfc_array_i8 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_8_i8 (gfc_array_i8 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_8_r10 (gfc_array_i8 * const restrict retarray,
extern void mmaxloc0_8_r10 (gfc_array_i8 * const restrict, extern void mmaxloc0_8_r10 (gfc_array_i8 * const restrict,
gfc_array_r10 * const restrict, gfc_array_l4 * const restrict); gfc_array_r10 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_8_r10); export_proto(mmaxloc0_8_r10);
void void
mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray,
gfc_array_r10 * const restrict array, gfc_array_r10 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_8 *dest; GFC_INTEGER_8 *dest;
const GFC_REAL_10 *base; const GFC_REAL_10 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_8_r16 (gfc_array_i8 * const restrict retarray,
extern void mmaxloc0_8_r16 (gfc_array_i8 * const restrict, extern void mmaxloc0_8_r16 (gfc_array_i8 * const restrict,
gfc_array_r16 * const restrict, gfc_array_l4 * const restrict); gfc_array_r16 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_8_r16); export_proto(mmaxloc0_8_r16);
void void
mmaxloc0_8_r16 (gfc_array_i8 * const restrict retarray, mmaxloc0_8_r16 (gfc_array_i8 * const restrict retarray,
gfc_array_r16 * const restrict array, gfc_array_r16 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_8_r16 (gfc_array_i8 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_8 *dest; GFC_INTEGER_8 *dest;
const GFC_REAL_16 *base; const GFC_REAL_16 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_8_r16 (gfc_array_i8 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_8_r16 (gfc_array_i8 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_8_r4 (gfc_array_i8 * const restrict retarray,
extern void mmaxloc0_8_r4 (gfc_array_i8 * const restrict, extern void mmaxloc0_8_r4 (gfc_array_i8 * const restrict,
gfc_array_r4 * const restrict, gfc_array_l4 * const restrict); gfc_array_r4 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_8_r4); export_proto(mmaxloc0_8_r4);
void void
mmaxloc0_8_r4 (gfc_array_i8 * const restrict retarray, mmaxloc0_8_r4 (gfc_array_i8 * const restrict retarray,
gfc_array_r4 * const restrict array, gfc_array_r4 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_8_r4 (gfc_array_i8 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_8 *dest; GFC_INTEGER_8 *dest;
const GFC_REAL_4 *base; const GFC_REAL_4 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_8_r4 (gfc_array_i8 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_8_r4 (gfc_array_i8 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ maxloc0_8_r8 (gfc_array_i8 * const restrict retarray,
extern void mmaxloc0_8_r8 (gfc_array_i8 * const restrict, extern void mmaxloc0_8_r8 (gfc_array_i8 * const restrict,
gfc_array_r8 * const restrict, gfc_array_l4 * const restrict); gfc_array_r8 * const restrict, gfc_array_l1 * const restrict);
export_proto(mmaxloc0_8_r8); export_proto(mmaxloc0_8_r8);
void void
mmaxloc0_8_r8 (gfc_array_i8 * const restrict retarray, mmaxloc0_8_r8 (gfc_array_i8 * const restrict retarray,
gfc_array_r8 * const restrict array, gfc_array_r8 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mmaxloc0_8_r8 (gfc_array_i8 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_8 *dest; GFC_INTEGER_8 *dest;
const GFC_REAL_8 *base; const GFC_REAL_8 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mmaxloc0_8_r8 (gfc_array_i8 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mmaxloc0_8_r8 (gfc_array_i8 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -191,14 +191,14 @@ maxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
extern void mmaxloc1_16_i1 (gfc_array_i16 * const restrict, extern void mmaxloc1_16_i1 (gfc_array_i16 * const restrict,
gfc_array_i1 * const restrict, const index_type * const restrict, gfc_array_i1 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_16_i1); export_proto(mmaxloc1_16_i1);
void void
mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
gfc_array_i1 * const restrict array, gfc_array_i1 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest; GFC_INTEGER_16 * restrict dest;
const GFC_INTEGER_1 * restrict base; const GFC_INTEGER_1 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_1 * restrict src; const GFC_INTEGER_1 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result; GFC_INTEGER_16 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
extern void mmaxloc1_16_i16 (gfc_array_i16 * const restrict, extern void mmaxloc1_16_i16 (gfc_array_i16 * const restrict,
gfc_array_i16 * const restrict, const index_type * const restrict, gfc_array_i16 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_16_i16); export_proto(mmaxloc1_16_i16);
void void
mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
gfc_array_i16 * const restrict array, gfc_array_i16 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest; GFC_INTEGER_16 * restrict dest;
const GFC_INTEGER_16 * restrict base; const GFC_INTEGER_16 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_16 * restrict src; const GFC_INTEGER_16 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result; GFC_INTEGER_16 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
extern void mmaxloc1_16_i2 (gfc_array_i16 * const restrict, extern void mmaxloc1_16_i2 (gfc_array_i16 * const restrict,
gfc_array_i2 * const restrict, const index_type * const restrict, gfc_array_i2 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_16_i2); export_proto(mmaxloc1_16_i2);
void void
mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
gfc_array_i2 * const restrict array, gfc_array_i2 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest; GFC_INTEGER_16 * restrict dest;
const GFC_INTEGER_2 * restrict base; const GFC_INTEGER_2 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_2 * restrict src; const GFC_INTEGER_2 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result; GFC_INTEGER_16 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
extern void mmaxloc1_16_i4 (gfc_array_i16 * const restrict, extern void mmaxloc1_16_i4 (gfc_array_i16 * const restrict,
gfc_array_i4 * const restrict, const index_type * const restrict, gfc_array_i4 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_16_i4); export_proto(mmaxloc1_16_i4);
void void
mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
gfc_array_i4 * const restrict array, gfc_array_i4 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest; GFC_INTEGER_16 * restrict dest;
const GFC_INTEGER_4 * restrict base; const GFC_INTEGER_4 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_4 * restrict src; const GFC_INTEGER_4 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result; GFC_INTEGER_16 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
extern void mmaxloc1_16_i8 (gfc_array_i16 * const restrict, extern void mmaxloc1_16_i8 (gfc_array_i16 * const restrict,
gfc_array_i8 * const restrict, const index_type * const restrict, gfc_array_i8 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_16_i8); export_proto(mmaxloc1_16_i8);
void void
mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
gfc_array_i8 * const restrict array, gfc_array_i8 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest; GFC_INTEGER_16 * restrict dest;
const GFC_INTEGER_8 * restrict base; const GFC_INTEGER_8 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_8 * restrict src; const GFC_INTEGER_8 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result; GFC_INTEGER_16 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
extern void mmaxloc1_16_r10 (gfc_array_i16 * const restrict, extern void mmaxloc1_16_r10 (gfc_array_i16 * const restrict,
gfc_array_r10 * const restrict, const index_type * const restrict, gfc_array_r10 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_16_r10); export_proto(mmaxloc1_16_r10);
void void
mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
gfc_array_r10 * const restrict array, gfc_array_r10 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest; GFC_INTEGER_16 * restrict dest;
const GFC_REAL_10 * restrict base; const GFC_REAL_10 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_REAL_10 * restrict src; const GFC_REAL_10 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result; GFC_INTEGER_16 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
extern void mmaxloc1_16_r16 (gfc_array_i16 * const restrict, extern void mmaxloc1_16_r16 (gfc_array_i16 * const restrict,
gfc_array_r16 * const restrict, const index_type * const restrict, gfc_array_r16 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_16_r16); export_proto(mmaxloc1_16_r16);
void void
mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
gfc_array_r16 * const restrict array, gfc_array_r16 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest; GFC_INTEGER_16 * restrict dest;
const GFC_REAL_16 * restrict base; const GFC_REAL_16 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_REAL_16 * restrict src; const GFC_REAL_16 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result; GFC_INTEGER_16 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
extern void mmaxloc1_16_r4 (gfc_array_i16 * const restrict, extern void mmaxloc1_16_r4 (gfc_array_i16 * const restrict,
gfc_array_r4 * const restrict, const index_type * const restrict, gfc_array_r4 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_16_r4); export_proto(mmaxloc1_16_r4);
void void
mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
gfc_array_r4 * const restrict array, gfc_array_r4 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest; GFC_INTEGER_16 * restrict dest;
const GFC_REAL_4 * restrict base; const GFC_REAL_4 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_REAL_4 * restrict src; const GFC_REAL_4 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result; GFC_INTEGER_16 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
extern void mmaxloc1_16_r8 (gfc_array_i16 * const restrict, extern void mmaxloc1_16_r8 (gfc_array_i16 * const restrict,
gfc_array_r8 * const restrict, const index_type * const restrict, gfc_array_r8 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_16_r8); export_proto(mmaxloc1_16_r8);
void void
mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
gfc_array_r8 * const restrict array, gfc_array_r8 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest; GFC_INTEGER_16 * restrict dest;
const GFC_REAL_8 * restrict base; const GFC_REAL_8 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_REAL_8 * restrict src; const GFC_REAL_8 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result; GFC_INTEGER_16 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
extern void mmaxloc1_4_i1 (gfc_array_i4 * const restrict, extern void mmaxloc1_4_i1 (gfc_array_i4 * const restrict,
gfc_array_i1 * const restrict, const index_type * const restrict, gfc_array_i1 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_4_i1); export_proto(mmaxloc1_4_i1);
void void
mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
gfc_array_i1 * const restrict array, gfc_array_i1 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_4 * restrict dest; GFC_INTEGER_4 * restrict dest;
const GFC_INTEGER_1 * restrict base; const GFC_INTEGER_1 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_1 * restrict src; const GFC_INTEGER_1 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_4 result; GFC_INTEGER_4 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
extern void mmaxloc1_4_i16 (gfc_array_i4 * const restrict, extern void mmaxloc1_4_i16 (gfc_array_i4 * const restrict,
gfc_array_i16 * const restrict, const index_type * const restrict, gfc_array_i16 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_4_i16); export_proto(mmaxloc1_4_i16);
void void
mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
gfc_array_i16 * const restrict array, gfc_array_i16 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_4 * restrict dest; GFC_INTEGER_4 * restrict dest;
const GFC_INTEGER_16 * restrict base; const GFC_INTEGER_16 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_16 * restrict src; const GFC_INTEGER_16 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_4 result; GFC_INTEGER_4 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
extern void mmaxloc1_4_i2 (gfc_array_i4 * const restrict, extern void mmaxloc1_4_i2 (gfc_array_i4 * const restrict,
gfc_array_i2 * const restrict, const index_type * const restrict, gfc_array_i2 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_4_i2); export_proto(mmaxloc1_4_i2);
void void
mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
gfc_array_i2 * const restrict array, gfc_array_i2 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_4 * restrict dest; GFC_INTEGER_4 * restrict dest;
const GFC_INTEGER_2 * restrict base; const GFC_INTEGER_2 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_2 * restrict src; const GFC_INTEGER_2 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_4 result; GFC_INTEGER_4 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
extern void mmaxloc1_4_i4 (gfc_array_i4 * const restrict, extern void mmaxloc1_4_i4 (gfc_array_i4 * const restrict,
gfc_array_i4 * const restrict, const index_type * const restrict, gfc_array_i4 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_4_i4); export_proto(mmaxloc1_4_i4);
void void
mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
gfc_array_i4 * const restrict array, gfc_array_i4 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_4 * restrict dest; GFC_INTEGER_4 * restrict dest;
const GFC_INTEGER_4 * restrict base; const GFC_INTEGER_4 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_4 * restrict src; const GFC_INTEGER_4 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_4 result; GFC_INTEGER_4 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
extern void mmaxloc1_4_i8 (gfc_array_i4 * const restrict, extern void mmaxloc1_4_i8 (gfc_array_i4 * const restrict,
gfc_array_i8 * const restrict, const index_type * const restrict, gfc_array_i8 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_4_i8); export_proto(mmaxloc1_4_i8);
void void
mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
gfc_array_i8 * const restrict array, gfc_array_i8 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_4 * restrict dest; GFC_INTEGER_4 * restrict dest;
const GFC_INTEGER_8 * restrict base; const GFC_INTEGER_8 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_8 * restrict src; const GFC_INTEGER_8 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_4 result; GFC_INTEGER_4 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
extern void mmaxloc1_4_r10 (gfc_array_i4 * const restrict, extern void mmaxloc1_4_r10 (gfc_array_i4 * const restrict,
gfc_array_r10 * const restrict, const index_type * const restrict, gfc_array_r10 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_4_r10); export_proto(mmaxloc1_4_r10);
void void
mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
gfc_array_r10 * const restrict array, gfc_array_r10 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_4 * restrict dest; GFC_INTEGER_4 * restrict dest;
const GFC_REAL_10 * restrict base; const GFC_REAL_10 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_REAL_10 * restrict src; const GFC_REAL_10 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_4 result; GFC_INTEGER_4 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
extern void mmaxloc1_4_r16 (gfc_array_i4 * const restrict, extern void mmaxloc1_4_r16 (gfc_array_i4 * const restrict,
gfc_array_r16 * const restrict, const index_type * const restrict, gfc_array_r16 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_4_r16); export_proto(mmaxloc1_4_r16);
void void
mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
gfc_array_r16 * const restrict array, gfc_array_r16 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_4 * restrict dest; GFC_INTEGER_4 * restrict dest;
const GFC_REAL_16 * restrict base; const GFC_REAL_16 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_REAL_16 * restrict src; const GFC_REAL_16 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_4 result; GFC_INTEGER_4 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
extern void mmaxloc1_4_r4 (gfc_array_i4 * const restrict, extern void mmaxloc1_4_r4 (gfc_array_i4 * const restrict,
gfc_array_r4 * const restrict, const index_type * const restrict, gfc_array_r4 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_4_r4); export_proto(mmaxloc1_4_r4);
void void
mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
gfc_array_r4 * const restrict array, gfc_array_r4 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_4 * restrict dest; GFC_INTEGER_4 * restrict dest;
const GFC_REAL_4 * restrict base; const GFC_REAL_4 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_REAL_4 * restrict src; const GFC_REAL_4 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_4 result; GFC_INTEGER_4 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
extern void mmaxloc1_4_r8 (gfc_array_i4 * const restrict, extern void mmaxloc1_4_r8 (gfc_array_i4 * const restrict,
gfc_array_r8 * const restrict, const index_type * const restrict, gfc_array_r8 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_4_r8); export_proto(mmaxloc1_4_r8);
void void
mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
gfc_array_r8 * const restrict array, gfc_array_r8 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_4 * restrict dest; GFC_INTEGER_4 * restrict dest;
const GFC_REAL_8 * restrict base; const GFC_REAL_8 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_REAL_8 * restrict src; const GFC_REAL_8 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_4 result; GFC_INTEGER_4 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
extern void mmaxloc1_8_i1 (gfc_array_i8 * const restrict, extern void mmaxloc1_8_i1 (gfc_array_i8 * const restrict,
gfc_array_i1 * const restrict, const index_type * const restrict, gfc_array_i1 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_8_i1); export_proto(mmaxloc1_8_i1);
void void
mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
gfc_array_i1 * const restrict array, gfc_array_i1 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest; GFC_INTEGER_8 * restrict dest;
const GFC_INTEGER_1 * restrict base; const GFC_INTEGER_1 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_1 * restrict src; const GFC_INTEGER_1 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_8 result; GFC_INTEGER_8 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
extern void mmaxloc1_8_i16 (gfc_array_i8 * const restrict, extern void mmaxloc1_8_i16 (gfc_array_i8 * const restrict,
gfc_array_i16 * const restrict, const index_type * const restrict, gfc_array_i16 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_8_i16); export_proto(mmaxloc1_8_i16);
void void
mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
gfc_array_i16 * const restrict array, gfc_array_i16 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest; GFC_INTEGER_8 * restrict dest;
const GFC_INTEGER_16 * restrict base; const GFC_INTEGER_16 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_16 * restrict src; const GFC_INTEGER_16 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_8 result; GFC_INTEGER_8 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
extern void mmaxloc1_8_i2 (gfc_array_i8 * const restrict, extern void mmaxloc1_8_i2 (gfc_array_i8 * const restrict,
gfc_array_i2 * const restrict, const index_type * const restrict, gfc_array_i2 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_8_i2); export_proto(mmaxloc1_8_i2);
void void
mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
gfc_array_i2 * const restrict array, gfc_array_i2 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest; GFC_INTEGER_8 * restrict dest;
const GFC_INTEGER_2 * restrict base; const GFC_INTEGER_2 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_2 * restrict src; const GFC_INTEGER_2 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_8 result; GFC_INTEGER_8 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
extern void mmaxloc1_8_i4 (gfc_array_i8 * const restrict, extern void mmaxloc1_8_i4 (gfc_array_i8 * const restrict,
gfc_array_i4 * const restrict, const index_type * const restrict, gfc_array_i4 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_8_i4); export_proto(mmaxloc1_8_i4);
void void
mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
gfc_array_i4 * const restrict array, gfc_array_i4 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest; GFC_INTEGER_8 * restrict dest;
const GFC_INTEGER_4 * restrict base; const GFC_INTEGER_4 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_4 * restrict src; const GFC_INTEGER_4 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_8 result; GFC_INTEGER_8 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
extern void mmaxloc1_8_i8 (gfc_array_i8 * const restrict, extern void mmaxloc1_8_i8 (gfc_array_i8 * const restrict,
gfc_array_i8 * const restrict, const index_type * const restrict, gfc_array_i8 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_8_i8); export_proto(mmaxloc1_8_i8);
void void
mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
gfc_array_i8 * const restrict array, gfc_array_i8 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest; GFC_INTEGER_8 * restrict dest;
const GFC_INTEGER_8 * restrict base; const GFC_INTEGER_8 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_8 * restrict src; const GFC_INTEGER_8 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_8 result; GFC_INTEGER_8 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
extern void mmaxloc1_8_r10 (gfc_array_i8 * const restrict, extern void mmaxloc1_8_r10 (gfc_array_i8 * const restrict,
gfc_array_r10 * const restrict, const index_type * const restrict, gfc_array_r10 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_8_r10); export_proto(mmaxloc1_8_r10);
void void
mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
gfc_array_r10 * const restrict array, gfc_array_r10 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest; GFC_INTEGER_8 * restrict dest;
const GFC_REAL_10 * restrict base; const GFC_REAL_10 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_REAL_10 * restrict src; const GFC_REAL_10 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_8 result; GFC_INTEGER_8 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
extern void mmaxloc1_8_r16 (gfc_array_i8 * const restrict, extern void mmaxloc1_8_r16 (gfc_array_i8 * const restrict,
gfc_array_r16 * const restrict, const index_type * const restrict, gfc_array_r16 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_8_r16); export_proto(mmaxloc1_8_r16);
void void
mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
gfc_array_r16 * const restrict array, gfc_array_r16 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest; GFC_INTEGER_8 * restrict dest;
const GFC_REAL_16 * restrict base; const GFC_REAL_16 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_REAL_16 * restrict src; const GFC_REAL_16 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_8 result; GFC_INTEGER_8 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
extern void mmaxloc1_8_r4 (gfc_array_i8 * const restrict, extern void mmaxloc1_8_r4 (gfc_array_i8 * const restrict,
gfc_array_r4 * const restrict, const index_type * const restrict, gfc_array_r4 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_8_r4); export_proto(mmaxloc1_8_r4);
void void
mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
gfc_array_r4 * const restrict array, gfc_array_r4 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest; GFC_INTEGER_8 * restrict dest;
const GFC_REAL_4 * restrict base; const GFC_REAL_4 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_REAL_4 * restrict src; const GFC_REAL_4 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_8 result; GFC_INTEGER_8 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ maxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
extern void mmaxloc1_8_r8 (gfc_array_i8 * const restrict, extern void mmaxloc1_8_r8 (gfc_array_i8 * const restrict,
gfc_array_r8 * const restrict, const index_type * const restrict, gfc_array_r8 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxloc1_8_r8); export_proto(mmaxloc1_8_r8);
void void
mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
gfc_array_r8 * const restrict array, gfc_array_r8 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest; GFC_INTEGER_8 * restrict dest;
const GFC_REAL_8 * restrict base; const GFC_REAL_8 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_REAL_8 * restrict src; const GFC_REAL_8 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_8 result; GFC_INTEGER_8 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -185,14 +185,14 @@ maxval_i1 (gfc_array_i1 * const restrict retarray,
extern void mmaxval_i1 (gfc_array_i1 * const restrict, extern void mmaxval_i1 (gfc_array_i1 * const restrict,
gfc_array_i1 * const restrict, const index_type * const restrict, gfc_array_i1 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxval_i1); export_proto(mmaxval_i1);
void void
mmaxval_i1 (gfc_array_i1 * const restrict retarray, mmaxval_i1 (gfc_array_i1 * const restrict retarray,
gfc_array_i1 * const restrict array, gfc_array_i1 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -201,13 +201,14 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_1 * restrict dest; GFC_INTEGER_1 * restrict dest;
const GFC_INTEGER_1 * restrict base; const GFC_INTEGER_1 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -215,13 +216,27 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -231,7 +246,7 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -286,22 +301,11 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_1 * restrict src; const GFC_INTEGER_1 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_1 result; GFC_INTEGER_1 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -185,14 +185,14 @@ maxval_i16 (gfc_array_i16 * const restrict retarray,
extern void mmaxval_i16 (gfc_array_i16 * const restrict, extern void mmaxval_i16 (gfc_array_i16 * const restrict,
gfc_array_i16 * const restrict, const index_type * const restrict, gfc_array_i16 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxval_i16); export_proto(mmaxval_i16);
void void
mmaxval_i16 (gfc_array_i16 * const restrict retarray, mmaxval_i16 (gfc_array_i16 * const restrict retarray,
gfc_array_i16 * const restrict array, gfc_array_i16 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -201,13 +201,14 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest; GFC_INTEGER_16 * restrict dest;
const GFC_INTEGER_16 * restrict base; const GFC_INTEGER_16 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -215,13 +216,27 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -231,7 +246,7 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -286,22 +301,11 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_16 * restrict src; const GFC_INTEGER_16 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result; GFC_INTEGER_16 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -185,14 +185,14 @@ maxval_i2 (gfc_array_i2 * const restrict retarray,
extern void mmaxval_i2 (gfc_array_i2 * const restrict, extern void mmaxval_i2 (gfc_array_i2 * const restrict,
gfc_array_i2 * const restrict, const index_type * const restrict, gfc_array_i2 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxval_i2); export_proto(mmaxval_i2);
void void
mmaxval_i2 (gfc_array_i2 * const restrict retarray, mmaxval_i2 (gfc_array_i2 * const restrict retarray,
gfc_array_i2 * const restrict array, gfc_array_i2 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -201,13 +201,14 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_2 * restrict dest; GFC_INTEGER_2 * restrict dest;
const GFC_INTEGER_2 * restrict base; const GFC_INTEGER_2 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -215,13 +216,27 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -231,7 +246,7 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -286,22 +301,11 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_2 * restrict src; const GFC_INTEGER_2 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_2 result; GFC_INTEGER_2 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -185,14 +185,14 @@ maxval_i4 (gfc_array_i4 * const restrict retarray,
extern void mmaxval_i4 (gfc_array_i4 * const restrict, extern void mmaxval_i4 (gfc_array_i4 * const restrict,
gfc_array_i4 * const restrict, const index_type * const restrict, gfc_array_i4 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxval_i4); export_proto(mmaxval_i4);
void void
mmaxval_i4 (gfc_array_i4 * const restrict retarray, mmaxval_i4 (gfc_array_i4 * const restrict retarray,
gfc_array_i4 * const restrict array, gfc_array_i4 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -201,13 +201,14 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_4 * restrict dest; GFC_INTEGER_4 * restrict dest;
const GFC_INTEGER_4 * restrict base; const GFC_INTEGER_4 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -215,13 +216,27 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -231,7 +246,7 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -286,22 +301,11 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_4 * restrict src; const GFC_INTEGER_4 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_4 result; GFC_INTEGER_4 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -185,14 +185,14 @@ maxval_i8 (gfc_array_i8 * const restrict retarray,
extern void mmaxval_i8 (gfc_array_i8 * const restrict, extern void mmaxval_i8 (gfc_array_i8 * const restrict,
gfc_array_i8 * const restrict, const index_type * const restrict, gfc_array_i8 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxval_i8); export_proto(mmaxval_i8);
void void
mmaxval_i8 (gfc_array_i8 * const restrict retarray, mmaxval_i8 (gfc_array_i8 * const restrict retarray,
gfc_array_i8 * const restrict array, gfc_array_i8 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -201,13 +201,14 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest; GFC_INTEGER_8 * restrict dest;
const GFC_INTEGER_8 * restrict base; const GFC_INTEGER_8 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -215,13 +216,27 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -231,7 +246,7 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -286,22 +301,11 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_8 * restrict src; const GFC_INTEGER_8 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_8 result; GFC_INTEGER_8 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -185,14 +185,14 @@ maxval_r10 (gfc_array_r10 * const restrict retarray,
extern void mmaxval_r10 (gfc_array_r10 * const restrict, extern void mmaxval_r10 (gfc_array_r10 * const restrict,
gfc_array_r10 * const restrict, const index_type * const restrict, gfc_array_r10 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxval_r10); export_proto(mmaxval_r10);
void void
mmaxval_r10 (gfc_array_r10 * const restrict retarray, mmaxval_r10 (gfc_array_r10 * const restrict retarray,
gfc_array_r10 * const restrict array, gfc_array_r10 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -201,13 +201,14 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_REAL_10 * restrict dest; GFC_REAL_10 * restrict dest;
const GFC_REAL_10 * restrict base; const GFC_REAL_10 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -215,13 +216,27 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -231,7 +246,7 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -286,22 +301,11 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_REAL_10 * restrict src; const GFC_REAL_10 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_REAL_10 result; GFC_REAL_10 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -185,14 +185,14 @@ maxval_r16 (gfc_array_r16 * const restrict retarray,
extern void mmaxval_r16 (gfc_array_r16 * const restrict, extern void mmaxval_r16 (gfc_array_r16 * const restrict,
gfc_array_r16 * const restrict, const index_type * const restrict, gfc_array_r16 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxval_r16); export_proto(mmaxval_r16);
void void
mmaxval_r16 (gfc_array_r16 * const restrict retarray, mmaxval_r16 (gfc_array_r16 * const restrict retarray,
gfc_array_r16 * const restrict array, gfc_array_r16 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -201,13 +201,14 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_REAL_16 * restrict dest; GFC_REAL_16 * restrict dest;
const GFC_REAL_16 * restrict base; const GFC_REAL_16 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -215,13 +216,27 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -231,7 +246,7 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -286,22 +301,11 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_REAL_16 * restrict src; const GFC_REAL_16 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_REAL_16 result; GFC_REAL_16 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -185,14 +185,14 @@ maxval_r4 (gfc_array_r4 * const restrict retarray,
extern void mmaxval_r4 (gfc_array_r4 * const restrict, extern void mmaxval_r4 (gfc_array_r4 * const restrict,
gfc_array_r4 * const restrict, const index_type * const restrict, gfc_array_r4 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxval_r4); export_proto(mmaxval_r4);
void void
mmaxval_r4 (gfc_array_r4 * const restrict retarray, mmaxval_r4 (gfc_array_r4 * const restrict retarray,
gfc_array_r4 * const restrict array, gfc_array_r4 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -201,13 +201,14 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_REAL_4 * restrict dest; GFC_REAL_4 * restrict dest;
const GFC_REAL_4 * restrict base; const GFC_REAL_4 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -215,13 +216,27 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -231,7 +246,7 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -286,22 +301,11 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_REAL_4 * restrict src; const GFC_REAL_4 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_REAL_4 result; GFC_REAL_4 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -185,14 +185,14 @@ maxval_r8 (gfc_array_r8 * const restrict retarray,
extern void mmaxval_r8 (gfc_array_r8 * const restrict, extern void mmaxval_r8 (gfc_array_r8 * const restrict,
gfc_array_r8 * const restrict, const index_type * const restrict, gfc_array_r8 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mmaxval_r8); export_proto(mmaxval_r8);
void void
mmaxval_r8 (gfc_array_r8 * const restrict retarray, mmaxval_r8 (gfc_array_r8 * const restrict retarray,
gfc_array_r8 * const restrict array, gfc_array_r8 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -201,13 +201,14 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_REAL_8 * restrict dest; GFC_REAL_8 * restrict dest;
const GFC_REAL_8 * restrict base; const GFC_REAL_8 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -215,13 +216,27 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -231,7 +246,7 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -286,22 +301,11 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_REAL_8 * restrict src; const GFC_REAL_8 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_REAL_8 result; GFC_REAL_8 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -148,13 +148,13 @@ minloc0_16_i1 (gfc_array_i16 * const restrict retarray,
extern void mminloc0_16_i1 (gfc_array_i16 * const restrict, extern void mminloc0_16_i1 (gfc_array_i16 * const restrict,
gfc_array_i1 * const restrict, gfc_array_l4 * const restrict); gfc_array_i1 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_16_i1); export_proto(mminloc0_16_i1);
void void
mminloc0_16_i1 (gfc_array_i16 * const restrict retarray, mminloc0_16_i1 (gfc_array_i16 * const restrict retarray,
gfc_array_i1 * const restrict array, gfc_array_i1 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_16_i1 (gfc_array_i16 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_16 *dest; GFC_INTEGER_16 *dest;
const GFC_INTEGER_1 *base; const GFC_INTEGER_1 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_16_i1 (gfc_array_i16 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_16_i1 (gfc_array_i16 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_16_i16 (gfc_array_i16 * const restrict retarray,
extern void mminloc0_16_i16 (gfc_array_i16 * const restrict, extern void mminloc0_16_i16 (gfc_array_i16 * const restrict,
gfc_array_i16 * const restrict, gfc_array_l4 * const restrict); gfc_array_i16 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_16_i16); export_proto(mminloc0_16_i16);
void void
mminloc0_16_i16 (gfc_array_i16 * const restrict retarray, mminloc0_16_i16 (gfc_array_i16 * const restrict retarray,
gfc_array_i16 * const restrict array, gfc_array_i16 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_16_i16 (gfc_array_i16 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_16 *dest; GFC_INTEGER_16 *dest;
const GFC_INTEGER_16 *base; const GFC_INTEGER_16 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_16_i16 (gfc_array_i16 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_16_i16 (gfc_array_i16 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_16_i2 (gfc_array_i16 * const restrict retarray,
extern void mminloc0_16_i2 (gfc_array_i16 * const restrict, extern void mminloc0_16_i2 (gfc_array_i16 * const restrict,
gfc_array_i2 * const restrict, gfc_array_l4 * const restrict); gfc_array_i2 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_16_i2); export_proto(mminloc0_16_i2);
void void
mminloc0_16_i2 (gfc_array_i16 * const restrict retarray, mminloc0_16_i2 (gfc_array_i16 * const restrict retarray,
gfc_array_i2 * const restrict array, gfc_array_i2 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_16_i2 (gfc_array_i16 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_16 *dest; GFC_INTEGER_16 *dest;
const GFC_INTEGER_2 *base; const GFC_INTEGER_2 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_16_i2 (gfc_array_i16 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_16_i2 (gfc_array_i16 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_16_i4 (gfc_array_i16 * const restrict retarray,
extern void mminloc0_16_i4 (gfc_array_i16 * const restrict, extern void mminloc0_16_i4 (gfc_array_i16 * const restrict,
gfc_array_i4 * const restrict, gfc_array_l4 * const restrict); gfc_array_i4 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_16_i4); export_proto(mminloc0_16_i4);
void void
mminloc0_16_i4 (gfc_array_i16 * const restrict retarray, mminloc0_16_i4 (gfc_array_i16 * const restrict retarray,
gfc_array_i4 * const restrict array, gfc_array_i4 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_16_i4 (gfc_array_i16 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_16 *dest; GFC_INTEGER_16 *dest;
const GFC_INTEGER_4 *base; const GFC_INTEGER_4 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_16_i4 (gfc_array_i16 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_16_i4 (gfc_array_i16 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_16_i8 (gfc_array_i16 * const restrict retarray,
extern void mminloc0_16_i8 (gfc_array_i16 * const restrict, extern void mminloc0_16_i8 (gfc_array_i16 * const restrict,
gfc_array_i8 * const restrict, gfc_array_l4 * const restrict); gfc_array_i8 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_16_i8); export_proto(mminloc0_16_i8);
void void
mminloc0_16_i8 (gfc_array_i16 * const restrict retarray, mminloc0_16_i8 (gfc_array_i16 * const restrict retarray,
gfc_array_i8 * const restrict array, gfc_array_i8 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_16_i8 (gfc_array_i16 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_16 *dest; GFC_INTEGER_16 *dest;
const GFC_INTEGER_8 *base; const GFC_INTEGER_8 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_16_i8 (gfc_array_i16 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_16_i8 (gfc_array_i16 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_16_r10 (gfc_array_i16 * const restrict retarray,
extern void mminloc0_16_r10 (gfc_array_i16 * const restrict, extern void mminloc0_16_r10 (gfc_array_i16 * const restrict,
gfc_array_r10 * const restrict, gfc_array_l4 * const restrict); gfc_array_r10 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_16_r10); export_proto(mminloc0_16_r10);
void void
mminloc0_16_r10 (gfc_array_i16 * const restrict retarray, mminloc0_16_r10 (gfc_array_i16 * const restrict retarray,
gfc_array_r10 * const restrict array, gfc_array_r10 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_16_r10 (gfc_array_i16 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_16 *dest; GFC_INTEGER_16 *dest;
const GFC_REAL_10 *base; const GFC_REAL_10 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_16_r10 (gfc_array_i16 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_16_r10 (gfc_array_i16 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_16_r16 (gfc_array_i16 * const restrict retarray,
extern void mminloc0_16_r16 (gfc_array_i16 * const restrict, extern void mminloc0_16_r16 (gfc_array_i16 * const restrict,
gfc_array_r16 * const restrict, gfc_array_l4 * const restrict); gfc_array_r16 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_16_r16); export_proto(mminloc0_16_r16);
void void
mminloc0_16_r16 (gfc_array_i16 * const restrict retarray, mminloc0_16_r16 (gfc_array_i16 * const restrict retarray,
gfc_array_r16 * const restrict array, gfc_array_r16 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_16_r16 (gfc_array_i16 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_16 *dest; GFC_INTEGER_16 *dest;
const GFC_REAL_16 *base; const GFC_REAL_16 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_16_r16 (gfc_array_i16 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_16_r16 (gfc_array_i16 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_16_r4 (gfc_array_i16 * const restrict retarray,
extern void mminloc0_16_r4 (gfc_array_i16 * const restrict, extern void mminloc0_16_r4 (gfc_array_i16 * const restrict,
gfc_array_r4 * const restrict, gfc_array_l4 * const restrict); gfc_array_r4 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_16_r4); export_proto(mminloc0_16_r4);
void void
mminloc0_16_r4 (gfc_array_i16 * const restrict retarray, mminloc0_16_r4 (gfc_array_i16 * const restrict retarray,
gfc_array_r4 * const restrict array, gfc_array_r4 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_16_r4 (gfc_array_i16 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_16 *dest; GFC_INTEGER_16 *dest;
const GFC_REAL_4 *base; const GFC_REAL_4 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_16_r4 (gfc_array_i16 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_16_r4 (gfc_array_i16 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_16_r8 (gfc_array_i16 * const restrict retarray,
extern void mminloc0_16_r8 (gfc_array_i16 * const restrict, extern void mminloc0_16_r8 (gfc_array_i16 * const restrict,
gfc_array_r8 * const restrict, gfc_array_l4 * const restrict); gfc_array_r8 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_16_r8); export_proto(mminloc0_16_r8);
void void
mminloc0_16_r8 (gfc_array_i16 * const restrict retarray, mminloc0_16_r8 (gfc_array_i16 * const restrict retarray,
gfc_array_r8 * const restrict array, gfc_array_r8 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_16_r8 (gfc_array_i16 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_16 *dest; GFC_INTEGER_16 *dest;
const GFC_REAL_8 *base; const GFC_REAL_8 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_16_r8 (gfc_array_i16 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_16_r8 (gfc_array_i16 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_4_i1 (gfc_array_i4 * const restrict retarray,
extern void mminloc0_4_i1 (gfc_array_i4 * const restrict, extern void mminloc0_4_i1 (gfc_array_i4 * const restrict,
gfc_array_i1 * const restrict, gfc_array_l4 * const restrict); gfc_array_i1 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_4_i1); export_proto(mminloc0_4_i1);
void void
mminloc0_4_i1 (gfc_array_i4 * const restrict retarray, mminloc0_4_i1 (gfc_array_i4 * const restrict retarray,
gfc_array_i1 * const restrict array, gfc_array_i1 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_4_i1 (gfc_array_i4 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_4 *dest; GFC_INTEGER_4 *dest;
const GFC_INTEGER_1 *base; const GFC_INTEGER_1 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_4_i1 (gfc_array_i4 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_4_i1 (gfc_array_i4 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_4_i16 (gfc_array_i4 * const restrict retarray,
extern void mminloc0_4_i16 (gfc_array_i4 * const restrict, extern void mminloc0_4_i16 (gfc_array_i4 * const restrict,
gfc_array_i16 * const restrict, gfc_array_l4 * const restrict); gfc_array_i16 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_4_i16); export_proto(mminloc0_4_i16);
void void
mminloc0_4_i16 (gfc_array_i4 * const restrict retarray, mminloc0_4_i16 (gfc_array_i4 * const restrict retarray,
gfc_array_i16 * const restrict array, gfc_array_i16 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_4_i16 (gfc_array_i4 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_4 *dest; GFC_INTEGER_4 *dest;
const GFC_INTEGER_16 *base; const GFC_INTEGER_16 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_4_i16 (gfc_array_i4 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_4_i16 (gfc_array_i4 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_4_i2 (gfc_array_i4 * const restrict retarray,
extern void mminloc0_4_i2 (gfc_array_i4 * const restrict, extern void mminloc0_4_i2 (gfc_array_i4 * const restrict,
gfc_array_i2 * const restrict, gfc_array_l4 * const restrict); gfc_array_i2 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_4_i2); export_proto(mminloc0_4_i2);
void void
mminloc0_4_i2 (gfc_array_i4 * const restrict retarray, mminloc0_4_i2 (gfc_array_i4 * const restrict retarray,
gfc_array_i2 * const restrict array, gfc_array_i2 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_4_i2 (gfc_array_i4 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_4 *dest; GFC_INTEGER_4 *dest;
const GFC_INTEGER_2 *base; const GFC_INTEGER_2 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_4_i2 (gfc_array_i4 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_4_i2 (gfc_array_i4 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_4_i4 (gfc_array_i4 * const restrict retarray,
extern void mminloc0_4_i4 (gfc_array_i4 * const restrict, extern void mminloc0_4_i4 (gfc_array_i4 * const restrict,
gfc_array_i4 * const restrict, gfc_array_l4 * const restrict); gfc_array_i4 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_4_i4); export_proto(mminloc0_4_i4);
void void
mminloc0_4_i4 (gfc_array_i4 * const restrict retarray, mminloc0_4_i4 (gfc_array_i4 * const restrict retarray,
gfc_array_i4 * const restrict array, gfc_array_i4 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_4_i4 (gfc_array_i4 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_4 *dest; GFC_INTEGER_4 *dest;
const GFC_INTEGER_4 *base; const GFC_INTEGER_4 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_4_i4 (gfc_array_i4 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_4_i4 (gfc_array_i4 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_4_i8 (gfc_array_i4 * const restrict retarray,
extern void mminloc0_4_i8 (gfc_array_i4 * const restrict, extern void mminloc0_4_i8 (gfc_array_i4 * const restrict,
gfc_array_i8 * const restrict, gfc_array_l4 * const restrict); gfc_array_i8 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_4_i8); export_proto(mminloc0_4_i8);
void void
mminloc0_4_i8 (gfc_array_i4 * const restrict retarray, mminloc0_4_i8 (gfc_array_i4 * const restrict retarray,
gfc_array_i8 * const restrict array, gfc_array_i8 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_4_i8 (gfc_array_i4 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_4 *dest; GFC_INTEGER_4 *dest;
const GFC_INTEGER_8 *base; const GFC_INTEGER_8 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_4_i8 (gfc_array_i4 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_4_i8 (gfc_array_i4 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_4_r10 (gfc_array_i4 * const restrict retarray,
extern void mminloc0_4_r10 (gfc_array_i4 * const restrict, extern void mminloc0_4_r10 (gfc_array_i4 * const restrict,
gfc_array_r10 * const restrict, gfc_array_l4 * const restrict); gfc_array_r10 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_4_r10); export_proto(mminloc0_4_r10);
void void
mminloc0_4_r10 (gfc_array_i4 * const restrict retarray, mminloc0_4_r10 (gfc_array_i4 * const restrict retarray,
gfc_array_r10 * const restrict array, gfc_array_r10 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_4_r10 (gfc_array_i4 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_4 *dest; GFC_INTEGER_4 *dest;
const GFC_REAL_10 *base; const GFC_REAL_10 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_4_r10 (gfc_array_i4 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_4_r10 (gfc_array_i4 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_4_r16 (gfc_array_i4 * const restrict retarray,
extern void mminloc0_4_r16 (gfc_array_i4 * const restrict, extern void mminloc0_4_r16 (gfc_array_i4 * const restrict,
gfc_array_r16 * const restrict, gfc_array_l4 * const restrict); gfc_array_r16 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_4_r16); export_proto(mminloc0_4_r16);
void void
mminloc0_4_r16 (gfc_array_i4 * const restrict retarray, mminloc0_4_r16 (gfc_array_i4 * const restrict retarray,
gfc_array_r16 * const restrict array, gfc_array_r16 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_4_r16 (gfc_array_i4 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_4 *dest; GFC_INTEGER_4 *dest;
const GFC_REAL_16 *base; const GFC_REAL_16 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_4_r16 (gfc_array_i4 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_4_r16 (gfc_array_i4 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_4_r4 (gfc_array_i4 * const restrict retarray,
extern void mminloc0_4_r4 (gfc_array_i4 * const restrict, extern void mminloc0_4_r4 (gfc_array_i4 * const restrict,
gfc_array_r4 * const restrict, gfc_array_l4 * const restrict); gfc_array_r4 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_4_r4); export_proto(mminloc0_4_r4);
void void
mminloc0_4_r4 (gfc_array_i4 * const restrict retarray, mminloc0_4_r4 (gfc_array_i4 * const restrict retarray,
gfc_array_r4 * const restrict array, gfc_array_r4 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_4_r4 (gfc_array_i4 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_4 *dest; GFC_INTEGER_4 *dest;
const GFC_REAL_4 *base; const GFC_REAL_4 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_4_r4 (gfc_array_i4 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_4_r4 (gfc_array_i4 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_4_r8 (gfc_array_i4 * const restrict retarray,
extern void mminloc0_4_r8 (gfc_array_i4 * const restrict, extern void mminloc0_4_r8 (gfc_array_i4 * const restrict,
gfc_array_r8 * const restrict, gfc_array_l4 * const restrict); gfc_array_r8 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_4_r8); export_proto(mminloc0_4_r8);
void void
mminloc0_4_r8 (gfc_array_i4 * const restrict retarray, mminloc0_4_r8 (gfc_array_i4 * const restrict retarray,
gfc_array_r8 * const restrict array, gfc_array_r8 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_4_r8 (gfc_array_i4 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_4 *dest; GFC_INTEGER_4 *dest;
const GFC_REAL_8 *base; const GFC_REAL_8 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_4_r8 (gfc_array_i4 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_4_r8 (gfc_array_i4 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_8_i1 (gfc_array_i8 * const restrict retarray,
extern void mminloc0_8_i1 (gfc_array_i8 * const restrict, extern void mminloc0_8_i1 (gfc_array_i8 * const restrict,
gfc_array_i1 * const restrict, gfc_array_l4 * const restrict); gfc_array_i1 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_8_i1); export_proto(mminloc0_8_i1);
void void
mminloc0_8_i1 (gfc_array_i8 * const restrict retarray, mminloc0_8_i1 (gfc_array_i8 * const restrict retarray,
gfc_array_i1 * const restrict array, gfc_array_i1 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_8_i1 (gfc_array_i8 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_8 *dest; GFC_INTEGER_8 *dest;
const GFC_INTEGER_1 *base; const GFC_INTEGER_1 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_8_i1 (gfc_array_i8 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_8_i1 (gfc_array_i8 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_8_i16 (gfc_array_i8 * const restrict retarray,
extern void mminloc0_8_i16 (gfc_array_i8 * const restrict, extern void mminloc0_8_i16 (gfc_array_i8 * const restrict,
gfc_array_i16 * const restrict, gfc_array_l4 * const restrict); gfc_array_i16 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_8_i16); export_proto(mminloc0_8_i16);
void void
mminloc0_8_i16 (gfc_array_i8 * const restrict retarray, mminloc0_8_i16 (gfc_array_i8 * const restrict retarray,
gfc_array_i16 * const restrict array, gfc_array_i16 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_8_i16 (gfc_array_i8 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_8 *dest; GFC_INTEGER_8 *dest;
const GFC_INTEGER_16 *base; const GFC_INTEGER_16 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_8_i16 (gfc_array_i8 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_8_i16 (gfc_array_i8 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_8_i2 (gfc_array_i8 * const restrict retarray,
extern void mminloc0_8_i2 (gfc_array_i8 * const restrict, extern void mminloc0_8_i2 (gfc_array_i8 * const restrict,
gfc_array_i2 * const restrict, gfc_array_l4 * const restrict); gfc_array_i2 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_8_i2); export_proto(mminloc0_8_i2);
void void
mminloc0_8_i2 (gfc_array_i8 * const restrict retarray, mminloc0_8_i2 (gfc_array_i8 * const restrict retarray,
gfc_array_i2 * const restrict array, gfc_array_i2 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_8_i2 (gfc_array_i8 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_8 *dest; GFC_INTEGER_8 *dest;
const GFC_INTEGER_2 *base; const GFC_INTEGER_2 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_8_i2 (gfc_array_i8 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_8_i2 (gfc_array_i8 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_8_i4 (gfc_array_i8 * const restrict retarray,
extern void mminloc0_8_i4 (gfc_array_i8 * const restrict, extern void mminloc0_8_i4 (gfc_array_i8 * const restrict,
gfc_array_i4 * const restrict, gfc_array_l4 * const restrict); gfc_array_i4 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_8_i4); export_proto(mminloc0_8_i4);
void void
mminloc0_8_i4 (gfc_array_i8 * const restrict retarray, mminloc0_8_i4 (gfc_array_i8 * const restrict retarray,
gfc_array_i4 * const restrict array, gfc_array_i4 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_8_i4 (gfc_array_i8 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_8 *dest; GFC_INTEGER_8 *dest;
const GFC_INTEGER_4 *base; const GFC_INTEGER_4 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_8_i4 (gfc_array_i8 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_8_i4 (gfc_array_i8 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_8_i8 (gfc_array_i8 * const restrict retarray,
extern void mminloc0_8_i8 (gfc_array_i8 * const restrict, extern void mminloc0_8_i8 (gfc_array_i8 * const restrict,
gfc_array_i8 * const restrict, gfc_array_l4 * const restrict); gfc_array_i8 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_8_i8); export_proto(mminloc0_8_i8);
void void
mminloc0_8_i8 (gfc_array_i8 * const restrict retarray, mminloc0_8_i8 (gfc_array_i8 * const restrict retarray,
gfc_array_i8 * const restrict array, gfc_array_i8 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_8_i8 (gfc_array_i8 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_8 *dest; GFC_INTEGER_8 *dest;
const GFC_INTEGER_8 *base; const GFC_INTEGER_8 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_8_i8 (gfc_array_i8 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_8_i8 (gfc_array_i8 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_8_r10 (gfc_array_i8 * const restrict retarray,
extern void mminloc0_8_r10 (gfc_array_i8 * const restrict, extern void mminloc0_8_r10 (gfc_array_i8 * const restrict,
gfc_array_r10 * const restrict, gfc_array_l4 * const restrict); gfc_array_r10 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_8_r10); export_proto(mminloc0_8_r10);
void void
mminloc0_8_r10 (gfc_array_i8 * const restrict retarray, mminloc0_8_r10 (gfc_array_i8 * const restrict retarray,
gfc_array_r10 * const restrict array, gfc_array_r10 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_8_r10 (gfc_array_i8 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_8 *dest; GFC_INTEGER_8 *dest;
const GFC_REAL_10 *base; const GFC_REAL_10 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_8_r10 (gfc_array_i8 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_8_r10 (gfc_array_i8 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_8_r16 (gfc_array_i8 * const restrict retarray,
extern void mminloc0_8_r16 (gfc_array_i8 * const restrict, extern void mminloc0_8_r16 (gfc_array_i8 * const restrict,
gfc_array_r16 * const restrict, gfc_array_l4 * const restrict); gfc_array_r16 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_8_r16); export_proto(mminloc0_8_r16);
void void
mminloc0_8_r16 (gfc_array_i8 * const restrict retarray, mminloc0_8_r16 (gfc_array_i8 * const restrict retarray,
gfc_array_r16 * const restrict array, gfc_array_r16 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_8_r16 (gfc_array_i8 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_8 *dest; GFC_INTEGER_8 *dest;
const GFC_REAL_16 *base; const GFC_REAL_16 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_8_r16 (gfc_array_i8 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_8_r16 (gfc_array_i8 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_8_r4 (gfc_array_i8 * const restrict retarray,
extern void mminloc0_8_r4 (gfc_array_i8 * const restrict, extern void mminloc0_8_r4 (gfc_array_i8 * const restrict,
gfc_array_r4 * const restrict, gfc_array_l4 * const restrict); gfc_array_r4 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_8_r4); export_proto(mminloc0_8_r4);
void void
mminloc0_8_r4 (gfc_array_i8 * const restrict retarray, mminloc0_8_r4 (gfc_array_i8 * const restrict retarray,
gfc_array_r4 * const restrict array, gfc_array_r4 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_8_r4 (gfc_array_i8 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_8 *dest; GFC_INTEGER_8 *dest;
const GFC_REAL_4 *base; const GFC_REAL_4 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_8_r4 (gfc_array_i8 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_8_r4 (gfc_array_i8 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -148,13 +148,13 @@ minloc0_8_r8 (gfc_array_i8 * const restrict retarray,
extern void mminloc0_8_r8 (gfc_array_i8 * const restrict, extern void mminloc0_8_r8 (gfc_array_i8 * const restrict,
gfc_array_r8 * const restrict, gfc_array_l4 * const restrict); gfc_array_r8 * const restrict, gfc_array_l1 * const restrict);
export_proto(mminloc0_8_r8); export_proto(mminloc0_8_r8);
void void
mminloc0_8_r8 (gfc_array_i8 * const restrict retarray, mminloc0_8_r8 (gfc_array_i8 * const restrict retarray,
gfc_array_r8 * const restrict array, gfc_array_r8 * const restrict array,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -163,9 +163,10 @@ mminloc0_8_r8 (gfc_array_i8 * const restrict retarray,
index_type dstride; index_type dstride;
GFC_INTEGER_8 *dest; GFC_INTEGER_8 *dest;
const GFC_REAL_8 *base; const GFC_REAL_8 *base;
GFC_LOGICAL_4 *mbase; GFC_LOGICAL_1 *mbase;
int rank; int rank;
index_type n; index_type n;
int mask_kind;
rank = GFC_DESCRIPTOR_RANK (array); rank = GFC_DESCRIPTOR_RANK (array);
if (rank <= 0) if (rank <= 0)
@ -189,12 +190,25 @@ mminloc0_8_r8 (gfc_array_i8 * const restrict retarray,
runtime_error ("dimension of return array incorrect"); runtime_error ("dimension of return array incorrect");
} }
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
mbase = mask->data;
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
dstride = retarray->dim[0].stride; dstride = retarray->dim[0].stride;
dest = retarray->data; dest = retarray->data;
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
count[n] = 0; count[n] = 0;
if (extent[n] <= 0) if (extent[n] <= 0)
@ -207,17 +221,6 @@ mminloc0_8_r8 (gfc_array_i8 * const restrict retarray,
} }
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
/* Initialize the return value. */ /* Initialize the return value. */
for (n = 0; n < rank; n++) for (n = 0; n < rank; n++)

View File

@ -191,14 +191,14 @@ minloc1_16_i1 (gfc_array_i16 * const restrict retarray,
extern void mminloc1_16_i1 (gfc_array_i16 * const restrict, extern void mminloc1_16_i1 (gfc_array_i16 * const restrict,
gfc_array_i1 * const restrict, const index_type * const restrict, gfc_array_i1 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mminloc1_16_i1); export_proto(mminloc1_16_i1);
void void
mminloc1_16_i1 (gfc_array_i16 * const restrict retarray, mminloc1_16_i1 (gfc_array_i16 * const restrict retarray,
gfc_array_i1 * const restrict array, gfc_array_i1 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mminloc1_16_i1 (gfc_array_i16 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest; GFC_INTEGER_16 * restrict dest;
const GFC_INTEGER_1 * restrict base; const GFC_INTEGER_1 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mminloc1_16_i1 (gfc_array_i16 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mminloc1_16_i1 (gfc_array_i16 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mminloc1_16_i1 (gfc_array_i16 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_1 * restrict src; const GFC_INTEGER_1 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result; GFC_INTEGER_16 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ minloc1_16_i16 (gfc_array_i16 * const restrict retarray,
extern void mminloc1_16_i16 (gfc_array_i16 * const restrict, extern void mminloc1_16_i16 (gfc_array_i16 * const restrict,
gfc_array_i16 * const restrict, const index_type * const restrict, gfc_array_i16 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mminloc1_16_i16); export_proto(mminloc1_16_i16);
void void
mminloc1_16_i16 (gfc_array_i16 * const restrict retarray, mminloc1_16_i16 (gfc_array_i16 * const restrict retarray,
gfc_array_i16 * const restrict array, gfc_array_i16 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mminloc1_16_i16 (gfc_array_i16 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest; GFC_INTEGER_16 * restrict dest;
const GFC_INTEGER_16 * restrict base; const GFC_INTEGER_16 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mminloc1_16_i16 (gfc_array_i16 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mminloc1_16_i16 (gfc_array_i16 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mminloc1_16_i16 (gfc_array_i16 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_16 * restrict src; const GFC_INTEGER_16 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result; GFC_INTEGER_16 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ minloc1_16_i2 (gfc_array_i16 * const restrict retarray,
extern void mminloc1_16_i2 (gfc_array_i16 * const restrict, extern void mminloc1_16_i2 (gfc_array_i16 * const restrict,
gfc_array_i2 * const restrict, const index_type * const restrict, gfc_array_i2 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mminloc1_16_i2); export_proto(mminloc1_16_i2);
void void
mminloc1_16_i2 (gfc_array_i16 * const restrict retarray, mminloc1_16_i2 (gfc_array_i16 * const restrict retarray,
gfc_array_i2 * const restrict array, gfc_array_i2 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mminloc1_16_i2 (gfc_array_i16 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest; GFC_INTEGER_16 * restrict dest;
const GFC_INTEGER_2 * restrict base; const GFC_INTEGER_2 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mminloc1_16_i2 (gfc_array_i16 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mminloc1_16_i2 (gfc_array_i16 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mminloc1_16_i2 (gfc_array_i16 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_2 * restrict src; const GFC_INTEGER_2 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result; GFC_INTEGER_16 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

View File

@ -191,14 +191,14 @@ minloc1_16_i4 (gfc_array_i16 * const restrict retarray,
extern void mminloc1_16_i4 (gfc_array_i16 * const restrict, extern void mminloc1_16_i4 (gfc_array_i16 * const restrict,
gfc_array_i4 * const restrict, const index_type * const restrict, gfc_array_i4 * const restrict, const index_type * const restrict,
gfc_array_l4 * const restrict); gfc_array_l1 * const restrict);
export_proto(mminloc1_16_i4); export_proto(mminloc1_16_i4);
void void
mminloc1_16_i4 (gfc_array_i16 * const restrict retarray, mminloc1_16_i4 (gfc_array_i16 * const restrict retarray,
gfc_array_i4 * const restrict array, gfc_array_i4 * const restrict array,
const index_type * const restrict pdim, const index_type * const restrict pdim,
gfc_array_l4 * const restrict mask) gfc_array_l1 * const restrict mask)
{ {
index_type count[GFC_MAX_DIMENSIONS]; index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS];
@ -207,13 +207,14 @@ mminloc1_16_i4 (gfc_array_i16 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS]; index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest; GFC_INTEGER_16 * restrict dest;
const GFC_INTEGER_4 * restrict base; const GFC_INTEGER_4 * restrict base;
const GFC_LOGICAL_4 * restrict mbase; const GFC_LOGICAL_1 * restrict mbase;
int rank; int rank;
int dim; int dim;
index_type n; index_type n;
index_type len; index_type len;
index_type delta; index_type delta;
index_type mdelta; index_type mdelta;
int mask_kind;
dim = (*pdim) - 1; dim = (*pdim) - 1;
rank = GFC_DESCRIPTOR_RANK (array) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1;
@ -221,13 +222,27 @@ mminloc1_16_i4 (gfc_array_i16 * const restrict retarray,
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
if (len <= 0) if (len <= 0)
return; return;
mbase = mask->data;
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
|| mask_kind == 16
#endif
)
mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
else
runtime_error ("Funny sized logical array");
delta = array->dim[dim].stride; delta = array->dim[dim].stride;
mdelta = mask->dim[dim].stride; mdelta = mask->dim[dim].stride * mask_kind;
for (n = 0; n < dim; n++) for (n = 0; n < dim; n++)
{ {
sstride[n] = array->dim[n].stride; sstride[n] = array->dim[n].stride;
mstride[n] = mask->dim[n].stride; mstride[n] = mask->dim[n].stride * mask_kind;
extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
if (extent[n] < 0) if (extent[n] < 0)
@ -237,7 +252,7 @@ mminloc1_16_i4 (gfc_array_i16 * const restrict retarray,
for (n = dim; n < rank; n++) for (n = dim; n < rank; n++)
{ {
sstride[n] = array->dim[n + 1].stride; sstride[n] = array->dim[n + 1].stride;
mstride[n] = mask->dim[n + 1].stride; mstride[n] = mask->dim[n + 1].stride * mask_kind;
extent[n] = extent[n] =
array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
@ -292,22 +307,11 @@ mminloc1_16_i4 (gfc_array_i16 * const restrict retarray,
dest = retarray->data; dest = retarray->data;
base = array->data; base = array->data;
mbase = mask->data;
if (GFC_DESCRIPTOR_SIZE (mask) != 4)
{
/* This allows the same loop to be used for all logical types. */
assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
for (n = 0; n < rank; n++)
mstride[n] <<= 1;
mdelta <<= 1;
mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
}
while (base) while (base)
{ {
const GFC_INTEGER_4 * restrict src; const GFC_INTEGER_4 * restrict src;
const GFC_LOGICAL_4 * restrict msrc; const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result; GFC_INTEGER_16 result;
src = base; src = base;
msrc = mbase; msrc = mbase;

Some files were not shown because too many files have changed in this diff Show More