+2005-10-03 Francois-Xavier Coudert <coudert@clipper.ens.fr>
+
+ PR fortran/20120
+ * f95-lang.c (DO_DEFINE_MATH_BUILTIN): Add support for long
+ double builtin function.
+ (gfc_init_builtin_functions): Add mfunc_longdouble,
+ mfunc_clongdouble and func_clongdouble_longdouble trees. Build
+ them for round, trunc, cabs, copysign and pow functions.
+ * iresolve.c (gfc_resolve_reshape, gfc_resolve_transpose): Add
+ case for kind 10 and 16.
+ * trans-decl.c: Add trees for cpowl10, cpowl16, ishftc16,
+ exponent10 and exponent16.
+ (gfc_build_intrinsic_function_decls): Build nodes for int16,
+ real10, real16, complex10 and complex16 types. Build all possible
+ combinations for function _gfortran_pow_?n_?n. Build function
+ calls cpowl10, cpowl16, ishftc16, exponent10 and exponent16.
+ * trans-expr.c (gfc_conv_power_op): Add case for integer(16),
+ real(10) and real(16).
+ * trans-intrinsic.c: Add suppport for long double builtin
+ functions in BUILT_IN_FUNCTION, LIBM_FUNCTION and LIBF_FUNCTION
+ macros.
+ (gfc_conv_intrinsic_aint): Add case for integer(16), real(10) and
+ real(16) kinds.
+ (gfc_build_intrinsic_lib_fndecls): Add support for real10_decl
+ and real16_decl in library functions.
+ (gfc_get_intrinsic_lib_fndecl): Add cases for real and complex
+ kinds 10 and 16.
+ (gfc_conv_intrinsic_exponent): Add cases for real(10) and real(16)
+ kinds.
+ (gfc_conv_intrinsic_sign): Likewise.
+ (gfc_conv_intrinsic_ishftc): Add case for integer(16) kind.
+ * trans-types.c (gfc_get_int_type, gfc_get_real_type,
+ gfc_get_complex_type, gfc_get_logical_type): Doesn't error out in
+ the case of kinds not available.
+ * trans.h: Declare trees for cpowl10, cpowl16, ishftc16,
+ exponent10 and exponent16.
+
2005-10-01 Paul Thomas <pault@gcc.gnu.org>
PR fortran/16404
#define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \
+ gfc_define_builtin ("__builtin_" name "l", tbase##longdouble[argtype], \
+ BUILT_IN_ ## code ## L, name "l", true); \
gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \
BUILT_IN_ ## code, name, true); \
gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \
#define DEFINE_MATH_BUILTIN(code, name, argtype) \
DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
-/* The middle-end is missing builtins for some complex math functions, so
- we don't use them yet. */
#define DEFINE_MATH_BUILTIN_C(code, name, argtype) \
- DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
-/* DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)*/
+ DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) \
+ DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)
/* Create function types for builtin functions. */
{
tree mfunc_float[3];
tree mfunc_double[3];
+ tree mfunc_longdouble[3];
tree mfunc_cfloat[3];
tree mfunc_cdouble[3];
+ tree mfunc_clongdouble[3];
tree func_cfloat_float;
tree func_cdouble_double;
+ tree func_clongdouble_longdouble;
tree ftype;
tree tmp;
build_builtin_fntypes (mfunc_float, float_type_node);
build_builtin_fntypes (mfunc_double, double_type_node);
+ build_builtin_fntypes (mfunc_longdouble, long_double_type_node);
build_builtin_fntypes (mfunc_cfloat, complex_float_type_node);
build_builtin_fntypes (mfunc_cdouble, complex_double_type_node);
+ build_builtin_fntypes (mfunc_clongdouble, complex_long_double_type_node);
tmp = tree_cons (NULL_TREE, complex_float_type_node, void_list_node);
func_cfloat_float = build_function_type (float_type_node, tmp);
tmp = tree_cons (NULL_TREE, complex_double_type_node, void_list_node);
func_cdouble_double = build_function_type (double_type_node, tmp);
+ tmp = tree_cons (NULL_TREE, complex_long_double_type_node, void_list_node);
+ func_clongdouble_longdouble =
+ build_function_type (long_double_type_node, tmp);
+
#include "mathbuiltins.def"
/* We define these separately as the fortran versions have different
semantics (they return an integer type) */
+ gfc_define_builtin ("__builtin_roundl", mfunc_longdouble[0],
+ BUILT_IN_ROUNDL, "roundl", true);
gfc_define_builtin ("__builtin_round", mfunc_double[0],
BUILT_IN_ROUND, "round", true);
gfc_define_builtin ("__builtin_roundf", mfunc_float[0],
BUILT_IN_ROUNDF, "roundf", true);
+
+ gfc_define_builtin ("__builtin_truncl", mfunc_longdouble[0],
+ BUILT_IN_TRUNCL, "truncl", true);
gfc_define_builtin ("__builtin_trunc", mfunc_double[0],
BUILT_IN_TRUNC, "trunc", true);
gfc_define_builtin ("__builtin_truncf", mfunc_float[0],
BUILT_IN_TRUNCF, "truncf", true);
+ gfc_define_builtin ("__builtin_cabsl", func_clongdouble_longdouble,
+ BUILT_IN_CABSL, "cabsl", true);
gfc_define_builtin ("__builtin_cabs", func_cdouble_double,
BUILT_IN_CABS, "cabs", true);
gfc_define_builtin ("__builtin_cabsf", func_cfloat_float,
BUILT_IN_CABSF, "cabsf", true);
+ gfc_define_builtin ("__builtin_copysignl", mfunc_longdouble[1],
+ BUILT_IN_COPYSIGNL, "copysignl", true);
gfc_define_builtin ("__builtin_copysign", mfunc_double[1],
BUILT_IN_COPYSIGN, "copysign", true);
gfc_define_builtin ("__builtin_copysignf", mfunc_float[1],
BUILT_IN_COPYSIGNF, "copysignf", true);
/* These are used to implement the ** operator. */
+ gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1],
+ BUILT_IN_POWL, "powl", true);
gfc_define_builtin ("__builtin_pow", mfunc_double[1],
BUILT_IN_POW, "pow", true);
gfc_define_builtin ("__builtin_powf", mfunc_float[1],
{
case 4:
case 8:
- /* case 16: */
+ case 10:
+ case 16:
if (source->ts.type == BT_COMPLEX)
f->value.function.name =
gfc_get_string (PREFIX("reshape_%c%d"),
{
case 4:
case 8:
+ case 10:
+ case 16:
switch (matrix->ts.type)
{
case BT_COMPLEX:
/* Math functions. Many other math functions are handled in
trans-intrinsic.c. */
-gfc_powdecl_list gfor_fndecl_math_powi[3][2];
+gfc_powdecl_list gfor_fndecl_math_powi[4][3];
tree gfor_fndecl_math_cpowf;
tree gfor_fndecl_math_cpow;
+tree gfor_fndecl_math_cpowl10;
+tree gfor_fndecl_math_cpowl16;
tree gfor_fndecl_math_ishftc4;
tree gfor_fndecl_math_ishftc8;
+tree gfor_fndecl_math_ishftc16;
tree gfor_fndecl_math_exponent4;
tree gfor_fndecl_math_exponent8;
+tree gfor_fndecl_math_exponent10;
+tree gfor_fndecl_math_exponent16;
/* String functions. */
{
tree gfc_int4_type_node = gfc_get_int_type (4);
tree gfc_int8_type_node = gfc_get_int_type (8);
+ tree gfc_int16_type_node = gfc_get_int_type (16);
tree gfc_logical4_type_node = gfc_get_logical_type (4);
tree gfc_real4_type_node = gfc_get_real_type (4);
tree gfc_real8_type_node = gfc_get_real_type (8);
+ tree gfc_real10_type_node = gfc_get_real_type (10);
+ tree gfc_real16_type_node = gfc_get_real_type (16);
tree gfc_complex4_type_node = gfc_get_complex_type (4);
tree gfc_complex8_type_node = gfc_get_complex_type (8);
+ tree gfc_complex10_type_node = gfc_get_complex_type (10);
+ tree gfc_complex16_type_node = gfc_get_complex_type (16);
/* String functions. */
gfor_fndecl_copy_string =
/* Power functions. */
{
- tree type;
- tree itype;
- int kind;
- int ikind;
- static int kinds[2] = {4, 8};
- char name[PREFIX_LEN + 10]; /* _gfortran_pow_?n_?n */
-
- for (ikind=0; ikind < 2; ikind++)
+ tree ctype, rtype, itype, jtype;
+ int rkind, ikind, jkind;
+#define NIKINDS 3
+#define NRKINDS 4
+ static int ikinds[NIKINDS] = {4, 8, 16};
+ static int rkinds[NRKINDS] = {4, 8, 10, 16};
+ char name[PREFIX_LEN + 12]; /* _gfortran_pow_?n_?n */
+
+ for (ikind=0; ikind < NIKINDS; ikind++)
{
- itype = gfc_get_int_type (kinds[ikind]);
- for (kind = 0; kind < 2; kind ++)
+ itype = gfc_get_int_type (ikinds[ikind]);
+
+ for (jkind=0; jkind < NIKINDS; jkind++)
+ {
+ jtype = gfc_get_int_type (ikinds[jkind]);
+ if (itype && jtype)
+ {
+ sprintf(name, PREFIX("pow_i%d_i%d"), ikinds[ikind],
+ ikinds[jkind]);
+ gfor_fndecl_math_powi[jkind][ikind].integer =
+ gfc_build_library_function_decl (get_identifier (name),
+ jtype, 2, jtype, itype);
+ }
+ }
+
+ for (rkind = 0; rkind < NRKINDS; rkind ++)
{
- type = gfc_get_int_type (kinds[kind]);
- sprintf(name, PREFIX("pow_i%d_i%d"), kinds[kind], kinds[ikind]);
- gfor_fndecl_math_powi[kind][ikind].integer =
- gfc_build_library_function_decl (get_identifier (name),
- type, 2, type, itype);
-
- type = gfc_get_real_type (kinds[kind]);
- sprintf(name, PREFIX("pow_r%d_i%d"), kinds[kind], kinds[ikind]);
- gfor_fndecl_math_powi[kind][ikind].real =
- gfc_build_library_function_decl (get_identifier (name),
- type, 2, type, itype);
-
- type = gfc_get_complex_type (kinds[kind]);
- sprintf(name, PREFIX("pow_c%d_i%d"), kinds[kind], kinds[ikind]);
- gfor_fndecl_math_powi[kind][ikind].cmplx =
- gfc_build_library_function_decl (get_identifier (name),
- type, 2, type, itype);
+ rtype = gfc_get_real_type (rkinds[rkind]);
+ if (rtype && itype)
+ {
+ sprintf(name, PREFIX("pow_r%d_i%d"), rkinds[rkind],
+ ikinds[ikind]);
+ gfor_fndecl_math_powi[rkind][ikind].real =
+ gfc_build_library_function_decl (get_identifier (name),
+ rtype, 2, rtype, itype);
+ }
+
+ ctype = gfc_get_complex_type (rkinds[rkind]);
+ if (ctype && itype)
+ {
+ sprintf(name, PREFIX("pow_c%d_i%d"), rkinds[rkind],
+ ikinds[ikind]);
+ gfor_fndecl_math_powi[rkind][ikind].cmplx =
+ gfc_build_library_function_decl (get_identifier (name),
+ ctype, 2,ctype, itype);
+ }
}
}
+#undef NIKINDS
+#undef NRKINDS
}
gfor_fndecl_math_cpowf =
gfc_build_library_function_decl (get_identifier ("cpow"),
gfc_complex8_type_node,
1, gfc_complex8_type_node);
+ if (gfc_complex10_type_node)
+ gfor_fndecl_math_cpowl10 =
+ gfc_build_library_function_decl (get_identifier ("cpowl"),
+ gfc_complex10_type_node, 1,
+ gfc_complex10_type_node);
+ if (gfc_complex16_type_node)
+ gfor_fndecl_math_cpowl16 =
+ gfc_build_library_function_decl (get_identifier ("cpowl"),
+ gfc_complex16_type_node, 1,
+ gfc_complex16_type_node);
+
gfor_fndecl_math_ishftc4 =
gfc_build_library_function_decl (get_identifier (PREFIX("ishftc4")),
gfc_int4_type_node,
gfc_build_library_function_decl (get_identifier (PREFIX("ishftc8")),
gfc_int8_type_node,
3, gfc_int8_type_node,
- gfc_int8_type_node, gfc_int8_type_node);
+ gfc_int4_type_node, gfc_int4_type_node);
+ if (gfc_int16_type_node)
+ gfor_fndecl_math_ishftc16 =
+ gfc_build_library_function_decl (get_identifier (PREFIX("ishftc16")),
+ gfc_int16_type_node, 3,
+ gfc_int16_type_node,
+ gfc_int4_type_node,
+ gfc_int4_type_node);
+
gfor_fndecl_math_exponent4 =
gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r4")),
gfc_int4_type_node,
gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r8")),
gfc_int4_type_node,
1, gfc_real8_type_node);
+ if (gfc_real10_type_node)
+ gfor_fndecl_math_exponent10 =
+ gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r10")),
+ gfc_int4_type_node, 1,
+ gfc_real10_type_node);
+ if (gfc_real16_type_node)
+ gfor_fndecl_math_exponent16 =
+ gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r16")),
+ gfc_int4_type_node, 1,
+ gfc_real16_type_node);
/* Other functions. */
gfor_fndecl_size0 =
ikind = 1;
break;
+ case 16:
+ ikind = 2;
+ break;
+
default:
gcc_unreachable ();
}
kind = 1;
break;
+ case 10:
+ kind = 2;
+ break;
+
+ case 16:
+ kind = 3;
+ break;
+
default:
gcc_unreachable ();
}
switch (expr->value.op.op1->ts.type)
{
case BT_INTEGER:
+ if (kind == 3) /* Case 16 was not handled properly above. */
+ kind = 2;
fndecl = gfor_fndecl_math_powi[kind][ikind].integer;
break;
case 8:
fndecl = built_in_decls[BUILT_IN_POW];
break;
+ case 10:
+ case 16:
+ fndecl = built_in_decls[BUILT_IN_POWL];
+ break;
default:
gcc_unreachable ();
}
case 8:
fndecl = gfor_fndecl_math_cpow;
break;
+ case 10:
+ fndecl = gfor_fndecl_math_cpowl10;
+ break;
+ case 16:
+ fndecl = gfor_fndecl_math_cpowl16;
+ break;
default:
gcc_unreachable ();
}
/* Enum value from the "language-independent", aka C-centric, part
of gcc, or END_BUILTINS of no such value set. */
- /* ??? There are now complex variants in builtins.def, though we
- don't currently do anything with them. */
- enum built_in_function code4;
- enum built_in_function code8;
+ enum built_in_function code_r4;
+ enum built_in_function code_r8;
+ enum built_in_function code_r10;
+ enum built_in_function code_r16;
+ enum built_in_function code_c4;
+ enum built_in_function code_c8;
+ enum built_in_function code_c10;
+ enum built_in_function code_c16;
/* True if the naming pattern is to prepend "c" for complex and
append "f" for kind=4. False if the naming pattern is to
- prepend "_gfortran_" and append "[rc][48]". */
+ prepend "_gfortran_" and append "[rc](4|8|10|16)". */
bool libm_name;
/* True if a complex version of the function exists. */
/* Cache decls created for the various operand types. */
tree real4_decl;
tree real8_decl;
+ tree real10_decl;
+ tree real16_decl;
tree complex4_decl;
tree complex8_decl;
+ tree complex10_decl;
+ tree complex16_decl;
}
gfc_intrinsic_map_t;
/* ??? The NARGS==1 hack here is based on the fact that (c99 at least)
defines complex variants of all of the entries in mathbuiltins.def
except for atan2. */
-#define BUILT_IN_FUNCTION(ID, NAME, HAVE_COMPLEX) \
- { GFC_ISYM_ ## ID, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, true, \
- HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
-
-#define DEFINE_MATH_BUILTIN(id, name, argtype) \
- BUILT_IN_FUNCTION (id, name, false)
-
-/* TODO: Use builtin function for complex intrinsics. */
-#define DEFINE_MATH_BUILTIN_C(id, name, argtype) \
- BUILT_IN_FUNCTION (id, name, true)
+#define DEFINE_MATH_BUILTIN(ID, NAME, ARGTYPE) \
+ { GFC_ISYM_ ## ID, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, \
+ BUILT_IN_ ## ID ## L, BUILT_IN_ ## ID ## L, 0, 0, 0, 0, true, \
+ false, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, \
+ NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
+
+#define DEFINE_MATH_BUILTIN_C(ID, NAME, ARGTYPE) \
+ { GFC_ISYM_ ## ID, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, \
+ BUILT_IN_ ## ID ## L, BUILT_IN_ ## ID ## L, BUILT_IN_C ## ID ## F, \
+ BUILT_IN_C ## ID, BUILT_IN_C ## ID ## L, BUILT_IN_C ## ID ## L, true, \
+ true, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, \
+ NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
#define LIBM_FUNCTION(ID, NAME, HAVE_COMPLEX) \
- { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, true, HAVE_COMPLEX, true, \
- NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE }
+ { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
+ END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
+ true, HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, \
+ NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE }
#define LIBF_FUNCTION(ID, NAME, HAVE_COMPLEX) \
- { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, false, HAVE_COMPLEX, true, \
- NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE }
+ { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
+ END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
+ false, HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, \
+ NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE }
static GTY(()) gfc_intrinsic_map_t gfc_intrinsic_map[] =
{
};
#undef DEFINE_MATH_BUILTIN
#undef DEFINE_MATH_BUILTIN_C
-#undef BUILT_IN_FUNCTION
#undef LIBM_FUNCTION
#undef LIBF_FUNCTION
case 8:
n = BUILT_IN_ROUND;
break;
+
+ case 10:
+ case 16:
+ n = BUILT_IN_ROUNDL;
+ break;
}
break;
case 8:
n = BUILT_IN_TRUNC;
break;
+
+ case 10:
+ case 16:
+ n = BUILT_IN_TRUNCL;
+ break;
}
break;
/* Add GCC builtin functions. */
for (m = gfc_intrinsic_map; m->id != GFC_ISYM_NONE; m++)
{
- if (m->code4 != END_BUILTINS)
- m->real4_decl = built_in_decls[m->code4];
- if (m->code8 != END_BUILTINS)
- m->real8_decl = built_in_decls[m->code8];
+ if (m->code_r4 != END_BUILTINS)
+ m->real4_decl = built_in_decls[m->code_r4];
+ if (m->code_r8 != END_BUILTINS)
+ m->real8_decl = built_in_decls[m->code_r8];
+ if (m->code_r10 != END_BUILTINS)
+ m->real10_decl = built_in_decls[m->code_r10];
+ if (m->code_r16 != END_BUILTINS)
+ m->real16_decl = built_in_decls[m->code_r16];
+ if (m->code_c4 != END_BUILTINS)
+ m->complex4_decl = built_in_decls[m->code_c4];
+ if (m->code_c8 != END_BUILTINS)
+ m->complex8_decl = built_in_decls[m->code_c8];
+ if (m->code_c10 != END_BUILTINS)
+ m->complex10_decl = built_in_decls[m->code_c10];
+ if (m->code_c16 != END_BUILTINS)
+ m->complex16_decl = built_in_decls[m->code_c16];
}
}
case 8:
pdecl = &m->real8_decl;
break;
+ case 10:
+ pdecl = &m->real10_decl;
+ break;
+ case 16:
+ pdecl = &m->real16_decl;
+ break;
default:
gcc_unreachable ();
}
case 8:
pdecl = &m->complex8_decl;
break;
+ case 10:
+ pdecl = &m->complex10_decl;
+ break;
+ case 16:
+ pdecl = &m->complex16_decl;
+ break;
default:
gcc_unreachable ();
}
if (m->libm_name)
{
- gcc_assert (ts->kind == 4 || ts->kind == 8);
+ gcc_assert (ts->kind == 4 || ts->kind == 8 || ts->kind == 10
+ || ts->kind == 16);
snprintf (name, sizeof (name), "%s%s%s",
ts->type == BT_COMPLEX ? "c" : "",
m->name,
case 8:
fndecl = gfor_fndecl_math_exponent8;
break;
+ case 10:
+ fndecl = gfor_fndecl_math_exponent10;
+ break;
+ case 16:
+ fndecl = gfor_fndecl_math_exponent16;
+ break;
default:
gcc_unreachable ();
}
case 8:
n = BUILT_IN_CABS;
break;
+ case 10:
+ case 16:
+ n = BUILT_IN_CABSL;
+ break;
default:
gcc_unreachable ();
}
case 8:
tmp = built_in_decls[BUILT_IN_COPYSIGN];
break;
+ case 10:
+ case 16:
+ tmp = built_in_decls[BUILT_IN_COPYSIGNL];
+ break;
default:
gcc_unreachable ();
}
case 8:
tmp = gfor_fndecl_math_ishftc8;
break;
+ case 16:
+ tmp = gfor_fndecl_math_ishftc16;
+ break;
default:
gcc_unreachable ();
}
tree
gfc_get_int_type (int kind)
{
- int index = gfc_validate_kind (BT_INTEGER, kind, false);
- return gfc_integer_types[index];
+ int index = gfc_validate_kind (BT_INTEGER, kind, true);
+ return index < 0 ? 0 : gfc_integer_types[index];
}
tree
gfc_get_real_type (int kind)
{
- int index = gfc_validate_kind (BT_REAL, kind, false);
- return gfc_real_types[index];
+ int index = gfc_validate_kind (BT_REAL, kind, true);
+ return index < 0 ? 0 : gfc_real_types[index];
}
tree
gfc_get_complex_type (int kind)
{
- int index = gfc_validate_kind (BT_COMPLEX, kind, false);
- return gfc_complex_types[index];
+ int index = gfc_validate_kind (BT_COMPLEX, kind, true);
+ return index < 0 ? 0 : gfc_complex_types[index];
}
tree
gfc_get_logical_type (int kind)
{
- int index = gfc_validate_kind (BT_LOGICAL, kind, false);
- return gfc_logical_types[index];
+ int index = gfc_validate_kind (BT_LOGICAL, kind, true);
+ return index < 0 ? 0 : gfc_logical_types[index];
}
\f
/* Create a character type with the given kind and length. */
}
gfc_powdecl_list;
-extern GTY(()) gfc_powdecl_list gfor_fndecl_math_powi[3][2];
+extern GTY(()) gfc_powdecl_list gfor_fndecl_math_powi[4][3];
extern GTY(()) tree gfor_fndecl_math_cpowf;
extern GTY(()) tree gfor_fndecl_math_cpow;
+extern GTY(()) tree gfor_fndecl_math_cpowl10;
+extern GTY(()) tree gfor_fndecl_math_cpowl16;
extern GTY(()) tree gfor_fndecl_math_ishftc4;
extern GTY(()) tree gfor_fndecl_math_ishftc8;
+extern GTY(()) tree gfor_fndecl_math_ishftc16;
extern GTY(()) tree gfor_fndecl_math_exponent4;
extern GTY(()) tree gfor_fndecl_math_exponent8;
+extern GTY(()) tree gfor_fndecl_math_exponent10;
+extern GTY(()) tree gfor_fndecl_math_exponent16;
/* String functions. */
extern GTY(()) tree gfor_fndecl_copy_string;
+2005-10-03 Francois-Xavier Coudert <coudert@clipper.ens.fr>
+
+ PR libfortran/19308
+ * gfortran.dg/large_real_kind_2.F90: New test.
+ * gfortran.dg/large_integer_kind_2.f90: New test.
+
2005-10-03 Uros Bizjak <uros@kss-loka.si>
* lib/target-supports.exp (check_effective_target_vect_shift):
--- /dev/null
+! { dg-do run }
+! { dg-require-effective-target fortran_large_int }
+
+! Testing library calls on large integer kinds (larger than kind=8)
+ implicit none
+
+ integer,parameter :: k = selected_int_kind (range (0_8) + 1)
+
+ integer(kind=k) :: i, j
+ integer(8) :: a, b
+
+ i = 0; j = 1; a = i; b = j
+ if (i ** j /= a ** b) call abort
+
+end
--- /dev/null
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+
+! Testing library calls on large real kinds (larger than kind=8)
+ implicit none
+
+ integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+ real(8),parameter :: eps = 1e-8
+
+ real(kind=k) :: x, x1
+ real(8) :: y, y1
+ complex(kind=k) :: z, z1
+ complex(8) :: w, w1
+
+#define TEST_FUNCTION(func,val) \
+ x = val ;\
+ y = x ;\
+ x = func (x) ;\
+ y = func (y) ;\
+ if (abs((y - x) / y) > eps) call abort
+
+#define CTEST_FUNCTION(func,valc) \
+ z = valc ;\
+ w = z ;\
+ z = func (z) ;\
+ w = func (w) ;\
+ if (abs((z - w) / w) > eps) call abort
+
+ TEST_FUNCTION(cos,17.456)
+ TEST_FUNCTION(sin,17.456)
+ TEST_FUNCTION(tan,1.456)
+ TEST_FUNCTION(cosh,-2.45)
+ TEST_FUNCTION(sinh,7.1)
+ TEST_FUNCTION(tanh,12.7)
+ TEST_FUNCTION(acos,0.78)
+ TEST_FUNCTION(asin,-0.24)
+ TEST_FUNCTION(atan,-17.123)
+ TEST_FUNCTION(acosh,0.2)
+ TEST_FUNCTION(asinh,0.3)
+ TEST_FUNCTION(atanh,0.4)
+ TEST_FUNCTION(exp,1.74)
+ TEST_FUNCTION(log,0.00178914)
+ TEST_FUNCTION(log10,123789.123)
+ TEST_FUNCTION(sqrt,789.1356)
+ TEST_FUNCTION(erf,1.45123231)
+ TEST_FUNCTION(erfc,-0.123789)
+
+ CTEST_FUNCTION(cos,(17.456,-1.123))
+ CTEST_FUNCTION(sin,(17.456,-7.6))
+ CTEST_FUNCTION(exp,(1.74,-1.01))
+ CTEST_FUNCTION(log,(0.00178914,-1.207))
+ CTEST_FUNCTION(sqrt,(789.1356,2.4))
+
+#define TEST_POWER(val1,val2) \
+ x = val1 ; \
+ y = x ; \
+ x1 = val2 ; \
+ y1 = x1; \
+ if (abs((x**x1 - y**y1)/(y**y1)) > eps) call abort
+
+#define CTEST_POWER(val1,val2) \
+ z = val1 ; \
+ w = z ; \
+ z1 = val2 ; \
+ w1 = z1; \
+ if (abs((z**z1 - w**w1)/(w**w1)) > eps) call abort
+
+ CTEST_POWER (1.0,1.0)
+ CTEST_POWER (1.0,5.4)
+ CTEST_POWER (1.0,-5.4)
+ CTEST_POWER (1.0,0.0)
+ CTEST_POWER (-1.0,1.0)
+ CTEST_POWER (-1.0,5.4)
+ CTEST_POWER (-1.0,-5.4)
+ CTEST_POWER (-1.0,0.0)
+ CTEST_POWER (0.0,1.0)
+ CTEST_POWER (0.0,5.4)
+ CTEST_POWER (0.0,-5.4)
+ CTEST_POWER (0.0,0.0)
+ CTEST_POWER (7.6,1.0)
+ CTEST_POWER (7.6,5.4)
+ CTEST_POWER (7.6,-5.4)
+ CTEST_POWER (7.6,0.0)
+ CTEST_POWER (-7.6,1.0)
+ CTEST_POWER (-7.6,5.4)
+ CTEST_POWER (-7.6,-5.4)
+ CTEST_POWER (-7.6,0.0)
+
+ CTEST_POWER ((10.78,123.213),(14.123,13279.5))
+ CTEST_POWER ((-10.78,123.213),(14.123,13279.5))
+ CTEST_POWER ((10.78,-123.213),(14.123,13279.5))
+ CTEST_POWER ((10.78,123.213),(-14.123,13279.5))
+ CTEST_POWER ((10.78,123.213),(14.123,-13279.5))
+ CTEST_POWER ((-10.78,-123.213),(14.123,13279.5))
+ CTEST_POWER ((-10.78,123.213),(-14.123,13279.5))
+ CTEST_POWER ((-10.78,123.213),(14.123,-13279.5))
+ CTEST_POWER ((10.78,-123.213),(-14.123,13279.5))
+ CTEST_POWER ((10.78,-123.213),(14.123,-13279.5))
+ CTEST_POWER ((10.78,123.213),(-14.123,-13279.5))
+ CTEST_POWER ((-10.78,-123.213),(-14.123,13279.5))
+ CTEST_POWER ((-10.78,-123.213),(14.123,-13279.5))
+ CTEST_POWER ((-10.78,123.213),(-14.123,-13279.5))
+ CTEST_POWER ((10.78,-123.213),(-14.123,-13279.5))
+ CTEST_POWER ((-10.78,-123.213),(-14.123,-13279.5))
+
+end
+2005-10-03 Francois-Xavier Coudert <coudert@clipper.ens.fr>
+
+ PR libfortran/19308
+ PR libfortran/22437
+ * Makefile.am: Add generated files for large real and integers
+ kinds. Add a rule to create the kinds.inc c99_protos.inc files.
+ Use kinds.inc to preprocess Fortran generated files.
+ * libgfortran.h: Add macro definitions for GFC_INTEGER_16_HUGE,
+ GFC_REAL_10_HUGE and GFC_REAL_16_HUGE. Add types gfc_array_i16,
+ gfc_array_r10, gfc_array_r16, gfc_array_c10, gfc_array_c16,
+ gfc_array_l16.
+ * mk-kinds-h.sh: Define macros HAVE_GFC_LOGICAL_* and
+ HAVE_GFC_COMPLEX_* when these types are available.
+ * intrinsics/ishftc.c (ishftc16): New function for GFC_INTEGER_16.
+ * m4/all.m4, m4/any.m4, m4/count.m4, m4/cshift1.m4, m4/dotprod.m4,
+ m4/dotprodc.m4, m4/dotprodl.m4, m4/eoshift1.m4, m4/eoshift3.m4,
+ m4/exponent.m4, m4/fraction.m4, m4/in_pack.m4, m4/in_unpack.m4,
+ m4/matmul.m4, m4/matmull.m4, m4/maxloc0.m4, m4/maxloc1.m4,
+ m4/maxval.m4, m4/minloc0.m4, m4/minloc1.m4, m4/minval.m4, m4/mtype.m4,
+ m4/nearest.m4, m4/pow.m4, m4/product.m4, m4/reshape.m4,
+ m4/set_exponent.m4, m4/shape.m4, m4/specific.m4, m4/specific2.m4,
+ m4/sum.m4, m4/transpose.m4: Protect generated functions with
+ appropriate "#if defined (HAVE_GFC_type_kind)" preprocessor directives.
+ * Makefile.in: Regenerate.
+ * all files in generated/: Regenerate.
+
2005-10-01 Jakub Jelinek <jakub@redhat.com>
* runtime/memory.c (malloc_t): Remove.
* config.h.in: Regenerate.
* libgfortan.h (isfinite): undef if broken, set if needed.
(isnan): undef if broken, set if needed.
- (fpclassify): undef if broken, set if needed.
+ (fpclassify): undef if broken, set if needed.
* io/write.c: Remove TODO comment about working isfinite.
* intrinsics/c99_functions.c (round): Use isfinite instead
of fpclassify.
i_all_c= \
generated/all_l4.c \
-generated/all_l8.c
+generated/all_l8.c \
+generated/all_l16.c
i_any_c= \
generated/any_l4.c \
-generated/any_l8.c
+generated/any_l8.c \
+generated/any_l16.c
i_count_c= \
generated/count_4_l4.c \
generated/count_8_l4.c \
+generated/count_16_l4.c \
generated/count_4_l8.c \
-generated/count_8_l8.c
+generated/count_8_l8.c \
+generated/count_16_l8.c \
+generated/count_4_l16.c \
+generated/count_8_l16.c \
+generated/count_16_l16.c
i_maxloc0_c= \
generated/maxloc0_4_i4.c \
generated/maxloc0_8_i4.c \
+generated/maxloc0_16_i4.c \
generated/maxloc0_4_i8.c \
generated/maxloc0_8_i8.c \
+generated/maxloc0_16_i8.c \
+generated/maxloc0_4_i16.c \
+generated/maxloc0_8_i16.c \
+generated/maxloc0_16_i16.c \
generated/maxloc0_4_r4.c \
generated/maxloc0_8_r4.c \
+generated/maxloc0_16_r4.c \
generated/maxloc0_4_r8.c \
-generated/maxloc0_8_r8.c
+generated/maxloc0_8_r8.c \
+generated/maxloc0_16_r8.c \
+generated/maxloc0_4_r10.c \
+generated/maxloc0_8_r10.c \
+generated/maxloc0_16_r10.c \
+generated/maxloc0_4_r16.c \
+generated/maxloc0_8_r16.c \
+generated/maxloc0_16_r16.c
i_maxloc1_c= \
generated/maxloc1_4_i4.c \
generated/maxloc1_8_i4.c \
+generated/maxloc1_16_i4.c \
generated/maxloc1_4_i8.c \
generated/maxloc1_8_i8.c \
+generated/maxloc1_16_i8.c \
+generated/maxloc1_4_i16.c \
+generated/maxloc1_8_i16.c \
+generated/maxloc1_16_i16.c \
generated/maxloc1_4_r4.c \
generated/maxloc1_8_r4.c \
+generated/maxloc1_16_r4.c \
generated/maxloc1_4_r8.c \
-generated/maxloc1_8_r8.c
+generated/maxloc1_8_r8.c \
+generated/maxloc1_16_r8.c \
+generated/maxloc1_4_r10.c \
+generated/maxloc1_8_r10.c \
+generated/maxloc1_16_r10.c \
+generated/maxloc1_4_r16.c \
+generated/maxloc1_8_r16.c \
+generated/maxloc1_16_r16.c
i_maxval_c= \
generated/maxval_i4.c \
generated/maxval_i8.c \
+generated/maxval_i16.c \
generated/maxval_r4.c \
-generated/maxval_r8.c
+generated/maxval_r8.c \
+generated/maxval_r10.c \
+generated/maxval_r16.c
i_minloc0_c= \
generated/minloc0_4_i4.c \
generated/minloc0_8_i4.c \
+generated/minloc0_16_i4.c \
generated/minloc0_4_i8.c \
generated/minloc0_8_i8.c \
+generated/minloc0_16_i8.c \
+generated/minloc0_4_i16.c \
+generated/minloc0_8_i16.c \
+generated/minloc0_16_i16.c \
generated/minloc0_4_r4.c \
generated/minloc0_8_r4.c \
+generated/minloc0_16_r4.c \
generated/minloc0_4_r8.c \
-generated/minloc0_8_r8.c
+generated/minloc0_8_r8.c \
+generated/minloc0_16_r8.c \
+generated/minloc0_4_r10.c \
+generated/minloc0_8_r10.c \
+generated/minloc0_16_r10.c \
+generated/minloc0_4_r16.c \
+generated/minloc0_8_r16.c \
+generated/minloc0_16_r16.c
i_minloc1_c= \
generated/minloc1_4_i4.c \
generated/minloc1_8_i4.c \
+generated/minloc1_16_i4.c \
generated/minloc1_4_i8.c \
generated/minloc1_8_i8.c \
+generated/minloc1_16_i8.c \
+generated/minloc1_4_i16.c \
+generated/minloc1_8_i16.c \
+generated/minloc1_16_i16.c \
generated/minloc1_4_r4.c \
generated/minloc1_8_r4.c \
+generated/minloc1_16_r4.c \
generated/minloc1_4_r8.c \
-generated/minloc1_8_r8.c
+generated/minloc1_8_r8.c \
+generated/minloc1_16_r8.c \
+generated/minloc1_4_r10.c \
+generated/minloc1_8_r10.c \
+generated/minloc1_16_r10.c \
+generated/minloc1_4_r16.c \
+generated/minloc1_8_r16.c \
+generated/minloc1_16_r16.c
i_minval_c= \
generated/minval_i4.c \
generated/minval_i8.c \
+generated/minval_i16.c \
generated/minval_r4.c \
-generated/minval_r8.c
+generated/minval_r8.c \
+generated/minval_r10.c \
+generated/minval_r16.c
i_sum_c= \
generated/sum_i4.c \
generated/sum_i8.c \
+generated/sum_i16.c \
generated/sum_r4.c \
generated/sum_r8.c \
+generated/sum_r10.c \
+generated/sum_r16.c \
generated/sum_c4.c \
-generated/sum_c8.c
+generated/sum_c8.c \
+generated/sum_c10.c \
+generated/sum_c16.c
i_product_c= \
generated/product_i4.c \
generated/product_i8.c \
+generated/product_i16.c \
generated/product_r4.c \
generated/product_r8.c \
+generated/product_r10.c \
+generated/product_r16.c \
generated/product_c4.c \
-generated/product_c8.c
+generated/product_c8.c \
+generated/product_c10.c \
+generated/product_c16.c
i_dotprod_c= \
generated/dotprod_i4.c \
generated/dotprod_i8.c \
+generated/dotprod_i16.c \
generated/dotprod_r4.c \
-generated/dotprod_r8.c
+generated/dotprod_r8.c \
+generated/dotprod_r10.c \
+generated/dotprod_r16.c
i_dotprodl_c= \
generated/dotprod_l4.c \
-generated/dotprod_l8.c
+generated/dotprod_l8.c \
+generated/dotprod_l16.c
i_dotprodc_c= \
generated/dotprod_c4.c \
-generated/dotprod_c8.c
+generated/dotprod_c8.c \
+generated/dotprod_c10.c \
+generated/dotprod_c16.c
i_matmul_c= \
generated/matmul_i4.c \
generated/matmul_i8.c \
+generated/matmul_i16.c \
generated/matmul_r4.c \
generated/matmul_r8.c \
+generated/matmul_r10.c \
+generated/matmul_r16.c \
generated/matmul_c4.c \
-generated/matmul_c8.c
+generated/matmul_c8.c \
+generated/matmul_c10.c \
+generated/matmul_c16.c
i_matmull_c= \
generated/matmul_l4.c \
-generated/matmul_l8.c
+generated/matmul_l8.c \
+generated/matmul_l16.c
i_transpose_c= \
generated/transpose_i4.c \
generated/transpose_i8.c \
+generated/transpose_i16.c \
generated/transpose_c4.c \
-generated/transpose_c8.c
+generated/transpose_c8.c \
+generated/transpose_c10.c \
+generated/transpose_c16.c
i_shape_c= \
generated/shape_i4.c \
-generated/shape_i8.c
+generated/shape_i8.c \
+generated/shape_i16.c
i_reshape_c= \
generated/reshape_i4.c \
generated/reshape_i8.c \
+generated/reshape_i16.c \
generated/reshape_c4.c \
-generated/reshape_c8.c
+generated/reshape_c8.c \
+generated/reshape_c10.c \
+generated/reshape_c16.c
i_eoshift1_c= \
generated/eoshift1_4.c \
-generated/eoshift1_8.c
+generated/eoshift1_8.c \
+generated/eoshift1_16.c
i_eoshift3_c= \
generated/eoshift3_4.c \
-generated/eoshift3_8.c
+generated/eoshift3_8.c \
+generated/eoshift3_16.c
i_cshift1_c= \
generated/cshift1_4.c \
-generated/cshift1_8.c
+generated/cshift1_8.c \
+generated/cshift1_16.c
in_pack_c = \
generated/in_pack_i4.c \
generated/in_pack_i8.c \
+generated/in_pack_i16.c \
generated/in_pack_c4.c \
-generated/in_pack_c8.c
+generated/in_pack_c8.c \
+generated/in_pack_c10.c \
+generated/in_pack_c16.c
in_unpack_c = \
generated/in_unpack_i4.c \
generated/in_unpack_i8.c \
+generated/in_unpack_i16.c \
generated/in_unpack_c4.c \
-generated/in_unpack_c8.c
+generated/in_unpack_c8.c \
+generated/in_unpack_c10.c \
+generated/in_unpack_c16.c
i_exponent_c = \
generated/exponent_r4.c \
-generated/exponent_r8.c
+generated/exponent_r8.c \
+generated/exponent_r10.c \
+generated/exponent_r16.c
i_fraction_c = \
generated/fraction_r4.c \
-generated/fraction_r8.c
+generated/fraction_r8.c \
+generated/fraction_r10.c \
+generated/fraction_r16.c
i_nearest_c = \
generated/nearest_r4.c \
-generated/nearest_r8.c
+generated/nearest_r8.c \
+generated/nearest_r10.c \
+generated/nearest_r16.c
i_set_exponent_c = \
generated/set_exponent_r4.c \
-generated/set_exponent_r8.c
+generated/set_exponent_r8.c \
+generated/set_exponent_r10.c \
+generated/set_exponent_r16.c
i_pow_c = \
generated/pow_i4_i4.c \
generated/pow_i8_i4.c \
+generated/pow_i16_i4.c \
generated/pow_r4_i4.c \
generated/pow_r8_i4.c \
+generated/pow_r10_i4.c \
+generated/pow_r16_i4.c \
generated/pow_c4_i4.c \
generated/pow_c8_i4.c \
+generated/pow_c10_i4.c \
+generated/pow_c16_i4.c \
generated/pow_i4_i8.c \
generated/pow_i8_i8.c \
+generated/pow_i16_i8.c \
generated/pow_r4_i8.c \
generated/pow_r8_i8.c \
+generated/pow_r10_i8.c \
+generated/pow_r16_i8.c \
generated/pow_c4_i8.c \
-generated/pow_c8_i8.c
+generated/pow_c8_i8.c \
+generated/pow_c10_i8.c \
+generated/pow_c16_i8.c \
+generated/pow_i4_i16.c \
+generated/pow_i8_i16.c \
+generated/pow_i16_i16.c \
+generated/pow_r4_i16.c \
+generated/pow_r8_i16.c \
+generated/pow_r10_i16.c \
+generated/pow_r16_i16.c \
+generated/pow_c4_i16.c \
+generated/pow_c8_i16.c \
+generated/pow_c10_i16.c \
+generated/pow_c16_i16.c
m4_files= m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
m4/any.m4 m4/count.m4 m4/maxloc0.m4 m4/maxloc1.m4 m4/maxval.m4 \
$(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \
$(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \
$(i_pow_c) \
- selected_int_kind.inc selected_real_kind.inc kinds.h
+ selected_int_kind.inc selected_real_kind.inc kinds.h \
+ kinds.inc c99_protos.inc
# Machine generated specifics
gfor_built_specific_src= \
-generated/_abs_c4.f90 \
-generated/_abs_c8.f90 \
-generated/_abs_i4.f90 \
-generated/_abs_i8.f90 \
-generated/_abs_r4.f90 \
-generated/_abs_r8.f90 \
-generated/_exp_r4.f90 \
-generated/_exp_r8.f90 \
-generated/_exp_c4.f90 \
-generated/_exp_c8.f90 \
-generated/_log_r4.f90 \
-generated/_log_r8.f90 \
-generated/_log_c4.f90 \
-generated/_log_c8.f90 \
-generated/_log10_r4.f90 \
-generated/_log10_r8.f90 \
-generated/_sqrt_r4.f90 \
-generated/_sqrt_r8.f90 \
-generated/_sqrt_c4.f90 \
-generated/_sqrt_c8.f90 \
-generated/_asin_r4.f90 \
-generated/_asin_r8.f90 \
-generated/_acos_r4.f90 \
-generated/_acos_r8.f90 \
-generated/_atan_r4.f90 \
-generated/_atan_r8.f90 \
-generated/_sin_r4.f90 \
-generated/_sin_r8.f90 \
-generated/_sin_c4.f90 \
-generated/_sin_c8.f90 \
-generated/_cos_r4.f90 \
-generated/_cos_r8.f90 \
-generated/_cos_c4.f90 \
-generated/_cos_c8.f90 \
-generated/_tan_r4.f90 \
-generated/_tan_r8.f90 \
-generated/_sinh_r4.f90 \
-generated/_sinh_r8.f90 \
-generated/_cosh_r4.f90 \
-generated/_cosh_r8.f90 \
-generated/_tanh_r4.f90 \
-generated/_tanh_r8.f90 \
-generated/_conjg_c4.f90 \
-generated/_conjg_c8.f90 \
-generated/_aint_r4.f90 \
-generated/_aint_r8.f90 \
-generated/_anint_r4.f90 \
-generated/_anint_r8.f90
+generated/_abs_c4.F90 \
+generated/_abs_c8.F90 \
+generated/_abs_c10.F90 \
+generated/_abs_c16.F90 \
+generated/_abs_i4.F90 \
+generated/_abs_i8.F90 \
+generated/_abs_i16.F90 \
+generated/_abs_r4.F90 \
+generated/_abs_r8.F90 \
+generated/_abs_r10.F90 \
+generated/_abs_r16.F90 \
+generated/_exp_r4.F90 \
+generated/_exp_r8.F90 \
+generated/_exp_r10.F90 \
+generated/_exp_r16.F90 \
+generated/_exp_c4.F90 \
+generated/_exp_c8.F90 \
+generated/_exp_c10.F90 \
+generated/_exp_c16.F90 \
+generated/_log_r4.F90 \
+generated/_log_r8.F90 \
+generated/_log_r10.F90 \
+generated/_log_r16.F90 \
+generated/_log_c4.F90 \
+generated/_log_c8.F90 \
+generated/_log_c10.F90 \
+generated/_log_c16.F90 \
+generated/_log10_r4.F90 \
+generated/_log10_r8.F90 \
+generated/_log10_r10.F90 \
+generated/_log10_r16.F90 \
+generated/_sqrt_r4.F90 \
+generated/_sqrt_r8.F90 \
+generated/_sqrt_r10.F90 \
+generated/_sqrt_r16.F90 \
+generated/_sqrt_c4.F90 \
+generated/_sqrt_c8.F90 \
+generated/_sqrt_c10.F90 \
+generated/_sqrt_c16.F90 \
+generated/_asin_r4.F90 \
+generated/_asin_r8.F90 \
+generated/_asin_r10.F90 \
+generated/_asin_r16.F90 \
+generated/_acos_r4.F90 \
+generated/_acos_r8.F90 \
+generated/_acos_r10.F90 \
+generated/_acos_r16.F90 \
+generated/_atan_r4.F90 \
+generated/_atan_r8.F90 \
+generated/_atan_r10.F90 \
+generated/_atan_r16.F90 \
+generated/_sin_r4.F90 \
+generated/_sin_r8.F90 \
+generated/_sin_r10.F90 \
+generated/_sin_r16.F90 \
+generated/_sin_c4.F90 \
+generated/_sin_c8.F90 \
+generated/_sin_c10.F90 \
+generated/_sin_c16.F90 \
+generated/_cos_r4.F90 \
+generated/_cos_r8.F90 \
+generated/_cos_r10.F90 \
+generated/_cos_r16.F90 \
+generated/_cos_c4.F90 \
+generated/_cos_c8.F90 \
+generated/_cos_c10.F90 \
+generated/_cos_c16.F90 \
+generated/_tan_r4.F90 \
+generated/_tan_r8.F90 \
+generated/_tan_r10.F90 \
+generated/_tan_r16.F90 \
+generated/_sinh_r4.F90 \
+generated/_sinh_r8.F90 \
+generated/_sinh_r10.F90 \
+generated/_sinh_r16.F90 \
+generated/_cosh_r4.F90 \
+generated/_cosh_r8.F90 \
+generated/_cosh_r10.F90 \
+generated/_cosh_r16.F90 \
+generated/_tanh_r4.F90 \
+generated/_tanh_r8.F90 \
+generated/_tanh_r10.F90 \
+generated/_tanh_r16.F90 \
+generated/_conjg_c4.F90 \
+generated/_conjg_c8.F90 \
+generated/_conjg_c10.F90 \
+generated/_conjg_c16.F90 \
+generated/_aint_r4.F90 \
+generated/_aint_r8.F90 \
+generated/_aint_r10.F90 \
+generated/_aint_r16.F90 \
+generated/_anint_r4.F90 \
+generated/_anint_r8.F90 \
+generated/_anint_r10.F90 \
+generated/_anint_r16.F90
gfor_built_specific2_src= \
-generated/_sign_i4.f90 \
-generated/_sign_i8.f90 \
-generated/_sign_r4.f90 \
-generated/_sign_r8.f90 \
-generated/_dim_i4.f90 \
-generated/_dim_i8.f90 \
-generated/_dim_r4.f90 \
-generated/_dim_r8.f90 \
-generated/_atan2_r4.f90 \
-generated/_atan2_r8.f90 \
-generated/_mod_i4.f90 \
-generated/_mod_i8.f90 \
-generated/_mod_r4.f90 \
-generated/_mod_r8.f90
+generated/_sign_i4.F90 \
+generated/_sign_i8.F90 \
+generated/_sign_i16.F90 \
+generated/_sign_r4.F90 \
+generated/_sign_r8.F90 \
+generated/_sign_r10.F90 \
+generated/_sign_r16.F90 \
+generated/_dim_i4.F90 \
+generated/_dim_i8.F90 \
+generated/_dim_i16.F90 \
+generated/_dim_r4.F90 \
+generated/_dim_r8.F90 \
+generated/_dim_r10.F90 \
+generated/_dim_r16.F90 \
+generated/_atan2_r4.F90 \
+generated/_atan2_r8.F90 \
+generated/_atan2_r10.F90 \
+generated/_atan2_r16.F90 \
+generated/_mod_i4.F90 \
+generated/_mod_i8.F90 \
+generated/_mod_i16.F90 \
+generated/_mod_r4.F90 \
+generated/_mod_r8.F90
+# There are commented out due to a bug in the way the front-end
+# handles MOD
+#generated/_mod_r10.F90
+#generated/_mod_r16.F90
gfor_specific_src= \
$(gfor_built_specific_src) \
kinds.h: $(srcdir)/mk-kinds-h.sh
$(SHELL) $(srcdir)/mk-kinds-h.sh '$(FCCOMPILE)' > $@
+kinds.inc: kinds.h
+ grep '^#' < kinds.h > $@
+
+c99_protos.inc: $(srcdir)/c99_protos.h
+ grep '^#' < $(srcdir)/c99_protos.h > $@
+
selected_int_kind.inc: $(srcdir)/mk-sik-inc.sh
$(SHELL) $(srcdir)/mk-sik-inc.sh '$(FCCOMPILE)' > $@
libgfortran_la_LIBADD =
am__objects_1 = compile_options.lo environ.lo error.lo main.lo \
memory.lo pause.lo stop.lo string.lo select.lo
-am__objects_2 = all_l4.lo all_l8.lo
-am__objects_3 = any_l4.lo any_l8.lo
-am__objects_4 = count_4_l4.lo count_8_l4.lo count_4_l8.lo \
- count_8_l8.lo
-am__objects_5 = maxloc0_4_i4.lo maxloc0_8_i4.lo maxloc0_4_i8.lo \
- maxloc0_8_i8.lo maxloc0_4_r4.lo maxloc0_8_r4.lo \
- maxloc0_4_r8.lo maxloc0_8_r8.lo
-am__objects_6 = maxloc1_4_i4.lo maxloc1_8_i4.lo maxloc1_4_i8.lo \
- maxloc1_8_i8.lo maxloc1_4_r4.lo maxloc1_8_r4.lo \
- maxloc1_4_r8.lo maxloc1_8_r8.lo
-am__objects_7 = maxval_i4.lo maxval_i8.lo maxval_r4.lo maxval_r8.lo
-am__objects_8 = minloc0_4_i4.lo minloc0_8_i4.lo minloc0_4_i8.lo \
- minloc0_8_i8.lo minloc0_4_r4.lo minloc0_8_r4.lo \
- minloc0_4_r8.lo minloc0_8_r8.lo
-am__objects_9 = minloc1_4_i4.lo minloc1_8_i4.lo minloc1_4_i8.lo \
- minloc1_8_i8.lo minloc1_4_r4.lo minloc1_8_r4.lo \
- minloc1_4_r8.lo minloc1_8_r8.lo
-am__objects_10 = minval_i4.lo minval_i8.lo minval_r4.lo minval_r8.lo
-am__objects_11 = product_i4.lo product_i8.lo product_r4.lo \
- product_r8.lo product_c4.lo product_c8.lo
-am__objects_12 = sum_i4.lo sum_i8.lo sum_r4.lo sum_r8.lo sum_c4.lo \
- sum_c8.lo
-am__objects_13 = dotprod_i4.lo dotprod_i8.lo dotprod_r4.lo \
- dotprod_r8.lo
-am__objects_14 = dotprod_l4.lo dotprod_l8.lo
-am__objects_15 = dotprod_c4.lo dotprod_c8.lo
-am__objects_16 = matmul_i4.lo matmul_i8.lo matmul_r4.lo matmul_r8.lo \
- matmul_c4.lo matmul_c8.lo
-am__objects_17 = matmul_l4.lo matmul_l8.lo
-am__objects_18 = transpose_i4.lo transpose_i8.lo transpose_c4.lo \
- transpose_c8.lo
-am__objects_19 = shape_i4.lo shape_i8.lo
-am__objects_20 = eoshift1_4.lo eoshift1_8.lo
-am__objects_21 = eoshift3_4.lo eoshift3_8.lo
-am__objects_22 = cshift1_4.lo cshift1_8.lo
-am__objects_23 = reshape_i4.lo reshape_i8.lo reshape_c4.lo \
- reshape_c8.lo
-am__objects_24 = in_pack_i4.lo in_pack_i8.lo in_pack_c4.lo \
- in_pack_c8.lo
-am__objects_25 = in_unpack_i4.lo in_unpack_i8.lo in_unpack_c4.lo \
- in_unpack_c8.lo
-am__objects_26 = exponent_r4.lo exponent_r8.lo
-am__objects_27 = fraction_r4.lo fraction_r8.lo
-am__objects_28 = nearest_r4.lo nearest_r8.lo
-am__objects_29 = set_exponent_r4.lo set_exponent_r8.lo
-am__objects_30 = pow_i4_i4.lo pow_i8_i4.lo pow_r4_i4.lo pow_r8_i4.lo \
- pow_c4_i4.lo pow_c8_i4.lo pow_i4_i8.lo pow_i8_i8.lo \
- pow_r4_i8.lo pow_r8_i8.lo pow_c4_i8.lo pow_c8_i8.lo
+am__objects_2 = all_l4.lo all_l8.lo all_l16.lo
+am__objects_3 = any_l4.lo any_l8.lo any_l16.lo
+am__objects_4 = count_4_l4.lo count_8_l4.lo count_16_l4.lo \
+ count_4_l8.lo count_8_l8.lo count_16_l8.lo count_4_l16.lo \
+ count_8_l16.lo count_16_l16.lo
+am__objects_5 = maxloc0_4_i4.lo maxloc0_8_i4.lo maxloc0_16_i4.lo \
+ maxloc0_4_i8.lo maxloc0_8_i8.lo maxloc0_16_i8.lo \
+ maxloc0_4_i16.lo maxloc0_8_i16.lo maxloc0_16_i16.lo \
+ maxloc0_4_r4.lo maxloc0_8_r4.lo maxloc0_16_r4.lo \
+ maxloc0_4_r8.lo maxloc0_8_r8.lo maxloc0_16_r8.lo \
+ maxloc0_4_r10.lo maxloc0_8_r10.lo maxloc0_16_r10.lo \
+ maxloc0_4_r16.lo maxloc0_8_r16.lo maxloc0_16_r16.lo
+am__objects_6 = maxloc1_4_i4.lo maxloc1_8_i4.lo maxloc1_16_i4.lo \
+ maxloc1_4_i8.lo maxloc1_8_i8.lo maxloc1_16_i8.lo \
+ maxloc1_4_i16.lo maxloc1_8_i16.lo maxloc1_16_i16.lo \
+ maxloc1_4_r4.lo maxloc1_8_r4.lo maxloc1_16_r4.lo \
+ maxloc1_4_r8.lo maxloc1_8_r8.lo maxloc1_16_r8.lo \
+ maxloc1_4_r10.lo maxloc1_8_r10.lo maxloc1_16_r10.lo \
+ maxloc1_4_r16.lo maxloc1_8_r16.lo maxloc1_16_r16.lo
+am__objects_7 = maxval_i4.lo maxval_i8.lo maxval_i16.lo maxval_r4.lo \
+ maxval_r8.lo maxval_r10.lo maxval_r16.lo
+am__objects_8 = minloc0_4_i4.lo minloc0_8_i4.lo minloc0_16_i4.lo \
+ minloc0_4_i8.lo minloc0_8_i8.lo minloc0_16_i8.lo \
+ minloc0_4_i16.lo minloc0_8_i16.lo minloc0_16_i16.lo \
+ minloc0_4_r4.lo minloc0_8_r4.lo minloc0_16_r4.lo \
+ minloc0_4_r8.lo minloc0_8_r8.lo minloc0_16_r8.lo \
+ minloc0_4_r10.lo minloc0_8_r10.lo minloc0_16_r10.lo \
+ minloc0_4_r16.lo minloc0_8_r16.lo minloc0_16_r16.lo
+am__objects_9 = minloc1_4_i4.lo minloc1_8_i4.lo minloc1_16_i4.lo \
+ minloc1_4_i8.lo minloc1_8_i8.lo minloc1_16_i8.lo \
+ minloc1_4_i16.lo minloc1_8_i16.lo minloc1_16_i16.lo \
+ minloc1_4_r4.lo minloc1_8_r4.lo minloc1_16_r4.lo \
+ minloc1_4_r8.lo minloc1_8_r8.lo minloc1_16_r8.lo \
+ minloc1_4_r10.lo minloc1_8_r10.lo minloc1_16_r10.lo \
+ minloc1_4_r16.lo minloc1_8_r16.lo minloc1_16_r16.lo
+am__objects_10 = minval_i4.lo minval_i8.lo minval_i16.lo minval_r4.lo \
+ minval_r8.lo minval_r10.lo minval_r16.lo
+am__objects_11 = product_i4.lo product_i8.lo product_i16.lo \
+ product_r4.lo product_r8.lo product_r10.lo product_r16.lo \
+ product_c4.lo product_c8.lo product_c10.lo product_c16.lo
+am__objects_12 = sum_i4.lo sum_i8.lo sum_i16.lo sum_r4.lo sum_r8.lo \
+ sum_r10.lo sum_r16.lo sum_c4.lo sum_c8.lo sum_c10.lo \
+ sum_c16.lo
+am__objects_13 = dotprod_i4.lo dotprod_i8.lo dotprod_i16.lo \
+ dotprod_r4.lo dotprod_r8.lo dotprod_r10.lo dotprod_r16.lo
+am__objects_14 = dotprod_l4.lo dotprod_l8.lo dotprod_l16.lo
+am__objects_15 = dotprod_c4.lo dotprod_c8.lo dotprod_c10.lo \
+ dotprod_c16.lo
+am__objects_16 = matmul_i4.lo matmul_i8.lo matmul_i16.lo matmul_r4.lo \
+ matmul_r8.lo matmul_r10.lo matmul_r16.lo matmul_c4.lo \
+ matmul_c8.lo matmul_c10.lo matmul_c16.lo
+am__objects_17 = matmul_l4.lo matmul_l8.lo matmul_l16.lo
+am__objects_18 = transpose_i4.lo transpose_i8.lo transpose_i16.lo \
+ transpose_c4.lo transpose_c8.lo transpose_c10.lo \
+ transpose_c16.lo
+am__objects_19 = shape_i4.lo shape_i8.lo shape_i16.lo
+am__objects_20 = eoshift1_4.lo eoshift1_8.lo eoshift1_16.lo
+am__objects_21 = eoshift3_4.lo eoshift3_8.lo eoshift3_16.lo
+am__objects_22 = cshift1_4.lo cshift1_8.lo cshift1_16.lo
+am__objects_23 = reshape_i4.lo reshape_i8.lo reshape_i16.lo \
+ reshape_c4.lo reshape_c8.lo reshape_c10.lo reshape_c16.lo
+am__objects_24 = in_pack_i4.lo in_pack_i8.lo in_pack_i16.lo \
+ in_pack_c4.lo in_pack_c8.lo in_pack_c10.lo in_pack_c16.lo
+am__objects_25 = in_unpack_i4.lo in_unpack_i8.lo in_unpack_i16.lo \
+ in_unpack_c4.lo in_unpack_c8.lo in_unpack_c10.lo \
+ in_unpack_c16.lo
+am__objects_26 = exponent_r4.lo exponent_r8.lo exponent_r10.lo \
+ exponent_r16.lo
+am__objects_27 = fraction_r4.lo fraction_r8.lo fraction_r10.lo \
+ fraction_r16.lo
+am__objects_28 = nearest_r4.lo nearest_r8.lo nearest_r10.lo \
+ nearest_r16.lo
+am__objects_29 = set_exponent_r4.lo set_exponent_r8.lo \
+ set_exponent_r10.lo set_exponent_r16.lo
+am__objects_30 = pow_i4_i4.lo pow_i8_i4.lo pow_i16_i4.lo pow_r4_i4.lo \
+ pow_r8_i4.lo pow_r10_i4.lo pow_r16_i4.lo pow_c4_i4.lo \
+ pow_c8_i4.lo pow_c10_i4.lo pow_c16_i4.lo pow_i4_i8.lo \
+ pow_i8_i8.lo pow_i16_i8.lo pow_r4_i8.lo pow_r8_i8.lo \
+ pow_r10_i8.lo pow_r16_i8.lo pow_c4_i8.lo pow_c8_i8.lo \
+ pow_c10_i8.lo pow_c16_i8.lo pow_i4_i16.lo pow_i8_i16.lo \
+ pow_i16_i16.lo pow_r4_i16.lo pow_r8_i16.lo pow_r10_i16.lo \
+ pow_r16_i16.lo pow_c4_i16.lo pow_c8_i16.lo pow_c10_i16.lo \
+ pow_c16_i16.lo
am__objects_31 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \
$(am__objects_5) $(am__objects_6) $(am__objects_7) \
$(am__objects_8) $(am__objects_9) $(am__objects_10) \
tty.lo umask.lo unlink.lo unpack_generic.lo in_pack_generic.lo \
in_unpack_generic.lo normalize.lo
am__objects_34 =
-am__objects_35 = _abs_c4.lo _abs_c8.lo _abs_i4.lo _abs_i8.lo \
- _abs_r4.lo _abs_r8.lo _exp_r4.lo _exp_r8.lo _exp_c4.lo \
- _exp_c8.lo _log_r4.lo _log_r8.lo _log_c4.lo _log_c8.lo \
- _log10_r4.lo _log10_r8.lo _sqrt_r4.lo _sqrt_r8.lo _sqrt_c4.lo \
- _sqrt_c8.lo _asin_r4.lo _asin_r8.lo _acos_r4.lo _acos_r8.lo \
- _atan_r4.lo _atan_r8.lo _sin_r4.lo _sin_r8.lo _sin_c4.lo \
- _sin_c8.lo _cos_r4.lo _cos_r8.lo _cos_c4.lo _cos_c8.lo \
- _tan_r4.lo _tan_r8.lo _sinh_r4.lo _sinh_r8.lo _cosh_r4.lo \
- _cosh_r8.lo _tanh_r4.lo _tanh_r8.lo _conjg_c4.lo _conjg_c8.lo \
- _aint_r4.lo _aint_r8.lo _anint_r4.lo _anint_r8.lo
-am__objects_36 = _sign_i4.lo _sign_i8.lo _sign_r4.lo _sign_r8.lo \
- _dim_i4.lo _dim_i8.lo _dim_r4.lo _dim_r8.lo _atan2_r4.lo \
- _atan2_r8.lo _mod_i4.lo _mod_i8.lo _mod_r4.lo _mod_r8.lo
+am__objects_35 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
+ _abs_i4.lo _abs_i8.lo _abs_i16.lo _abs_r4.lo _abs_r8.lo \
+ _abs_r10.lo _abs_r16.lo _exp_r4.lo _exp_r8.lo _exp_r10.lo \
+ _exp_r16.lo _exp_c4.lo _exp_c8.lo _exp_c10.lo _exp_c16.lo \
+ _log_r4.lo _log_r8.lo _log_r10.lo _log_r16.lo _log_c4.lo \
+ _log_c8.lo _log_c10.lo _log_c16.lo _log10_r4.lo _log10_r8.lo \
+ _log10_r10.lo _log10_r16.lo _sqrt_r4.lo _sqrt_r8.lo \
+ _sqrt_r10.lo _sqrt_r16.lo _sqrt_c4.lo _sqrt_c8.lo _sqrt_c10.lo \
+ _sqrt_c16.lo _asin_r4.lo _asin_r8.lo _asin_r10.lo _asin_r16.lo \
+ _acos_r4.lo _acos_r8.lo _acos_r10.lo _acos_r16.lo _atan_r4.lo \
+ _atan_r8.lo _atan_r10.lo _atan_r16.lo _sin_r4.lo _sin_r8.lo \
+ _sin_r10.lo _sin_r16.lo _sin_c4.lo _sin_c8.lo _sin_c10.lo \
+ _sin_c16.lo _cos_r4.lo _cos_r8.lo _cos_r10.lo _cos_r16.lo \
+ _cos_c4.lo _cos_c8.lo _cos_c10.lo _cos_c16.lo _tan_r4.lo \
+ _tan_r8.lo _tan_r10.lo _tan_r16.lo _sinh_r4.lo _sinh_r8.lo \
+ _sinh_r10.lo _sinh_r16.lo _cosh_r4.lo _cosh_r8.lo _cosh_r10.lo \
+ _cosh_r16.lo _tanh_r4.lo _tanh_r8.lo _tanh_r10.lo _tanh_r16.lo \
+ _conjg_c4.lo _conjg_c8.lo _conjg_c10.lo _conjg_c16.lo \
+ _aint_r4.lo _aint_r8.lo _aint_r10.lo _aint_r16.lo _anint_r4.lo \
+ _anint_r8.lo _anint_r10.lo _anint_r16.lo
+am__objects_36 = _sign_i4.lo _sign_i8.lo _sign_i16.lo _sign_r4.lo \
+ _sign_r8.lo _sign_r10.lo _sign_r16.lo _dim_i4.lo _dim_i8.lo \
+ _dim_i16.lo _dim_r4.lo _dim_r8.lo _dim_r10.lo _dim_r16.lo \
+ _atan2_r4.lo _atan2_r8.lo _atan2_r10.lo _atan2_r16.lo \
+ _mod_i4.lo _mod_i8.lo _mod_i16.lo _mod_r4.lo _mod_r8.lo
am__objects_37 = $(am__objects_35) $(am__objects_36) dprod_r8.lo \
f2c_specifics.lo
am_libgfortran_la_OBJECTS = $(am__objects_1) $(am__objects_31) \
i_all_c = \
generated/all_l4.c \
-generated/all_l8.c
+generated/all_l8.c \
+generated/all_l16.c
i_any_c = \
generated/any_l4.c \
-generated/any_l8.c
+generated/any_l8.c \
+generated/any_l16.c
i_count_c = \
generated/count_4_l4.c \
generated/count_8_l4.c \
+generated/count_16_l4.c \
generated/count_4_l8.c \
-generated/count_8_l8.c
+generated/count_8_l8.c \
+generated/count_16_l8.c \
+generated/count_4_l16.c \
+generated/count_8_l16.c \
+generated/count_16_l16.c
i_maxloc0_c = \
generated/maxloc0_4_i4.c \
generated/maxloc0_8_i4.c \
+generated/maxloc0_16_i4.c \
generated/maxloc0_4_i8.c \
generated/maxloc0_8_i8.c \
+generated/maxloc0_16_i8.c \
+generated/maxloc0_4_i16.c \
+generated/maxloc0_8_i16.c \
+generated/maxloc0_16_i16.c \
generated/maxloc0_4_r4.c \
generated/maxloc0_8_r4.c \
+generated/maxloc0_16_r4.c \
generated/maxloc0_4_r8.c \
-generated/maxloc0_8_r8.c
+generated/maxloc0_8_r8.c \
+generated/maxloc0_16_r8.c \
+generated/maxloc0_4_r10.c \
+generated/maxloc0_8_r10.c \
+generated/maxloc0_16_r10.c \
+generated/maxloc0_4_r16.c \
+generated/maxloc0_8_r16.c \
+generated/maxloc0_16_r16.c
i_maxloc1_c = \
generated/maxloc1_4_i4.c \
generated/maxloc1_8_i4.c \
+generated/maxloc1_16_i4.c \
generated/maxloc1_4_i8.c \
generated/maxloc1_8_i8.c \
+generated/maxloc1_16_i8.c \
+generated/maxloc1_4_i16.c \
+generated/maxloc1_8_i16.c \
+generated/maxloc1_16_i16.c \
generated/maxloc1_4_r4.c \
generated/maxloc1_8_r4.c \
+generated/maxloc1_16_r4.c \
generated/maxloc1_4_r8.c \
-generated/maxloc1_8_r8.c
+generated/maxloc1_8_r8.c \
+generated/maxloc1_16_r8.c \
+generated/maxloc1_4_r10.c \
+generated/maxloc1_8_r10.c \
+generated/maxloc1_16_r10.c \
+generated/maxloc1_4_r16.c \
+generated/maxloc1_8_r16.c \
+generated/maxloc1_16_r16.c
i_maxval_c = \
generated/maxval_i4.c \
generated/maxval_i8.c \
+generated/maxval_i16.c \
generated/maxval_r4.c \
-generated/maxval_r8.c
+generated/maxval_r8.c \
+generated/maxval_r10.c \
+generated/maxval_r16.c
i_minloc0_c = \
generated/minloc0_4_i4.c \
generated/minloc0_8_i4.c \
+generated/minloc0_16_i4.c \
generated/minloc0_4_i8.c \
generated/minloc0_8_i8.c \
+generated/minloc0_16_i8.c \
+generated/minloc0_4_i16.c \
+generated/minloc0_8_i16.c \
+generated/minloc0_16_i16.c \
generated/minloc0_4_r4.c \
generated/minloc0_8_r4.c \
+generated/minloc0_16_r4.c \
generated/minloc0_4_r8.c \
-generated/minloc0_8_r8.c
+generated/minloc0_8_r8.c \
+generated/minloc0_16_r8.c \
+generated/minloc0_4_r10.c \
+generated/minloc0_8_r10.c \
+generated/minloc0_16_r10.c \
+generated/minloc0_4_r16.c \
+generated/minloc0_8_r16.c \
+generated/minloc0_16_r16.c
i_minloc1_c = \
generated/minloc1_4_i4.c \
generated/minloc1_8_i4.c \
+generated/minloc1_16_i4.c \
generated/minloc1_4_i8.c \
generated/minloc1_8_i8.c \
+generated/minloc1_16_i8.c \
+generated/minloc1_4_i16.c \
+generated/minloc1_8_i16.c \
+generated/minloc1_16_i16.c \
generated/minloc1_4_r4.c \
generated/minloc1_8_r4.c \
+generated/minloc1_16_r4.c \
generated/minloc1_4_r8.c \
-generated/minloc1_8_r8.c
+generated/minloc1_8_r8.c \
+generated/minloc1_16_r8.c \
+generated/minloc1_4_r10.c \
+generated/minloc1_8_r10.c \
+generated/minloc1_16_r10.c \
+generated/minloc1_4_r16.c \
+generated/minloc1_8_r16.c \
+generated/minloc1_16_r16.c
i_minval_c = \
generated/minval_i4.c \
generated/minval_i8.c \
+generated/minval_i16.c \
generated/minval_r4.c \
-generated/minval_r8.c
+generated/minval_r8.c \
+generated/minval_r10.c \
+generated/minval_r16.c
i_sum_c = \
generated/sum_i4.c \
generated/sum_i8.c \
+generated/sum_i16.c \
generated/sum_r4.c \
generated/sum_r8.c \
+generated/sum_r10.c \
+generated/sum_r16.c \
generated/sum_c4.c \
-generated/sum_c8.c
+generated/sum_c8.c \
+generated/sum_c10.c \
+generated/sum_c16.c
i_product_c = \
generated/product_i4.c \
generated/product_i8.c \
+generated/product_i16.c \
generated/product_r4.c \
generated/product_r8.c \
+generated/product_r10.c \
+generated/product_r16.c \
generated/product_c4.c \
-generated/product_c8.c
+generated/product_c8.c \
+generated/product_c10.c \
+generated/product_c16.c
i_dotprod_c = \
generated/dotprod_i4.c \
generated/dotprod_i8.c \
+generated/dotprod_i16.c \
generated/dotprod_r4.c \
-generated/dotprod_r8.c
+generated/dotprod_r8.c \
+generated/dotprod_r10.c \
+generated/dotprod_r16.c
i_dotprodl_c = \
generated/dotprod_l4.c \
-generated/dotprod_l8.c
+generated/dotprod_l8.c \
+generated/dotprod_l16.c
i_dotprodc_c = \
generated/dotprod_c4.c \
-generated/dotprod_c8.c
+generated/dotprod_c8.c \
+generated/dotprod_c10.c \
+generated/dotprod_c16.c
i_matmul_c = \
generated/matmul_i4.c \
generated/matmul_i8.c \
+generated/matmul_i16.c \
generated/matmul_r4.c \
generated/matmul_r8.c \
+generated/matmul_r10.c \
+generated/matmul_r16.c \
generated/matmul_c4.c \
-generated/matmul_c8.c
+generated/matmul_c8.c \
+generated/matmul_c10.c \
+generated/matmul_c16.c
i_matmull_c = \
generated/matmul_l4.c \
-generated/matmul_l8.c
+generated/matmul_l8.c \
+generated/matmul_l16.c
i_transpose_c = \
generated/transpose_i4.c \
generated/transpose_i8.c \
+generated/transpose_i16.c \
generated/transpose_c4.c \
-generated/transpose_c8.c
+generated/transpose_c8.c \
+generated/transpose_c10.c \
+generated/transpose_c16.c
i_shape_c = \
generated/shape_i4.c \
-generated/shape_i8.c
+generated/shape_i8.c \
+generated/shape_i16.c
i_reshape_c = \
generated/reshape_i4.c \
generated/reshape_i8.c \
+generated/reshape_i16.c \
generated/reshape_c4.c \
-generated/reshape_c8.c
+generated/reshape_c8.c \
+generated/reshape_c10.c \
+generated/reshape_c16.c
i_eoshift1_c = \
generated/eoshift1_4.c \
-generated/eoshift1_8.c
+generated/eoshift1_8.c \
+generated/eoshift1_16.c
i_eoshift3_c = \
generated/eoshift3_4.c \
-generated/eoshift3_8.c
+generated/eoshift3_8.c \
+generated/eoshift3_16.c
i_cshift1_c = \
generated/cshift1_4.c \
-generated/cshift1_8.c
+generated/cshift1_8.c \
+generated/cshift1_16.c
in_pack_c = \
generated/in_pack_i4.c \
generated/in_pack_i8.c \
+generated/in_pack_i16.c \
generated/in_pack_c4.c \
-generated/in_pack_c8.c
+generated/in_pack_c8.c \
+generated/in_pack_c10.c \
+generated/in_pack_c16.c
in_unpack_c = \
generated/in_unpack_i4.c \
generated/in_unpack_i8.c \
+generated/in_unpack_i16.c \
generated/in_unpack_c4.c \
-generated/in_unpack_c8.c
+generated/in_unpack_c8.c \
+generated/in_unpack_c10.c \
+generated/in_unpack_c16.c
i_exponent_c = \
generated/exponent_r4.c \
-generated/exponent_r8.c
+generated/exponent_r8.c \
+generated/exponent_r10.c \
+generated/exponent_r16.c
i_fraction_c = \
generated/fraction_r4.c \
-generated/fraction_r8.c
+generated/fraction_r8.c \
+generated/fraction_r10.c \
+generated/fraction_r16.c
i_nearest_c = \
generated/nearest_r4.c \
-generated/nearest_r8.c
+generated/nearest_r8.c \
+generated/nearest_r10.c \
+generated/nearest_r16.c
i_set_exponent_c = \
generated/set_exponent_r4.c \
-generated/set_exponent_r8.c
+generated/set_exponent_r8.c \
+generated/set_exponent_r10.c \
+generated/set_exponent_r16.c
i_pow_c = \
generated/pow_i4_i4.c \
generated/pow_i8_i4.c \
+generated/pow_i16_i4.c \
generated/pow_r4_i4.c \
generated/pow_r8_i4.c \
+generated/pow_r10_i4.c \
+generated/pow_r16_i4.c \
generated/pow_c4_i4.c \
generated/pow_c8_i4.c \
+generated/pow_c10_i4.c \
+generated/pow_c16_i4.c \
generated/pow_i4_i8.c \
generated/pow_i8_i8.c \
+generated/pow_i16_i8.c \
generated/pow_r4_i8.c \
generated/pow_r8_i8.c \
+generated/pow_r10_i8.c \
+generated/pow_r16_i8.c \
generated/pow_c4_i8.c \
-generated/pow_c8_i8.c
+generated/pow_c8_i8.c \
+generated/pow_c10_i8.c \
+generated/pow_c16_i8.c \
+generated/pow_i4_i16.c \
+generated/pow_i8_i16.c \
+generated/pow_i16_i16.c \
+generated/pow_r4_i16.c \
+generated/pow_r8_i16.c \
+generated/pow_r10_i16.c \
+generated/pow_r16_i16.c \
+generated/pow_c4_i16.c \
+generated/pow_c8_i16.c \
+generated/pow_c10_i16.c \
+generated/pow_c16_i16.c
m4_files = m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
m4/any.m4 m4/count.m4 m4/maxloc0.m4 m4/maxloc1.m4 m4/maxval.m4 \
$(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \
$(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \
$(i_pow_c) \
- selected_int_kind.inc selected_real_kind.inc kinds.h
+ selected_int_kind.inc selected_real_kind.inc kinds.h \
+ kinds.inc c99_protos.inc
# Machine generated specifics
gfor_built_specific_src = \
-generated/_abs_c4.f90 \
-generated/_abs_c8.f90 \
-generated/_abs_i4.f90 \
-generated/_abs_i8.f90 \
-generated/_abs_r4.f90 \
-generated/_abs_r8.f90 \
-generated/_exp_r4.f90 \
-generated/_exp_r8.f90 \
-generated/_exp_c4.f90 \
-generated/_exp_c8.f90 \
-generated/_log_r4.f90 \
-generated/_log_r8.f90 \
-generated/_log_c4.f90 \
-generated/_log_c8.f90 \
-generated/_log10_r4.f90 \
-generated/_log10_r8.f90 \
-generated/_sqrt_r4.f90 \
-generated/_sqrt_r8.f90 \
-generated/_sqrt_c4.f90 \
-generated/_sqrt_c8.f90 \
-generated/_asin_r4.f90 \
-generated/_asin_r8.f90 \
-generated/_acos_r4.f90 \
-generated/_acos_r8.f90 \
-generated/_atan_r4.f90 \
-generated/_atan_r8.f90 \
-generated/_sin_r4.f90 \
-generated/_sin_r8.f90 \
-generated/_sin_c4.f90 \
-generated/_sin_c8.f90 \
-generated/_cos_r4.f90 \
-generated/_cos_r8.f90 \
-generated/_cos_c4.f90 \
-generated/_cos_c8.f90 \
-generated/_tan_r4.f90 \
-generated/_tan_r8.f90 \
-generated/_sinh_r4.f90 \
-generated/_sinh_r8.f90 \
-generated/_cosh_r4.f90 \
-generated/_cosh_r8.f90 \
-generated/_tanh_r4.f90 \
-generated/_tanh_r8.f90 \
-generated/_conjg_c4.f90 \
-generated/_conjg_c8.f90 \
-generated/_aint_r4.f90 \
-generated/_aint_r8.f90 \
-generated/_anint_r4.f90 \
-generated/_anint_r8.f90
+generated/_abs_c4.F90 \
+generated/_abs_c8.F90 \
+generated/_abs_c10.F90 \
+generated/_abs_c16.F90 \
+generated/_abs_i4.F90 \
+generated/_abs_i8.F90 \
+generated/_abs_i16.F90 \
+generated/_abs_r4.F90 \
+generated/_abs_r8.F90 \
+generated/_abs_r10.F90 \
+generated/_abs_r16.F90 \
+generated/_exp_r4.F90 \
+generated/_exp_r8.F90 \
+generated/_exp_r10.F90 \
+generated/_exp_r16.F90 \
+generated/_exp_c4.F90 \
+generated/_exp_c8.F90 \
+generated/_exp_c10.F90 \
+generated/_exp_c16.F90 \
+generated/_log_r4.F90 \
+generated/_log_r8.F90 \
+generated/_log_r10.F90 \
+generated/_log_r16.F90 \
+generated/_log_c4.F90 \
+generated/_log_c8.F90 \
+generated/_log_c10.F90 \
+generated/_log_c16.F90 \
+generated/_log10_r4.F90 \
+generated/_log10_r8.F90 \
+generated/_log10_r10.F90 \
+generated/_log10_r16.F90 \
+generated/_sqrt_r4.F90 \
+generated/_sqrt_r8.F90 \
+generated/_sqrt_r10.F90 \
+generated/_sqrt_r16.F90 \
+generated/_sqrt_c4.F90 \
+generated/_sqrt_c8.F90 \
+generated/_sqrt_c10.F90 \
+generated/_sqrt_c16.F90 \
+generated/_asin_r4.F90 \
+generated/_asin_r8.F90 \
+generated/_asin_r10.F90 \
+generated/_asin_r16.F90 \
+generated/_acos_r4.F90 \
+generated/_acos_r8.F90 \
+generated/_acos_r10.F90 \
+generated/_acos_r16.F90 \
+generated/_atan_r4.F90 \
+generated/_atan_r8.F90 \
+generated/_atan_r10.F90 \
+generated/_atan_r16.F90 \
+generated/_sin_r4.F90 \
+generated/_sin_r8.F90 \
+generated/_sin_r10.F90 \
+generated/_sin_r16.F90 \
+generated/_sin_c4.F90 \
+generated/_sin_c8.F90 \
+generated/_sin_c10.F90 \
+generated/_sin_c16.F90 \
+generated/_cos_r4.F90 \
+generated/_cos_r8.F90 \
+generated/_cos_r10.F90 \
+generated/_cos_r16.F90 \
+generated/_cos_c4.F90 \
+generated/_cos_c8.F90 \
+generated/_cos_c10.F90 \
+generated/_cos_c16.F90 \
+generated/_tan_r4.F90 \
+generated/_tan_r8.F90 \
+generated/_tan_r10.F90 \
+generated/_tan_r16.F90 \
+generated/_sinh_r4.F90 \
+generated/_sinh_r8.F90 \
+generated/_sinh_r10.F90 \
+generated/_sinh_r16.F90 \
+generated/_cosh_r4.F90 \
+generated/_cosh_r8.F90 \
+generated/_cosh_r10.F90 \
+generated/_cosh_r16.F90 \
+generated/_tanh_r4.F90 \
+generated/_tanh_r8.F90 \
+generated/_tanh_r10.F90 \
+generated/_tanh_r16.F90 \
+generated/_conjg_c4.F90 \
+generated/_conjg_c8.F90 \
+generated/_conjg_c10.F90 \
+generated/_conjg_c16.F90 \
+generated/_aint_r4.F90 \
+generated/_aint_r8.F90 \
+generated/_aint_r10.F90 \
+generated/_aint_r16.F90 \
+generated/_anint_r4.F90 \
+generated/_anint_r8.F90 \
+generated/_anint_r10.F90 \
+generated/_anint_r16.F90
gfor_built_specific2_src = \
-generated/_sign_i4.f90 \
-generated/_sign_i8.f90 \
-generated/_sign_r4.f90 \
-generated/_sign_r8.f90 \
-generated/_dim_i4.f90 \
-generated/_dim_i8.f90 \
-generated/_dim_r4.f90 \
-generated/_dim_r8.f90 \
-generated/_atan2_r4.f90 \
-generated/_atan2_r8.f90 \
-generated/_mod_i4.f90 \
-generated/_mod_i8.f90 \
-generated/_mod_r4.f90 \
-generated/_mod_r8.f90
-
+generated/_sign_i4.F90 \
+generated/_sign_i8.F90 \
+generated/_sign_i16.F90 \
+generated/_sign_r4.F90 \
+generated/_sign_r8.F90 \
+generated/_sign_r10.F90 \
+generated/_sign_r16.F90 \
+generated/_dim_i4.F90 \
+generated/_dim_i8.F90 \
+generated/_dim_i16.F90 \
+generated/_dim_r4.F90 \
+generated/_dim_r8.F90 \
+generated/_dim_r10.F90 \
+generated/_dim_r16.F90 \
+generated/_atan2_r4.F90 \
+generated/_atan2_r8.F90 \
+generated/_atan2_r10.F90 \
+generated/_atan2_r16.F90 \
+generated/_mod_i4.F90 \
+generated/_mod_i8.F90 \
+generated/_mod_i16.F90 \
+generated/_mod_r4.F90 \
+generated/_mod_r8.F90
+
+# There are commented out due to a bug in the way the front-end
+# handles MOD
+#generated/_mod_r10.F90
+#generated/_mod_r16.F90
gfor_specific_src = \
$(gfor_built_specific_src) \
$(gfor_built_specific2_src) \
.F90.lo:
$(LTPPFCCOMPILE) -c -o $@ $<
+_abs_c4.lo: generated/_abs_c4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c4.lo `test -f 'generated/_abs_c4.F90' || echo '$(srcdir)/'`generated/_abs_c4.F90
+
+_abs_c8.lo: generated/_abs_c8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c8.lo `test -f 'generated/_abs_c8.F90' || echo '$(srcdir)/'`generated/_abs_c8.F90
+
+_abs_c10.lo: generated/_abs_c10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c10.lo `test -f 'generated/_abs_c10.F90' || echo '$(srcdir)/'`generated/_abs_c10.F90
+
+_abs_c16.lo: generated/_abs_c16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c16.lo `test -f 'generated/_abs_c16.F90' || echo '$(srcdir)/'`generated/_abs_c16.F90
+
+_abs_i4.lo: generated/_abs_i4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_i4.lo `test -f 'generated/_abs_i4.F90' || echo '$(srcdir)/'`generated/_abs_i4.F90
+
+_abs_i8.lo: generated/_abs_i8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_i8.lo `test -f 'generated/_abs_i8.F90' || echo '$(srcdir)/'`generated/_abs_i8.F90
+
+_abs_i16.lo: generated/_abs_i16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_i16.lo `test -f 'generated/_abs_i16.F90' || echo '$(srcdir)/'`generated/_abs_i16.F90
+
+_abs_r4.lo: generated/_abs_r4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r4.lo `test -f 'generated/_abs_r4.F90' || echo '$(srcdir)/'`generated/_abs_r4.F90
+
+_abs_r8.lo: generated/_abs_r8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r8.lo `test -f 'generated/_abs_r8.F90' || echo '$(srcdir)/'`generated/_abs_r8.F90
+
+_abs_r10.lo: generated/_abs_r10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r10.lo `test -f 'generated/_abs_r10.F90' || echo '$(srcdir)/'`generated/_abs_r10.F90
+
+_abs_r16.lo: generated/_abs_r16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r16.lo `test -f 'generated/_abs_r16.F90' || echo '$(srcdir)/'`generated/_abs_r16.F90
+
+_exp_r4.lo: generated/_exp_r4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r4.lo `test -f 'generated/_exp_r4.F90' || echo '$(srcdir)/'`generated/_exp_r4.F90
+
+_exp_r8.lo: generated/_exp_r8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r8.lo `test -f 'generated/_exp_r8.F90' || echo '$(srcdir)/'`generated/_exp_r8.F90
+
+_exp_r10.lo: generated/_exp_r10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r10.lo `test -f 'generated/_exp_r10.F90' || echo '$(srcdir)/'`generated/_exp_r10.F90
+
+_exp_r16.lo: generated/_exp_r16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r16.lo `test -f 'generated/_exp_r16.F90' || echo '$(srcdir)/'`generated/_exp_r16.F90
+
+_exp_c4.lo: generated/_exp_c4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c4.lo `test -f 'generated/_exp_c4.F90' || echo '$(srcdir)/'`generated/_exp_c4.F90
+
+_exp_c8.lo: generated/_exp_c8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c8.lo `test -f 'generated/_exp_c8.F90' || echo '$(srcdir)/'`generated/_exp_c8.F90
+
+_exp_c10.lo: generated/_exp_c10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c10.lo `test -f 'generated/_exp_c10.F90' || echo '$(srcdir)/'`generated/_exp_c10.F90
+
+_exp_c16.lo: generated/_exp_c16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c16.lo `test -f 'generated/_exp_c16.F90' || echo '$(srcdir)/'`generated/_exp_c16.F90
+
+_log_r4.lo: generated/_log_r4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r4.lo `test -f 'generated/_log_r4.F90' || echo '$(srcdir)/'`generated/_log_r4.F90
+
+_log_r8.lo: generated/_log_r8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r8.lo `test -f 'generated/_log_r8.F90' || echo '$(srcdir)/'`generated/_log_r8.F90
+
+_log_r10.lo: generated/_log_r10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r10.lo `test -f 'generated/_log_r10.F90' || echo '$(srcdir)/'`generated/_log_r10.F90
+
+_log_r16.lo: generated/_log_r16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r16.lo `test -f 'generated/_log_r16.F90' || echo '$(srcdir)/'`generated/_log_r16.F90
+
+_log_c4.lo: generated/_log_c4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c4.lo `test -f 'generated/_log_c4.F90' || echo '$(srcdir)/'`generated/_log_c4.F90
+
+_log_c8.lo: generated/_log_c8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c8.lo `test -f 'generated/_log_c8.F90' || echo '$(srcdir)/'`generated/_log_c8.F90
+
+_log_c10.lo: generated/_log_c10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c10.lo `test -f 'generated/_log_c10.F90' || echo '$(srcdir)/'`generated/_log_c10.F90
+
+_log_c16.lo: generated/_log_c16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c16.lo `test -f 'generated/_log_c16.F90' || echo '$(srcdir)/'`generated/_log_c16.F90
+
+_log10_r4.lo: generated/_log10_r4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r4.lo `test -f 'generated/_log10_r4.F90' || echo '$(srcdir)/'`generated/_log10_r4.F90
+
+_log10_r8.lo: generated/_log10_r8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r8.lo `test -f 'generated/_log10_r8.F90' || echo '$(srcdir)/'`generated/_log10_r8.F90
+
+_log10_r10.lo: generated/_log10_r10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r10.lo `test -f 'generated/_log10_r10.F90' || echo '$(srcdir)/'`generated/_log10_r10.F90
+
+_log10_r16.lo: generated/_log10_r16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r16.lo `test -f 'generated/_log10_r16.F90' || echo '$(srcdir)/'`generated/_log10_r16.F90
+
+_sqrt_r4.lo: generated/_sqrt_r4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r4.lo `test -f 'generated/_sqrt_r4.F90' || echo '$(srcdir)/'`generated/_sqrt_r4.F90
+
+_sqrt_r8.lo: generated/_sqrt_r8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r8.lo `test -f 'generated/_sqrt_r8.F90' || echo '$(srcdir)/'`generated/_sqrt_r8.F90
+
+_sqrt_r10.lo: generated/_sqrt_r10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r10.lo `test -f 'generated/_sqrt_r10.F90' || echo '$(srcdir)/'`generated/_sqrt_r10.F90
+
+_sqrt_r16.lo: generated/_sqrt_r16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r16.lo `test -f 'generated/_sqrt_r16.F90' || echo '$(srcdir)/'`generated/_sqrt_r16.F90
+
+_sqrt_c4.lo: generated/_sqrt_c4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c4.lo `test -f 'generated/_sqrt_c4.F90' || echo '$(srcdir)/'`generated/_sqrt_c4.F90
+
+_sqrt_c8.lo: generated/_sqrt_c8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c8.lo `test -f 'generated/_sqrt_c8.F90' || echo '$(srcdir)/'`generated/_sqrt_c8.F90
+
+_sqrt_c10.lo: generated/_sqrt_c10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c10.lo `test -f 'generated/_sqrt_c10.F90' || echo '$(srcdir)/'`generated/_sqrt_c10.F90
+
+_sqrt_c16.lo: generated/_sqrt_c16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c16.lo `test -f 'generated/_sqrt_c16.F90' || echo '$(srcdir)/'`generated/_sqrt_c16.F90
+
+_asin_r4.lo: generated/_asin_r4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r4.lo `test -f 'generated/_asin_r4.F90' || echo '$(srcdir)/'`generated/_asin_r4.F90
+
+_asin_r8.lo: generated/_asin_r8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r8.lo `test -f 'generated/_asin_r8.F90' || echo '$(srcdir)/'`generated/_asin_r8.F90
+
+_asin_r10.lo: generated/_asin_r10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r10.lo `test -f 'generated/_asin_r10.F90' || echo '$(srcdir)/'`generated/_asin_r10.F90
+
+_asin_r16.lo: generated/_asin_r16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r16.lo `test -f 'generated/_asin_r16.F90' || echo '$(srcdir)/'`generated/_asin_r16.F90
+
+_acos_r4.lo: generated/_acos_r4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r4.lo `test -f 'generated/_acos_r4.F90' || echo '$(srcdir)/'`generated/_acos_r4.F90
+
+_acos_r8.lo: generated/_acos_r8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r8.lo `test -f 'generated/_acos_r8.F90' || echo '$(srcdir)/'`generated/_acos_r8.F90
+
+_acos_r10.lo: generated/_acos_r10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r10.lo `test -f 'generated/_acos_r10.F90' || echo '$(srcdir)/'`generated/_acos_r10.F90
+
+_acos_r16.lo: generated/_acos_r16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r16.lo `test -f 'generated/_acos_r16.F90' || echo '$(srcdir)/'`generated/_acos_r16.F90
+
+_atan_r4.lo: generated/_atan_r4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r4.lo `test -f 'generated/_atan_r4.F90' || echo '$(srcdir)/'`generated/_atan_r4.F90
+
+_atan_r8.lo: generated/_atan_r8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r8.lo `test -f 'generated/_atan_r8.F90' || echo '$(srcdir)/'`generated/_atan_r8.F90
+
+_atan_r10.lo: generated/_atan_r10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r10.lo `test -f 'generated/_atan_r10.F90' || echo '$(srcdir)/'`generated/_atan_r10.F90
+
+_atan_r16.lo: generated/_atan_r16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r16.lo `test -f 'generated/_atan_r16.F90' || echo '$(srcdir)/'`generated/_atan_r16.F90
+
+_sin_r4.lo: generated/_sin_r4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r4.lo `test -f 'generated/_sin_r4.F90' || echo '$(srcdir)/'`generated/_sin_r4.F90
+
+_sin_r8.lo: generated/_sin_r8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r8.lo `test -f 'generated/_sin_r8.F90' || echo '$(srcdir)/'`generated/_sin_r8.F90
+
+_sin_r10.lo: generated/_sin_r10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r10.lo `test -f 'generated/_sin_r10.F90' || echo '$(srcdir)/'`generated/_sin_r10.F90
+
+_sin_r16.lo: generated/_sin_r16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r16.lo `test -f 'generated/_sin_r16.F90' || echo '$(srcdir)/'`generated/_sin_r16.F90
+
+_sin_c4.lo: generated/_sin_c4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c4.lo `test -f 'generated/_sin_c4.F90' || echo '$(srcdir)/'`generated/_sin_c4.F90
+
+_sin_c8.lo: generated/_sin_c8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c8.lo `test -f 'generated/_sin_c8.F90' || echo '$(srcdir)/'`generated/_sin_c8.F90
+
+_sin_c10.lo: generated/_sin_c10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c10.lo `test -f 'generated/_sin_c10.F90' || echo '$(srcdir)/'`generated/_sin_c10.F90
+
+_sin_c16.lo: generated/_sin_c16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c16.lo `test -f 'generated/_sin_c16.F90' || echo '$(srcdir)/'`generated/_sin_c16.F90
+
+_cos_r4.lo: generated/_cos_r4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r4.lo `test -f 'generated/_cos_r4.F90' || echo '$(srcdir)/'`generated/_cos_r4.F90
+
+_cos_r8.lo: generated/_cos_r8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r8.lo `test -f 'generated/_cos_r8.F90' || echo '$(srcdir)/'`generated/_cos_r8.F90
+
+_cos_r10.lo: generated/_cos_r10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r10.lo `test -f 'generated/_cos_r10.F90' || echo '$(srcdir)/'`generated/_cos_r10.F90
+
+_cos_r16.lo: generated/_cos_r16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r16.lo `test -f 'generated/_cos_r16.F90' || echo '$(srcdir)/'`generated/_cos_r16.F90
+
+_cos_c4.lo: generated/_cos_c4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c4.lo `test -f 'generated/_cos_c4.F90' || echo '$(srcdir)/'`generated/_cos_c4.F90
+
+_cos_c8.lo: generated/_cos_c8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c8.lo `test -f 'generated/_cos_c8.F90' || echo '$(srcdir)/'`generated/_cos_c8.F90
+
+_cos_c10.lo: generated/_cos_c10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c10.lo `test -f 'generated/_cos_c10.F90' || echo '$(srcdir)/'`generated/_cos_c10.F90
+
+_cos_c16.lo: generated/_cos_c16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c16.lo `test -f 'generated/_cos_c16.F90' || echo '$(srcdir)/'`generated/_cos_c16.F90
+
+_tan_r4.lo: generated/_tan_r4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r4.lo `test -f 'generated/_tan_r4.F90' || echo '$(srcdir)/'`generated/_tan_r4.F90
+
+_tan_r8.lo: generated/_tan_r8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r8.lo `test -f 'generated/_tan_r8.F90' || echo '$(srcdir)/'`generated/_tan_r8.F90
+
+_tan_r10.lo: generated/_tan_r10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r10.lo `test -f 'generated/_tan_r10.F90' || echo '$(srcdir)/'`generated/_tan_r10.F90
+
+_tan_r16.lo: generated/_tan_r16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r16.lo `test -f 'generated/_tan_r16.F90' || echo '$(srcdir)/'`generated/_tan_r16.F90
+
+_sinh_r4.lo: generated/_sinh_r4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r4.lo `test -f 'generated/_sinh_r4.F90' || echo '$(srcdir)/'`generated/_sinh_r4.F90
+
+_sinh_r8.lo: generated/_sinh_r8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r8.lo `test -f 'generated/_sinh_r8.F90' || echo '$(srcdir)/'`generated/_sinh_r8.F90
+
+_sinh_r10.lo: generated/_sinh_r10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r10.lo `test -f 'generated/_sinh_r10.F90' || echo '$(srcdir)/'`generated/_sinh_r10.F90
+
+_sinh_r16.lo: generated/_sinh_r16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r16.lo `test -f 'generated/_sinh_r16.F90' || echo '$(srcdir)/'`generated/_sinh_r16.F90
+
+_cosh_r4.lo: generated/_cosh_r4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r4.lo `test -f 'generated/_cosh_r4.F90' || echo '$(srcdir)/'`generated/_cosh_r4.F90
+
+_cosh_r8.lo: generated/_cosh_r8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r8.lo `test -f 'generated/_cosh_r8.F90' || echo '$(srcdir)/'`generated/_cosh_r8.F90
+
+_cosh_r10.lo: generated/_cosh_r10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r10.lo `test -f 'generated/_cosh_r10.F90' || echo '$(srcdir)/'`generated/_cosh_r10.F90
+
+_cosh_r16.lo: generated/_cosh_r16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r16.lo `test -f 'generated/_cosh_r16.F90' || echo '$(srcdir)/'`generated/_cosh_r16.F90
+
+_tanh_r4.lo: generated/_tanh_r4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r4.lo `test -f 'generated/_tanh_r4.F90' || echo '$(srcdir)/'`generated/_tanh_r4.F90
+
+_tanh_r8.lo: generated/_tanh_r8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r8.lo `test -f 'generated/_tanh_r8.F90' || echo '$(srcdir)/'`generated/_tanh_r8.F90
+
+_tanh_r10.lo: generated/_tanh_r10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r10.lo `test -f 'generated/_tanh_r10.F90' || echo '$(srcdir)/'`generated/_tanh_r10.F90
+
+_tanh_r16.lo: generated/_tanh_r16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r16.lo `test -f 'generated/_tanh_r16.F90' || echo '$(srcdir)/'`generated/_tanh_r16.F90
+
+_conjg_c4.lo: generated/_conjg_c4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c4.lo `test -f 'generated/_conjg_c4.F90' || echo '$(srcdir)/'`generated/_conjg_c4.F90
+
+_conjg_c8.lo: generated/_conjg_c8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c8.lo `test -f 'generated/_conjg_c8.F90' || echo '$(srcdir)/'`generated/_conjg_c8.F90
+
+_conjg_c10.lo: generated/_conjg_c10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c10.lo `test -f 'generated/_conjg_c10.F90' || echo '$(srcdir)/'`generated/_conjg_c10.F90
+
+_conjg_c16.lo: generated/_conjg_c16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c16.lo `test -f 'generated/_conjg_c16.F90' || echo '$(srcdir)/'`generated/_conjg_c16.F90
+
+_aint_r4.lo: generated/_aint_r4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r4.lo `test -f 'generated/_aint_r4.F90' || echo '$(srcdir)/'`generated/_aint_r4.F90
+
+_aint_r8.lo: generated/_aint_r8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r8.lo `test -f 'generated/_aint_r8.F90' || echo '$(srcdir)/'`generated/_aint_r8.F90
+
+_aint_r10.lo: generated/_aint_r10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r10.lo `test -f 'generated/_aint_r10.F90' || echo '$(srcdir)/'`generated/_aint_r10.F90
+
+_aint_r16.lo: generated/_aint_r16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r16.lo `test -f 'generated/_aint_r16.F90' || echo '$(srcdir)/'`generated/_aint_r16.F90
+
+_anint_r4.lo: generated/_anint_r4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r4.lo `test -f 'generated/_anint_r4.F90' || echo '$(srcdir)/'`generated/_anint_r4.F90
+
+_anint_r8.lo: generated/_anint_r8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r8.lo `test -f 'generated/_anint_r8.F90' || echo '$(srcdir)/'`generated/_anint_r8.F90
+
+_anint_r10.lo: generated/_anint_r10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r10.lo `test -f 'generated/_anint_r10.F90' || echo '$(srcdir)/'`generated/_anint_r10.F90
+
+_anint_r16.lo: generated/_anint_r16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r16.lo `test -f 'generated/_anint_r16.F90' || echo '$(srcdir)/'`generated/_anint_r16.F90
+
+_sign_i4.lo: generated/_sign_i4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_i4.lo `test -f 'generated/_sign_i4.F90' || echo '$(srcdir)/'`generated/_sign_i4.F90
+
+_sign_i8.lo: generated/_sign_i8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_i8.lo `test -f 'generated/_sign_i8.F90' || echo '$(srcdir)/'`generated/_sign_i8.F90
+
+_sign_i16.lo: generated/_sign_i16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_i16.lo `test -f 'generated/_sign_i16.F90' || echo '$(srcdir)/'`generated/_sign_i16.F90
+
+_sign_r4.lo: generated/_sign_r4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r4.lo `test -f 'generated/_sign_r4.F90' || echo '$(srcdir)/'`generated/_sign_r4.F90
+
+_sign_r8.lo: generated/_sign_r8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r8.lo `test -f 'generated/_sign_r8.F90' || echo '$(srcdir)/'`generated/_sign_r8.F90
+
+_sign_r10.lo: generated/_sign_r10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r10.lo `test -f 'generated/_sign_r10.F90' || echo '$(srcdir)/'`generated/_sign_r10.F90
+
+_sign_r16.lo: generated/_sign_r16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r16.lo `test -f 'generated/_sign_r16.F90' || echo '$(srcdir)/'`generated/_sign_r16.F90
+
+_dim_i4.lo: generated/_dim_i4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_i4.lo `test -f 'generated/_dim_i4.F90' || echo '$(srcdir)/'`generated/_dim_i4.F90
+
+_dim_i8.lo: generated/_dim_i8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_i8.lo `test -f 'generated/_dim_i8.F90' || echo '$(srcdir)/'`generated/_dim_i8.F90
+
+_dim_i16.lo: generated/_dim_i16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_i16.lo `test -f 'generated/_dim_i16.F90' || echo '$(srcdir)/'`generated/_dim_i16.F90
+
+_dim_r4.lo: generated/_dim_r4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r4.lo `test -f 'generated/_dim_r4.F90' || echo '$(srcdir)/'`generated/_dim_r4.F90
+
+_dim_r8.lo: generated/_dim_r8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r8.lo `test -f 'generated/_dim_r8.F90' || echo '$(srcdir)/'`generated/_dim_r8.F90
+
+_dim_r10.lo: generated/_dim_r10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r10.lo `test -f 'generated/_dim_r10.F90' || echo '$(srcdir)/'`generated/_dim_r10.F90
+
+_dim_r16.lo: generated/_dim_r16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r16.lo `test -f 'generated/_dim_r16.F90' || echo '$(srcdir)/'`generated/_dim_r16.F90
+
+_atan2_r4.lo: generated/_atan2_r4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r4.lo `test -f 'generated/_atan2_r4.F90' || echo '$(srcdir)/'`generated/_atan2_r4.F90
+
+_atan2_r8.lo: generated/_atan2_r8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r8.lo `test -f 'generated/_atan2_r8.F90' || echo '$(srcdir)/'`generated/_atan2_r8.F90
+
+_atan2_r10.lo: generated/_atan2_r10.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r10.lo `test -f 'generated/_atan2_r10.F90' || echo '$(srcdir)/'`generated/_atan2_r10.F90
+
+_atan2_r16.lo: generated/_atan2_r16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r16.lo `test -f 'generated/_atan2_r16.F90' || echo '$(srcdir)/'`generated/_atan2_r16.F90
+
+_mod_i4.lo: generated/_mod_i4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_i4.lo `test -f 'generated/_mod_i4.F90' || echo '$(srcdir)/'`generated/_mod_i4.F90
+
+_mod_i8.lo: generated/_mod_i8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_i8.lo `test -f 'generated/_mod_i8.F90' || echo '$(srcdir)/'`generated/_mod_i8.F90
+
+_mod_i16.lo: generated/_mod_i16.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_i16.lo `test -f 'generated/_mod_i16.F90' || echo '$(srcdir)/'`generated/_mod_i16.F90
+
+_mod_r4.lo: generated/_mod_r4.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_r4.lo `test -f 'generated/_mod_r4.F90' || echo '$(srcdir)/'`generated/_mod_r4.F90
+
+_mod_r8.lo: generated/_mod_r8.F90
+ $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_r8.lo `test -f 'generated/_mod_r8.F90' || echo '$(srcdir)/'`generated/_mod_r8.F90
+
f2c_specifics.lo: intrinsics/f2c_specifics.F90
$(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o f2c_specifics.lo `test -f 'intrinsics/f2c_specifics.F90' || echo '$(srcdir)/'`intrinsics/f2c_specifics.F90
all_l8.lo: generated/all_l8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o all_l8.lo `test -f 'generated/all_l8.c' || echo '$(srcdir)/'`generated/all_l8.c
+all_l16.lo: generated/all_l16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o all_l16.lo `test -f 'generated/all_l16.c' || echo '$(srcdir)/'`generated/all_l16.c
+
any_l4.lo: generated/any_l4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l4.lo `test -f 'generated/any_l4.c' || echo '$(srcdir)/'`generated/any_l4.c
any_l8.lo: generated/any_l8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l8.lo `test -f 'generated/any_l8.c' || echo '$(srcdir)/'`generated/any_l8.c
+any_l16.lo: generated/any_l16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l16.lo `test -f 'generated/any_l16.c' || echo '$(srcdir)/'`generated/any_l16.c
+
count_4_l4.lo: generated/count_4_l4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_4_l4.lo `test -f 'generated/count_4_l4.c' || echo '$(srcdir)/'`generated/count_4_l4.c
count_8_l4.lo: generated/count_8_l4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_8_l4.lo `test -f 'generated/count_8_l4.c' || echo '$(srcdir)/'`generated/count_8_l4.c
+count_16_l4.lo: generated/count_16_l4.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_16_l4.lo `test -f 'generated/count_16_l4.c' || echo '$(srcdir)/'`generated/count_16_l4.c
+
count_4_l8.lo: generated/count_4_l8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_4_l8.lo `test -f 'generated/count_4_l8.c' || echo '$(srcdir)/'`generated/count_4_l8.c
count_8_l8.lo: generated/count_8_l8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_8_l8.lo `test -f 'generated/count_8_l8.c' || echo '$(srcdir)/'`generated/count_8_l8.c
+count_16_l8.lo: generated/count_16_l8.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_16_l8.lo `test -f 'generated/count_16_l8.c' || echo '$(srcdir)/'`generated/count_16_l8.c
+
+count_4_l16.lo: generated/count_4_l16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_4_l16.lo `test -f 'generated/count_4_l16.c' || echo '$(srcdir)/'`generated/count_4_l16.c
+
+count_8_l16.lo: generated/count_8_l16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_8_l16.lo `test -f 'generated/count_8_l16.c' || echo '$(srcdir)/'`generated/count_8_l16.c
+
+count_16_l16.lo: generated/count_16_l16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_16_l16.lo `test -f 'generated/count_16_l16.c' || echo '$(srcdir)/'`generated/count_16_l16.c
+
maxloc0_4_i4.lo: generated/maxloc0_4_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_i4.lo `test -f 'generated/maxloc0_4_i4.c' || echo '$(srcdir)/'`generated/maxloc0_4_i4.c
maxloc0_8_i4.lo: generated/maxloc0_8_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_i4.lo `test -f 'generated/maxloc0_8_i4.c' || echo '$(srcdir)/'`generated/maxloc0_8_i4.c
+maxloc0_16_i4.lo: generated/maxloc0_16_i4.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_i4.lo `test -f 'generated/maxloc0_16_i4.c' || echo '$(srcdir)/'`generated/maxloc0_16_i4.c
+
maxloc0_4_i8.lo: generated/maxloc0_4_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_i8.lo `test -f 'generated/maxloc0_4_i8.c' || echo '$(srcdir)/'`generated/maxloc0_4_i8.c
maxloc0_8_i8.lo: generated/maxloc0_8_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_i8.lo `test -f 'generated/maxloc0_8_i8.c' || echo '$(srcdir)/'`generated/maxloc0_8_i8.c
+maxloc0_16_i8.lo: generated/maxloc0_16_i8.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_i8.lo `test -f 'generated/maxloc0_16_i8.c' || echo '$(srcdir)/'`generated/maxloc0_16_i8.c
+
+maxloc0_4_i16.lo: generated/maxloc0_4_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_i16.lo `test -f 'generated/maxloc0_4_i16.c' || echo '$(srcdir)/'`generated/maxloc0_4_i16.c
+
+maxloc0_8_i16.lo: generated/maxloc0_8_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_i16.lo `test -f 'generated/maxloc0_8_i16.c' || echo '$(srcdir)/'`generated/maxloc0_8_i16.c
+
+maxloc0_16_i16.lo: generated/maxloc0_16_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_i16.lo `test -f 'generated/maxloc0_16_i16.c' || echo '$(srcdir)/'`generated/maxloc0_16_i16.c
+
maxloc0_4_r4.lo: generated/maxloc0_4_r4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_r4.lo `test -f 'generated/maxloc0_4_r4.c' || echo '$(srcdir)/'`generated/maxloc0_4_r4.c
maxloc0_8_r4.lo: generated/maxloc0_8_r4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_r4.lo `test -f 'generated/maxloc0_8_r4.c' || echo '$(srcdir)/'`generated/maxloc0_8_r4.c
+maxloc0_16_r4.lo: generated/maxloc0_16_r4.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_r4.lo `test -f 'generated/maxloc0_16_r4.c' || echo '$(srcdir)/'`generated/maxloc0_16_r4.c
+
maxloc0_4_r8.lo: generated/maxloc0_4_r8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_r8.lo `test -f 'generated/maxloc0_4_r8.c' || echo '$(srcdir)/'`generated/maxloc0_4_r8.c
maxloc0_8_r8.lo: generated/maxloc0_8_r8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_r8.lo `test -f 'generated/maxloc0_8_r8.c' || echo '$(srcdir)/'`generated/maxloc0_8_r8.c
+maxloc0_16_r8.lo: generated/maxloc0_16_r8.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_r8.lo `test -f 'generated/maxloc0_16_r8.c' || echo '$(srcdir)/'`generated/maxloc0_16_r8.c
+
+maxloc0_4_r10.lo: generated/maxloc0_4_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_r10.lo `test -f 'generated/maxloc0_4_r10.c' || echo '$(srcdir)/'`generated/maxloc0_4_r10.c
+
+maxloc0_8_r10.lo: generated/maxloc0_8_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_r10.lo `test -f 'generated/maxloc0_8_r10.c' || echo '$(srcdir)/'`generated/maxloc0_8_r10.c
+
+maxloc0_16_r10.lo: generated/maxloc0_16_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_r10.lo `test -f 'generated/maxloc0_16_r10.c' || echo '$(srcdir)/'`generated/maxloc0_16_r10.c
+
+maxloc0_4_r16.lo: generated/maxloc0_4_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_r16.lo `test -f 'generated/maxloc0_4_r16.c' || echo '$(srcdir)/'`generated/maxloc0_4_r16.c
+
+maxloc0_8_r16.lo: generated/maxloc0_8_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_r16.lo `test -f 'generated/maxloc0_8_r16.c' || echo '$(srcdir)/'`generated/maxloc0_8_r16.c
+
+maxloc0_16_r16.lo: generated/maxloc0_16_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_r16.lo `test -f 'generated/maxloc0_16_r16.c' || echo '$(srcdir)/'`generated/maxloc0_16_r16.c
+
maxloc1_4_i4.lo: generated/maxloc1_4_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_i4.lo `test -f 'generated/maxloc1_4_i4.c' || echo '$(srcdir)/'`generated/maxloc1_4_i4.c
maxloc1_8_i4.lo: generated/maxloc1_8_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_i4.lo `test -f 'generated/maxloc1_8_i4.c' || echo '$(srcdir)/'`generated/maxloc1_8_i4.c
+maxloc1_16_i4.lo: generated/maxloc1_16_i4.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_i4.lo `test -f 'generated/maxloc1_16_i4.c' || echo '$(srcdir)/'`generated/maxloc1_16_i4.c
+
maxloc1_4_i8.lo: generated/maxloc1_4_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_i8.lo `test -f 'generated/maxloc1_4_i8.c' || echo '$(srcdir)/'`generated/maxloc1_4_i8.c
maxloc1_8_i8.lo: generated/maxloc1_8_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_i8.lo `test -f 'generated/maxloc1_8_i8.c' || echo '$(srcdir)/'`generated/maxloc1_8_i8.c
+maxloc1_16_i8.lo: generated/maxloc1_16_i8.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_i8.lo `test -f 'generated/maxloc1_16_i8.c' || echo '$(srcdir)/'`generated/maxloc1_16_i8.c
+
+maxloc1_4_i16.lo: generated/maxloc1_4_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_i16.lo `test -f 'generated/maxloc1_4_i16.c' || echo '$(srcdir)/'`generated/maxloc1_4_i16.c
+
+maxloc1_8_i16.lo: generated/maxloc1_8_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_i16.lo `test -f 'generated/maxloc1_8_i16.c' || echo '$(srcdir)/'`generated/maxloc1_8_i16.c
+
+maxloc1_16_i16.lo: generated/maxloc1_16_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_i16.lo `test -f 'generated/maxloc1_16_i16.c' || echo '$(srcdir)/'`generated/maxloc1_16_i16.c
+
maxloc1_4_r4.lo: generated/maxloc1_4_r4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_r4.lo `test -f 'generated/maxloc1_4_r4.c' || echo '$(srcdir)/'`generated/maxloc1_4_r4.c
maxloc1_8_r4.lo: generated/maxloc1_8_r4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_r4.lo `test -f 'generated/maxloc1_8_r4.c' || echo '$(srcdir)/'`generated/maxloc1_8_r4.c
+maxloc1_16_r4.lo: generated/maxloc1_16_r4.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_r4.lo `test -f 'generated/maxloc1_16_r4.c' || echo '$(srcdir)/'`generated/maxloc1_16_r4.c
+
maxloc1_4_r8.lo: generated/maxloc1_4_r8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_r8.lo `test -f 'generated/maxloc1_4_r8.c' || echo '$(srcdir)/'`generated/maxloc1_4_r8.c
maxloc1_8_r8.lo: generated/maxloc1_8_r8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_r8.lo `test -f 'generated/maxloc1_8_r8.c' || echo '$(srcdir)/'`generated/maxloc1_8_r8.c
+maxloc1_16_r8.lo: generated/maxloc1_16_r8.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_r8.lo `test -f 'generated/maxloc1_16_r8.c' || echo '$(srcdir)/'`generated/maxloc1_16_r8.c
+
+maxloc1_4_r10.lo: generated/maxloc1_4_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_r10.lo `test -f 'generated/maxloc1_4_r10.c' || echo '$(srcdir)/'`generated/maxloc1_4_r10.c
+
+maxloc1_8_r10.lo: generated/maxloc1_8_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_r10.lo `test -f 'generated/maxloc1_8_r10.c' || echo '$(srcdir)/'`generated/maxloc1_8_r10.c
+
+maxloc1_16_r10.lo: generated/maxloc1_16_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_r10.lo `test -f 'generated/maxloc1_16_r10.c' || echo '$(srcdir)/'`generated/maxloc1_16_r10.c
+
+maxloc1_4_r16.lo: generated/maxloc1_4_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_r16.lo `test -f 'generated/maxloc1_4_r16.c' || echo '$(srcdir)/'`generated/maxloc1_4_r16.c
+
+maxloc1_8_r16.lo: generated/maxloc1_8_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_r16.lo `test -f 'generated/maxloc1_8_r16.c' || echo '$(srcdir)/'`generated/maxloc1_8_r16.c
+
+maxloc1_16_r16.lo: generated/maxloc1_16_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_r16.lo `test -f 'generated/maxloc1_16_r16.c' || echo '$(srcdir)/'`generated/maxloc1_16_r16.c
+
maxval_i4.lo: generated/maxval_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_i4.lo `test -f 'generated/maxval_i4.c' || echo '$(srcdir)/'`generated/maxval_i4.c
maxval_i8.lo: generated/maxval_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_i8.lo `test -f 'generated/maxval_i8.c' || echo '$(srcdir)/'`generated/maxval_i8.c
+maxval_i16.lo: generated/maxval_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_i16.lo `test -f 'generated/maxval_i16.c' || echo '$(srcdir)/'`generated/maxval_i16.c
+
maxval_r4.lo: generated/maxval_r4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_r4.lo `test -f 'generated/maxval_r4.c' || echo '$(srcdir)/'`generated/maxval_r4.c
maxval_r8.lo: generated/maxval_r8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_r8.lo `test -f 'generated/maxval_r8.c' || echo '$(srcdir)/'`generated/maxval_r8.c
+maxval_r10.lo: generated/maxval_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_r10.lo `test -f 'generated/maxval_r10.c' || echo '$(srcdir)/'`generated/maxval_r10.c
+
+maxval_r16.lo: generated/maxval_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_r16.lo `test -f 'generated/maxval_r16.c' || echo '$(srcdir)/'`generated/maxval_r16.c
+
minloc0_4_i4.lo: generated/minloc0_4_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_i4.lo `test -f 'generated/minloc0_4_i4.c' || echo '$(srcdir)/'`generated/minloc0_4_i4.c
minloc0_8_i4.lo: generated/minloc0_8_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_i4.lo `test -f 'generated/minloc0_8_i4.c' || echo '$(srcdir)/'`generated/minloc0_8_i4.c
+minloc0_16_i4.lo: generated/minloc0_16_i4.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_i4.lo `test -f 'generated/minloc0_16_i4.c' || echo '$(srcdir)/'`generated/minloc0_16_i4.c
+
minloc0_4_i8.lo: generated/minloc0_4_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_i8.lo `test -f 'generated/minloc0_4_i8.c' || echo '$(srcdir)/'`generated/minloc0_4_i8.c
minloc0_8_i8.lo: generated/minloc0_8_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_i8.lo `test -f 'generated/minloc0_8_i8.c' || echo '$(srcdir)/'`generated/minloc0_8_i8.c
+minloc0_16_i8.lo: generated/minloc0_16_i8.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_i8.lo `test -f 'generated/minloc0_16_i8.c' || echo '$(srcdir)/'`generated/minloc0_16_i8.c
+
+minloc0_4_i16.lo: generated/minloc0_4_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_i16.lo `test -f 'generated/minloc0_4_i16.c' || echo '$(srcdir)/'`generated/minloc0_4_i16.c
+
+minloc0_8_i16.lo: generated/minloc0_8_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_i16.lo `test -f 'generated/minloc0_8_i16.c' || echo '$(srcdir)/'`generated/minloc0_8_i16.c
+
+minloc0_16_i16.lo: generated/minloc0_16_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_i16.lo `test -f 'generated/minloc0_16_i16.c' || echo '$(srcdir)/'`generated/minloc0_16_i16.c
+
minloc0_4_r4.lo: generated/minloc0_4_r4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_r4.lo `test -f 'generated/minloc0_4_r4.c' || echo '$(srcdir)/'`generated/minloc0_4_r4.c
minloc0_8_r4.lo: generated/minloc0_8_r4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_r4.lo `test -f 'generated/minloc0_8_r4.c' || echo '$(srcdir)/'`generated/minloc0_8_r4.c
+minloc0_16_r4.lo: generated/minloc0_16_r4.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_r4.lo `test -f 'generated/minloc0_16_r4.c' || echo '$(srcdir)/'`generated/minloc0_16_r4.c
+
minloc0_4_r8.lo: generated/minloc0_4_r8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_r8.lo `test -f 'generated/minloc0_4_r8.c' || echo '$(srcdir)/'`generated/minloc0_4_r8.c
minloc0_8_r8.lo: generated/minloc0_8_r8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_r8.lo `test -f 'generated/minloc0_8_r8.c' || echo '$(srcdir)/'`generated/minloc0_8_r8.c
+minloc0_16_r8.lo: generated/minloc0_16_r8.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_r8.lo `test -f 'generated/minloc0_16_r8.c' || echo '$(srcdir)/'`generated/minloc0_16_r8.c
+
+minloc0_4_r10.lo: generated/minloc0_4_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_r10.lo `test -f 'generated/minloc0_4_r10.c' || echo '$(srcdir)/'`generated/minloc0_4_r10.c
+
+minloc0_8_r10.lo: generated/minloc0_8_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_r10.lo `test -f 'generated/minloc0_8_r10.c' || echo '$(srcdir)/'`generated/minloc0_8_r10.c
+
+minloc0_16_r10.lo: generated/minloc0_16_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_r10.lo `test -f 'generated/minloc0_16_r10.c' || echo '$(srcdir)/'`generated/minloc0_16_r10.c
+
+minloc0_4_r16.lo: generated/minloc0_4_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_r16.lo `test -f 'generated/minloc0_4_r16.c' || echo '$(srcdir)/'`generated/minloc0_4_r16.c
+
+minloc0_8_r16.lo: generated/minloc0_8_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_r16.lo `test -f 'generated/minloc0_8_r16.c' || echo '$(srcdir)/'`generated/minloc0_8_r16.c
+
+minloc0_16_r16.lo: generated/minloc0_16_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_r16.lo `test -f 'generated/minloc0_16_r16.c' || echo '$(srcdir)/'`generated/minloc0_16_r16.c
+
minloc1_4_i4.lo: generated/minloc1_4_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_i4.lo `test -f 'generated/minloc1_4_i4.c' || echo '$(srcdir)/'`generated/minloc1_4_i4.c
minloc1_8_i4.lo: generated/minloc1_8_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_i4.lo `test -f 'generated/minloc1_8_i4.c' || echo '$(srcdir)/'`generated/minloc1_8_i4.c
+minloc1_16_i4.lo: generated/minloc1_16_i4.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_i4.lo `test -f 'generated/minloc1_16_i4.c' || echo '$(srcdir)/'`generated/minloc1_16_i4.c
+
minloc1_4_i8.lo: generated/minloc1_4_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_i8.lo `test -f 'generated/minloc1_4_i8.c' || echo '$(srcdir)/'`generated/minloc1_4_i8.c
minloc1_8_i8.lo: generated/minloc1_8_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_i8.lo `test -f 'generated/minloc1_8_i8.c' || echo '$(srcdir)/'`generated/minloc1_8_i8.c
+minloc1_16_i8.lo: generated/minloc1_16_i8.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_i8.lo `test -f 'generated/minloc1_16_i8.c' || echo '$(srcdir)/'`generated/minloc1_16_i8.c
+
+minloc1_4_i16.lo: generated/minloc1_4_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_i16.lo `test -f 'generated/minloc1_4_i16.c' || echo '$(srcdir)/'`generated/minloc1_4_i16.c
+
+minloc1_8_i16.lo: generated/minloc1_8_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_i16.lo `test -f 'generated/minloc1_8_i16.c' || echo '$(srcdir)/'`generated/minloc1_8_i16.c
+
+minloc1_16_i16.lo: generated/minloc1_16_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_i16.lo `test -f 'generated/minloc1_16_i16.c' || echo '$(srcdir)/'`generated/minloc1_16_i16.c
+
minloc1_4_r4.lo: generated/minloc1_4_r4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_r4.lo `test -f 'generated/minloc1_4_r4.c' || echo '$(srcdir)/'`generated/minloc1_4_r4.c
minloc1_8_r4.lo: generated/minloc1_8_r4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_r4.lo `test -f 'generated/minloc1_8_r4.c' || echo '$(srcdir)/'`generated/minloc1_8_r4.c
+minloc1_16_r4.lo: generated/minloc1_16_r4.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_r4.lo `test -f 'generated/minloc1_16_r4.c' || echo '$(srcdir)/'`generated/minloc1_16_r4.c
+
minloc1_4_r8.lo: generated/minloc1_4_r8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_r8.lo `test -f 'generated/minloc1_4_r8.c' || echo '$(srcdir)/'`generated/minloc1_4_r8.c
minloc1_8_r8.lo: generated/minloc1_8_r8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_r8.lo `test -f 'generated/minloc1_8_r8.c' || echo '$(srcdir)/'`generated/minloc1_8_r8.c
+minloc1_16_r8.lo: generated/minloc1_16_r8.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_r8.lo `test -f 'generated/minloc1_16_r8.c' || echo '$(srcdir)/'`generated/minloc1_16_r8.c
+
+minloc1_4_r10.lo: generated/minloc1_4_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_r10.lo `test -f 'generated/minloc1_4_r10.c' || echo '$(srcdir)/'`generated/minloc1_4_r10.c
+
+minloc1_8_r10.lo: generated/minloc1_8_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_r10.lo `test -f 'generated/minloc1_8_r10.c' || echo '$(srcdir)/'`generated/minloc1_8_r10.c
+
+minloc1_16_r10.lo: generated/minloc1_16_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_r10.lo `test -f 'generated/minloc1_16_r10.c' || echo '$(srcdir)/'`generated/minloc1_16_r10.c
+
+minloc1_4_r16.lo: generated/minloc1_4_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_r16.lo `test -f 'generated/minloc1_4_r16.c' || echo '$(srcdir)/'`generated/minloc1_4_r16.c
+
+minloc1_8_r16.lo: generated/minloc1_8_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_r16.lo `test -f 'generated/minloc1_8_r16.c' || echo '$(srcdir)/'`generated/minloc1_8_r16.c
+
+minloc1_16_r16.lo: generated/minloc1_16_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_r16.lo `test -f 'generated/minloc1_16_r16.c' || echo '$(srcdir)/'`generated/minloc1_16_r16.c
+
minval_i4.lo: generated/minval_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_i4.lo `test -f 'generated/minval_i4.c' || echo '$(srcdir)/'`generated/minval_i4.c
minval_i8.lo: generated/minval_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_i8.lo `test -f 'generated/minval_i8.c' || echo '$(srcdir)/'`generated/minval_i8.c
+minval_i16.lo: generated/minval_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_i16.lo `test -f 'generated/minval_i16.c' || echo '$(srcdir)/'`generated/minval_i16.c
+
minval_r4.lo: generated/minval_r4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_r4.lo `test -f 'generated/minval_r4.c' || echo '$(srcdir)/'`generated/minval_r4.c
minval_r8.lo: generated/minval_r8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_r8.lo `test -f 'generated/minval_r8.c' || echo '$(srcdir)/'`generated/minval_r8.c
+minval_r10.lo: generated/minval_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_r10.lo `test -f 'generated/minval_r10.c' || echo '$(srcdir)/'`generated/minval_r10.c
+
+minval_r16.lo: generated/minval_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_r16.lo `test -f 'generated/minval_r16.c' || echo '$(srcdir)/'`generated/minval_r16.c
+
product_i4.lo: generated/product_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_i4.lo `test -f 'generated/product_i4.c' || echo '$(srcdir)/'`generated/product_i4.c
product_i8.lo: generated/product_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_i8.lo `test -f 'generated/product_i8.c' || echo '$(srcdir)/'`generated/product_i8.c
+product_i16.lo: generated/product_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_i16.lo `test -f 'generated/product_i16.c' || echo '$(srcdir)/'`generated/product_i16.c
+
product_r4.lo: generated/product_r4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_r4.lo `test -f 'generated/product_r4.c' || echo '$(srcdir)/'`generated/product_r4.c
product_r8.lo: generated/product_r8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_r8.lo `test -f 'generated/product_r8.c' || echo '$(srcdir)/'`generated/product_r8.c
+product_r10.lo: generated/product_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_r10.lo `test -f 'generated/product_r10.c' || echo '$(srcdir)/'`generated/product_r10.c
+
+product_r16.lo: generated/product_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_r16.lo `test -f 'generated/product_r16.c' || echo '$(srcdir)/'`generated/product_r16.c
+
product_c4.lo: generated/product_c4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_c4.lo `test -f 'generated/product_c4.c' || echo '$(srcdir)/'`generated/product_c4.c
product_c8.lo: generated/product_c8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_c8.lo `test -f 'generated/product_c8.c' || echo '$(srcdir)/'`generated/product_c8.c
+product_c10.lo: generated/product_c10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_c10.lo `test -f 'generated/product_c10.c' || echo '$(srcdir)/'`generated/product_c10.c
+
+product_c16.lo: generated/product_c16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_c16.lo `test -f 'generated/product_c16.c' || echo '$(srcdir)/'`generated/product_c16.c
+
sum_i4.lo: generated/sum_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_i4.lo `test -f 'generated/sum_i4.c' || echo '$(srcdir)/'`generated/sum_i4.c
sum_i8.lo: generated/sum_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_i8.lo `test -f 'generated/sum_i8.c' || echo '$(srcdir)/'`generated/sum_i8.c
+sum_i16.lo: generated/sum_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_i16.lo `test -f 'generated/sum_i16.c' || echo '$(srcdir)/'`generated/sum_i16.c
+
sum_r4.lo: generated/sum_r4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_r4.lo `test -f 'generated/sum_r4.c' || echo '$(srcdir)/'`generated/sum_r4.c
sum_r8.lo: generated/sum_r8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_r8.lo `test -f 'generated/sum_r8.c' || echo '$(srcdir)/'`generated/sum_r8.c
+sum_r10.lo: generated/sum_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_r10.lo `test -f 'generated/sum_r10.c' || echo '$(srcdir)/'`generated/sum_r10.c
+
+sum_r16.lo: generated/sum_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_r16.lo `test -f 'generated/sum_r16.c' || echo '$(srcdir)/'`generated/sum_r16.c
+
sum_c4.lo: generated/sum_c4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_c4.lo `test -f 'generated/sum_c4.c' || echo '$(srcdir)/'`generated/sum_c4.c
sum_c8.lo: generated/sum_c8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_c8.lo `test -f 'generated/sum_c8.c' || echo '$(srcdir)/'`generated/sum_c8.c
+sum_c10.lo: generated/sum_c10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_c10.lo `test -f 'generated/sum_c10.c' || echo '$(srcdir)/'`generated/sum_c10.c
+
+sum_c16.lo: generated/sum_c16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_c16.lo `test -f 'generated/sum_c16.c' || echo '$(srcdir)/'`generated/sum_c16.c
+
dotprod_i4.lo: generated/dotprod_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_i4.lo `test -f 'generated/dotprod_i4.c' || echo '$(srcdir)/'`generated/dotprod_i4.c
dotprod_i8.lo: generated/dotprod_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_i8.lo `test -f 'generated/dotprod_i8.c' || echo '$(srcdir)/'`generated/dotprod_i8.c
+dotprod_i16.lo: generated/dotprod_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_i16.lo `test -f 'generated/dotprod_i16.c' || echo '$(srcdir)/'`generated/dotprod_i16.c
+
dotprod_r4.lo: generated/dotprod_r4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_r4.lo `test -f 'generated/dotprod_r4.c' || echo '$(srcdir)/'`generated/dotprod_r4.c
dotprod_r8.lo: generated/dotprod_r8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_r8.lo `test -f 'generated/dotprod_r8.c' || echo '$(srcdir)/'`generated/dotprod_r8.c
+dotprod_r10.lo: generated/dotprod_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_r10.lo `test -f 'generated/dotprod_r10.c' || echo '$(srcdir)/'`generated/dotprod_r10.c
+
+dotprod_r16.lo: generated/dotprod_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_r16.lo `test -f 'generated/dotprod_r16.c' || echo '$(srcdir)/'`generated/dotprod_r16.c
+
dotprod_l4.lo: generated/dotprod_l4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_l4.lo `test -f 'generated/dotprod_l4.c' || echo '$(srcdir)/'`generated/dotprod_l4.c
dotprod_l8.lo: generated/dotprod_l8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_l8.lo `test -f 'generated/dotprod_l8.c' || echo '$(srcdir)/'`generated/dotprod_l8.c
+dotprod_l16.lo: generated/dotprod_l16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_l16.lo `test -f 'generated/dotprod_l16.c' || echo '$(srcdir)/'`generated/dotprod_l16.c
+
dotprod_c4.lo: generated/dotprod_c4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_c4.lo `test -f 'generated/dotprod_c4.c' || echo '$(srcdir)/'`generated/dotprod_c4.c
dotprod_c8.lo: generated/dotprod_c8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_c8.lo `test -f 'generated/dotprod_c8.c' || echo '$(srcdir)/'`generated/dotprod_c8.c
+dotprod_c10.lo: generated/dotprod_c10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_c10.lo `test -f 'generated/dotprod_c10.c' || echo '$(srcdir)/'`generated/dotprod_c10.c
+
+dotprod_c16.lo: generated/dotprod_c16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_c16.lo `test -f 'generated/dotprod_c16.c' || echo '$(srcdir)/'`generated/dotprod_c16.c
+
matmul_i4.lo: generated/matmul_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_i4.lo `test -f 'generated/matmul_i4.c' || echo '$(srcdir)/'`generated/matmul_i4.c
matmul_i8.lo: generated/matmul_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_i8.lo `test -f 'generated/matmul_i8.c' || echo '$(srcdir)/'`generated/matmul_i8.c
+matmul_i16.lo: generated/matmul_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_i16.lo `test -f 'generated/matmul_i16.c' || echo '$(srcdir)/'`generated/matmul_i16.c
+
matmul_r4.lo: generated/matmul_r4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_r4.lo `test -f 'generated/matmul_r4.c' || echo '$(srcdir)/'`generated/matmul_r4.c
matmul_r8.lo: generated/matmul_r8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_r8.lo `test -f 'generated/matmul_r8.c' || echo '$(srcdir)/'`generated/matmul_r8.c
+matmul_r10.lo: generated/matmul_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_r10.lo `test -f 'generated/matmul_r10.c' || echo '$(srcdir)/'`generated/matmul_r10.c
+
+matmul_r16.lo: generated/matmul_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_r16.lo `test -f 'generated/matmul_r16.c' || echo '$(srcdir)/'`generated/matmul_r16.c
+
matmul_c4.lo: generated/matmul_c4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_c4.lo `test -f 'generated/matmul_c4.c' || echo '$(srcdir)/'`generated/matmul_c4.c
matmul_c8.lo: generated/matmul_c8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_c8.lo `test -f 'generated/matmul_c8.c' || echo '$(srcdir)/'`generated/matmul_c8.c
+matmul_c10.lo: generated/matmul_c10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_c10.lo `test -f 'generated/matmul_c10.c' || echo '$(srcdir)/'`generated/matmul_c10.c
+
+matmul_c16.lo: generated/matmul_c16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_c16.lo `test -f 'generated/matmul_c16.c' || echo '$(srcdir)/'`generated/matmul_c16.c
+
matmul_l4.lo: generated/matmul_l4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_l4.lo `test -f 'generated/matmul_l4.c' || echo '$(srcdir)/'`generated/matmul_l4.c
matmul_l8.lo: generated/matmul_l8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_l8.lo `test -f 'generated/matmul_l8.c' || echo '$(srcdir)/'`generated/matmul_l8.c
+matmul_l16.lo: generated/matmul_l16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_l16.lo `test -f 'generated/matmul_l16.c' || echo '$(srcdir)/'`generated/matmul_l16.c
+
transpose_i4.lo: generated/transpose_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_i4.lo `test -f 'generated/transpose_i4.c' || echo '$(srcdir)/'`generated/transpose_i4.c
transpose_i8.lo: generated/transpose_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_i8.lo `test -f 'generated/transpose_i8.c' || echo '$(srcdir)/'`generated/transpose_i8.c
+transpose_i16.lo: generated/transpose_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_i16.lo `test -f 'generated/transpose_i16.c' || echo '$(srcdir)/'`generated/transpose_i16.c
+
transpose_c4.lo: generated/transpose_c4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c4.lo `test -f 'generated/transpose_c4.c' || echo '$(srcdir)/'`generated/transpose_c4.c
transpose_c8.lo: generated/transpose_c8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c8.lo `test -f 'generated/transpose_c8.c' || echo '$(srcdir)/'`generated/transpose_c8.c
+transpose_c10.lo: generated/transpose_c10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c10.lo `test -f 'generated/transpose_c10.c' || echo '$(srcdir)/'`generated/transpose_c10.c
+
+transpose_c16.lo: generated/transpose_c16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c16.lo `test -f 'generated/transpose_c16.c' || echo '$(srcdir)/'`generated/transpose_c16.c
+
shape_i4.lo: generated/shape_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o shape_i4.lo `test -f 'generated/shape_i4.c' || echo '$(srcdir)/'`generated/shape_i4.c
shape_i8.lo: generated/shape_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o shape_i8.lo `test -f 'generated/shape_i8.c' || echo '$(srcdir)/'`generated/shape_i8.c
+shape_i16.lo: generated/shape_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o shape_i16.lo `test -f 'generated/shape_i16.c' || echo '$(srcdir)/'`generated/shape_i16.c
+
eoshift1_4.lo: generated/eoshift1_4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift1_4.lo `test -f 'generated/eoshift1_4.c' || echo '$(srcdir)/'`generated/eoshift1_4.c
eoshift1_8.lo: generated/eoshift1_8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift1_8.lo `test -f 'generated/eoshift1_8.c' || echo '$(srcdir)/'`generated/eoshift1_8.c
+eoshift1_16.lo: generated/eoshift1_16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift1_16.lo `test -f 'generated/eoshift1_16.c' || echo '$(srcdir)/'`generated/eoshift1_16.c
+
eoshift3_4.lo: generated/eoshift3_4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift3_4.lo `test -f 'generated/eoshift3_4.c' || echo '$(srcdir)/'`generated/eoshift3_4.c
eoshift3_8.lo: generated/eoshift3_8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift3_8.lo `test -f 'generated/eoshift3_8.c' || echo '$(srcdir)/'`generated/eoshift3_8.c
+eoshift3_16.lo: generated/eoshift3_16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift3_16.lo `test -f 'generated/eoshift3_16.c' || echo '$(srcdir)/'`generated/eoshift3_16.c
+
cshift1_4.lo: generated/cshift1_4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift1_4.lo `test -f 'generated/cshift1_4.c' || echo '$(srcdir)/'`generated/cshift1_4.c
cshift1_8.lo: generated/cshift1_8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift1_8.lo `test -f 'generated/cshift1_8.c' || echo '$(srcdir)/'`generated/cshift1_8.c
+cshift1_16.lo: generated/cshift1_16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift1_16.lo `test -f 'generated/cshift1_16.c' || echo '$(srcdir)/'`generated/cshift1_16.c
+
reshape_i4.lo: generated/reshape_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_i4.lo `test -f 'generated/reshape_i4.c' || echo '$(srcdir)/'`generated/reshape_i4.c
reshape_i8.lo: generated/reshape_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_i8.lo `test -f 'generated/reshape_i8.c' || echo '$(srcdir)/'`generated/reshape_i8.c
+reshape_i16.lo: generated/reshape_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_i16.lo `test -f 'generated/reshape_i16.c' || echo '$(srcdir)/'`generated/reshape_i16.c
+
reshape_c4.lo: generated/reshape_c4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c4.lo `test -f 'generated/reshape_c4.c' || echo '$(srcdir)/'`generated/reshape_c4.c
reshape_c8.lo: generated/reshape_c8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c8.lo `test -f 'generated/reshape_c8.c' || echo '$(srcdir)/'`generated/reshape_c8.c
+reshape_c10.lo: generated/reshape_c10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c10.lo `test -f 'generated/reshape_c10.c' || echo '$(srcdir)/'`generated/reshape_c10.c
+
+reshape_c16.lo: generated/reshape_c16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c16.lo `test -f 'generated/reshape_c16.c' || echo '$(srcdir)/'`generated/reshape_c16.c
+
in_pack_i4.lo: generated/in_pack_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i4.lo `test -f 'generated/in_pack_i4.c' || echo '$(srcdir)/'`generated/in_pack_i4.c
in_pack_i8.lo: generated/in_pack_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i8.lo `test -f 'generated/in_pack_i8.c' || echo '$(srcdir)/'`generated/in_pack_i8.c
+in_pack_i16.lo: generated/in_pack_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i16.lo `test -f 'generated/in_pack_i16.c' || echo '$(srcdir)/'`generated/in_pack_i16.c
+
in_pack_c4.lo: generated/in_pack_c4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c4.lo `test -f 'generated/in_pack_c4.c' || echo '$(srcdir)/'`generated/in_pack_c4.c
in_pack_c8.lo: generated/in_pack_c8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c8.lo `test -f 'generated/in_pack_c8.c' || echo '$(srcdir)/'`generated/in_pack_c8.c
+in_pack_c10.lo: generated/in_pack_c10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c10.lo `test -f 'generated/in_pack_c10.c' || echo '$(srcdir)/'`generated/in_pack_c10.c
+
+in_pack_c16.lo: generated/in_pack_c16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c16.lo `test -f 'generated/in_pack_c16.c' || echo '$(srcdir)/'`generated/in_pack_c16.c
+
in_unpack_i4.lo: generated/in_unpack_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i4.lo `test -f 'generated/in_unpack_i4.c' || echo '$(srcdir)/'`generated/in_unpack_i4.c
in_unpack_i8.lo: generated/in_unpack_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i8.lo `test -f 'generated/in_unpack_i8.c' || echo '$(srcdir)/'`generated/in_unpack_i8.c
+in_unpack_i16.lo: generated/in_unpack_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i16.lo `test -f 'generated/in_unpack_i16.c' || echo '$(srcdir)/'`generated/in_unpack_i16.c
+
in_unpack_c4.lo: generated/in_unpack_c4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c4.lo `test -f 'generated/in_unpack_c4.c' || echo '$(srcdir)/'`generated/in_unpack_c4.c
in_unpack_c8.lo: generated/in_unpack_c8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c8.lo `test -f 'generated/in_unpack_c8.c' || echo '$(srcdir)/'`generated/in_unpack_c8.c
+in_unpack_c10.lo: generated/in_unpack_c10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c10.lo `test -f 'generated/in_unpack_c10.c' || echo '$(srcdir)/'`generated/in_unpack_c10.c
+
+in_unpack_c16.lo: generated/in_unpack_c16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c16.lo `test -f 'generated/in_unpack_c16.c' || echo '$(srcdir)/'`generated/in_unpack_c16.c
+
exponent_r4.lo: generated/exponent_r4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exponent_r4.lo `test -f 'generated/exponent_r4.c' || echo '$(srcdir)/'`generated/exponent_r4.c
exponent_r8.lo: generated/exponent_r8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exponent_r8.lo `test -f 'generated/exponent_r8.c' || echo '$(srcdir)/'`generated/exponent_r8.c
+exponent_r10.lo: generated/exponent_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exponent_r10.lo `test -f 'generated/exponent_r10.c' || echo '$(srcdir)/'`generated/exponent_r10.c
+
+exponent_r16.lo: generated/exponent_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exponent_r16.lo `test -f 'generated/exponent_r16.c' || echo '$(srcdir)/'`generated/exponent_r16.c
+
fraction_r4.lo: generated/fraction_r4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fraction_r4.lo `test -f 'generated/fraction_r4.c' || echo '$(srcdir)/'`generated/fraction_r4.c
fraction_r8.lo: generated/fraction_r8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fraction_r8.lo `test -f 'generated/fraction_r8.c' || echo '$(srcdir)/'`generated/fraction_r8.c
+fraction_r10.lo: generated/fraction_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fraction_r10.lo `test -f 'generated/fraction_r10.c' || echo '$(srcdir)/'`generated/fraction_r10.c
+
+fraction_r16.lo: generated/fraction_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fraction_r16.lo `test -f 'generated/fraction_r16.c' || echo '$(srcdir)/'`generated/fraction_r16.c
+
nearest_r4.lo: generated/nearest_r4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o nearest_r4.lo `test -f 'generated/nearest_r4.c' || echo '$(srcdir)/'`generated/nearest_r4.c
nearest_r8.lo: generated/nearest_r8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o nearest_r8.lo `test -f 'generated/nearest_r8.c' || echo '$(srcdir)/'`generated/nearest_r8.c
+nearest_r10.lo: generated/nearest_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o nearest_r10.lo `test -f 'generated/nearest_r10.c' || echo '$(srcdir)/'`generated/nearest_r10.c
+
+nearest_r16.lo: generated/nearest_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o nearest_r16.lo `test -f 'generated/nearest_r16.c' || echo '$(srcdir)/'`generated/nearest_r16.c
+
set_exponent_r4.lo: generated/set_exponent_r4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o set_exponent_r4.lo `test -f 'generated/set_exponent_r4.c' || echo '$(srcdir)/'`generated/set_exponent_r4.c
set_exponent_r8.lo: generated/set_exponent_r8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o set_exponent_r8.lo `test -f 'generated/set_exponent_r8.c' || echo '$(srcdir)/'`generated/set_exponent_r8.c
+set_exponent_r10.lo: generated/set_exponent_r10.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o set_exponent_r10.lo `test -f 'generated/set_exponent_r10.c' || echo '$(srcdir)/'`generated/set_exponent_r10.c
+
+set_exponent_r16.lo: generated/set_exponent_r16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o set_exponent_r16.lo `test -f 'generated/set_exponent_r16.c' || echo '$(srcdir)/'`generated/set_exponent_r16.c
+
pow_i4_i4.lo: generated/pow_i4_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i4_i4.lo `test -f 'generated/pow_i4_i4.c' || echo '$(srcdir)/'`generated/pow_i4_i4.c
pow_i8_i4.lo: generated/pow_i8_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i8_i4.lo `test -f 'generated/pow_i8_i4.c' || echo '$(srcdir)/'`generated/pow_i8_i4.c
+pow_i16_i4.lo: generated/pow_i16_i4.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i16_i4.lo `test -f 'generated/pow_i16_i4.c' || echo '$(srcdir)/'`generated/pow_i16_i4.c
+
pow_r4_i4.lo: generated/pow_r4_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r4_i4.lo `test -f 'generated/pow_r4_i4.c' || echo '$(srcdir)/'`generated/pow_r4_i4.c
pow_r8_i4.lo: generated/pow_r8_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r8_i4.lo `test -f 'generated/pow_r8_i4.c' || echo '$(srcdir)/'`generated/pow_r8_i4.c
+pow_r10_i4.lo: generated/pow_r10_i4.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r10_i4.lo `test -f 'generated/pow_r10_i4.c' || echo '$(srcdir)/'`generated/pow_r10_i4.c
+
+pow_r16_i4.lo: generated/pow_r16_i4.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r16_i4.lo `test -f 'generated/pow_r16_i4.c' || echo '$(srcdir)/'`generated/pow_r16_i4.c
+
pow_c4_i4.lo: generated/pow_c4_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c4_i4.lo `test -f 'generated/pow_c4_i4.c' || echo '$(srcdir)/'`generated/pow_c4_i4.c
pow_c8_i4.lo: generated/pow_c8_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c8_i4.lo `test -f 'generated/pow_c8_i4.c' || echo '$(srcdir)/'`generated/pow_c8_i4.c
+pow_c10_i4.lo: generated/pow_c10_i4.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c10_i4.lo `test -f 'generated/pow_c10_i4.c' || echo '$(srcdir)/'`generated/pow_c10_i4.c
+
+pow_c16_i4.lo: generated/pow_c16_i4.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c16_i4.lo `test -f 'generated/pow_c16_i4.c' || echo '$(srcdir)/'`generated/pow_c16_i4.c
+
pow_i4_i8.lo: generated/pow_i4_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i4_i8.lo `test -f 'generated/pow_i4_i8.c' || echo '$(srcdir)/'`generated/pow_i4_i8.c
pow_i8_i8.lo: generated/pow_i8_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i8_i8.lo `test -f 'generated/pow_i8_i8.c' || echo '$(srcdir)/'`generated/pow_i8_i8.c
+pow_i16_i8.lo: generated/pow_i16_i8.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i16_i8.lo `test -f 'generated/pow_i16_i8.c' || echo '$(srcdir)/'`generated/pow_i16_i8.c
+
pow_r4_i8.lo: generated/pow_r4_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r4_i8.lo `test -f 'generated/pow_r4_i8.c' || echo '$(srcdir)/'`generated/pow_r4_i8.c
pow_r8_i8.lo: generated/pow_r8_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r8_i8.lo `test -f 'generated/pow_r8_i8.c' || echo '$(srcdir)/'`generated/pow_r8_i8.c
+pow_r10_i8.lo: generated/pow_r10_i8.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r10_i8.lo `test -f 'generated/pow_r10_i8.c' || echo '$(srcdir)/'`generated/pow_r10_i8.c
+
+pow_r16_i8.lo: generated/pow_r16_i8.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r16_i8.lo `test -f 'generated/pow_r16_i8.c' || echo '$(srcdir)/'`generated/pow_r16_i8.c
+
pow_c4_i8.lo: generated/pow_c4_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c4_i8.lo `test -f 'generated/pow_c4_i8.c' || echo '$(srcdir)/'`generated/pow_c4_i8.c
pow_c8_i8.lo: generated/pow_c8_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c8_i8.lo `test -f 'generated/pow_c8_i8.c' || echo '$(srcdir)/'`generated/pow_c8_i8.c
+pow_c10_i8.lo: generated/pow_c10_i8.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c10_i8.lo `test -f 'generated/pow_c10_i8.c' || echo '$(srcdir)/'`generated/pow_c10_i8.c
+
+pow_c16_i8.lo: generated/pow_c16_i8.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c16_i8.lo `test -f 'generated/pow_c16_i8.c' || echo '$(srcdir)/'`generated/pow_c16_i8.c
+
+pow_i4_i16.lo: generated/pow_i4_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i4_i16.lo `test -f 'generated/pow_i4_i16.c' || echo '$(srcdir)/'`generated/pow_i4_i16.c
+
+pow_i8_i16.lo: generated/pow_i8_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i8_i16.lo `test -f 'generated/pow_i8_i16.c' || echo '$(srcdir)/'`generated/pow_i8_i16.c
+
+pow_i16_i16.lo: generated/pow_i16_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i16_i16.lo `test -f 'generated/pow_i16_i16.c' || echo '$(srcdir)/'`generated/pow_i16_i16.c
+
+pow_r4_i16.lo: generated/pow_r4_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r4_i16.lo `test -f 'generated/pow_r4_i16.c' || echo '$(srcdir)/'`generated/pow_r4_i16.c
+
+pow_r8_i16.lo: generated/pow_r8_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r8_i16.lo `test -f 'generated/pow_r8_i16.c' || echo '$(srcdir)/'`generated/pow_r8_i16.c
+
+pow_r10_i16.lo: generated/pow_r10_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r10_i16.lo `test -f 'generated/pow_r10_i16.c' || echo '$(srcdir)/'`generated/pow_r10_i16.c
+
+pow_r16_i16.lo: generated/pow_r16_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r16_i16.lo `test -f 'generated/pow_r16_i16.c' || echo '$(srcdir)/'`generated/pow_r16_i16.c
+
+pow_c4_i16.lo: generated/pow_c4_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c4_i16.lo `test -f 'generated/pow_c4_i16.c' || echo '$(srcdir)/'`generated/pow_c4_i16.c
+
+pow_c8_i16.lo: generated/pow_c8_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c8_i16.lo `test -f 'generated/pow_c8_i16.c' || echo '$(srcdir)/'`generated/pow_c8_i16.c
+
+pow_c10_i16.lo: generated/pow_c10_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c10_i16.lo `test -f 'generated/pow_c10_i16.c' || echo '$(srcdir)/'`generated/pow_c10_i16.c
+
+pow_c16_i16.lo: generated/pow_c16_i16.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c16_i16.lo `test -f 'generated/pow_c16_i16.c' || echo '$(srcdir)/'`generated/pow_c16_i16.c
+
close.lo: io/close.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o close.lo `test -f 'io/close.c' || echo '$(srcdir)/'`io/close.c
selected_real_kind.lo: intrinsics/selected_real_kind.f90
$(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o selected_real_kind.lo `test -f 'intrinsics/selected_real_kind.f90' || echo '$(srcdir)/'`intrinsics/selected_real_kind.f90
-_abs_c4.lo: generated/_abs_c4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c4.lo `test -f 'generated/_abs_c4.f90' || echo '$(srcdir)/'`generated/_abs_c4.f90
-
-_abs_c8.lo: generated/_abs_c8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c8.lo `test -f 'generated/_abs_c8.f90' || echo '$(srcdir)/'`generated/_abs_c8.f90
-
-_abs_i4.lo: generated/_abs_i4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_i4.lo `test -f 'generated/_abs_i4.f90' || echo '$(srcdir)/'`generated/_abs_i4.f90
-
-_abs_i8.lo: generated/_abs_i8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_i8.lo `test -f 'generated/_abs_i8.f90' || echo '$(srcdir)/'`generated/_abs_i8.f90
-
-_abs_r4.lo: generated/_abs_r4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r4.lo `test -f 'generated/_abs_r4.f90' || echo '$(srcdir)/'`generated/_abs_r4.f90
-
-_abs_r8.lo: generated/_abs_r8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r8.lo `test -f 'generated/_abs_r8.f90' || echo '$(srcdir)/'`generated/_abs_r8.f90
-
-_exp_r4.lo: generated/_exp_r4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r4.lo `test -f 'generated/_exp_r4.f90' || echo '$(srcdir)/'`generated/_exp_r4.f90
-
-_exp_r8.lo: generated/_exp_r8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r8.lo `test -f 'generated/_exp_r8.f90' || echo '$(srcdir)/'`generated/_exp_r8.f90
-
-_exp_c4.lo: generated/_exp_c4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c4.lo `test -f 'generated/_exp_c4.f90' || echo '$(srcdir)/'`generated/_exp_c4.f90
-
-_exp_c8.lo: generated/_exp_c8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c8.lo `test -f 'generated/_exp_c8.f90' || echo '$(srcdir)/'`generated/_exp_c8.f90
-
-_log_r4.lo: generated/_log_r4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r4.lo `test -f 'generated/_log_r4.f90' || echo '$(srcdir)/'`generated/_log_r4.f90
-
-_log_r8.lo: generated/_log_r8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r8.lo `test -f 'generated/_log_r8.f90' || echo '$(srcdir)/'`generated/_log_r8.f90
-
-_log_c4.lo: generated/_log_c4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c4.lo `test -f 'generated/_log_c4.f90' || echo '$(srcdir)/'`generated/_log_c4.f90
-
-_log_c8.lo: generated/_log_c8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c8.lo `test -f 'generated/_log_c8.f90' || echo '$(srcdir)/'`generated/_log_c8.f90
-
-_log10_r4.lo: generated/_log10_r4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r4.lo `test -f 'generated/_log10_r4.f90' || echo '$(srcdir)/'`generated/_log10_r4.f90
-
-_log10_r8.lo: generated/_log10_r8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r8.lo `test -f 'generated/_log10_r8.f90' || echo '$(srcdir)/'`generated/_log10_r8.f90
-
-_sqrt_r4.lo: generated/_sqrt_r4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r4.lo `test -f 'generated/_sqrt_r4.f90' || echo '$(srcdir)/'`generated/_sqrt_r4.f90
-
-_sqrt_r8.lo: generated/_sqrt_r8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r8.lo `test -f 'generated/_sqrt_r8.f90' || echo '$(srcdir)/'`generated/_sqrt_r8.f90
-
-_sqrt_c4.lo: generated/_sqrt_c4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c4.lo `test -f 'generated/_sqrt_c4.f90' || echo '$(srcdir)/'`generated/_sqrt_c4.f90
-
-_sqrt_c8.lo: generated/_sqrt_c8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c8.lo `test -f 'generated/_sqrt_c8.f90' || echo '$(srcdir)/'`generated/_sqrt_c8.f90
-
-_asin_r4.lo: generated/_asin_r4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r4.lo `test -f 'generated/_asin_r4.f90' || echo '$(srcdir)/'`generated/_asin_r4.f90
-
-_asin_r8.lo: generated/_asin_r8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r8.lo `test -f 'generated/_asin_r8.f90' || echo '$(srcdir)/'`generated/_asin_r8.f90
-
-_acos_r4.lo: generated/_acos_r4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r4.lo `test -f 'generated/_acos_r4.f90' || echo '$(srcdir)/'`generated/_acos_r4.f90
-
-_acos_r8.lo: generated/_acos_r8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r8.lo `test -f 'generated/_acos_r8.f90' || echo '$(srcdir)/'`generated/_acos_r8.f90
-
-_atan_r4.lo: generated/_atan_r4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r4.lo `test -f 'generated/_atan_r4.f90' || echo '$(srcdir)/'`generated/_atan_r4.f90
-
-_atan_r8.lo: generated/_atan_r8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r8.lo `test -f 'generated/_atan_r8.f90' || echo '$(srcdir)/'`generated/_atan_r8.f90
-
-_sin_r4.lo: generated/_sin_r4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r4.lo `test -f 'generated/_sin_r4.f90' || echo '$(srcdir)/'`generated/_sin_r4.f90
-
-_sin_r8.lo: generated/_sin_r8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r8.lo `test -f 'generated/_sin_r8.f90' || echo '$(srcdir)/'`generated/_sin_r8.f90
-
-_sin_c4.lo: generated/_sin_c4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c4.lo `test -f 'generated/_sin_c4.f90' || echo '$(srcdir)/'`generated/_sin_c4.f90
-
-_sin_c8.lo: generated/_sin_c8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c8.lo `test -f 'generated/_sin_c8.f90' || echo '$(srcdir)/'`generated/_sin_c8.f90
-
-_cos_r4.lo: generated/_cos_r4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r4.lo `test -f 'generated/_cos_r4.f90' || echo '$(srcdir)/'`generated/_cos_r4.f90
-
-_cos_r8.lo: generated/_cos_r8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r8.lo `test -f 'generated/_cos_r8.f90' || echo '$(srcdir)/'`generated/_cos_r8.f90
-
-_cos_c4.lo: generated/_cos_c4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c4.lo `test -f 'generated/_cos_c4.f90' || echo '$(srcdir)/'`generated/_cos_c4.f90
-
-_cos_c8.lo: generated/_cos_c8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c8.lo `test -f 'generated/_cos_c8.f90' || echo '$(srcdir)/'`generated/_cos_c8.f90
-
-_tan_r4.lo: generated/_tan_r4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r4.lo `test -f 'generated/_tan_r4.f90' || echo '$(srcdir)/'`generated/_tan_r4.f90
-
-_tan_r8.lo: generated/_tan_r8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r8.lo `test -f 'generated/_tan_r8.f90' || echo '$(srcdir)/'`generated/_tan_r8.f90
-
-_sinh_r4.lo: generated/_sinh_r4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r4.lo `test -f 'generated/_sinh_r4.f90' || echo '$(srcdir)/'`generated/_sinh_r4.f90
-
-_sinh_r8.lo: generated/_sinh_r8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r8.lo `test -f 'generated/_sinh_r8.f90' || echo '$(srcdir)/'`generated/_sinh_r8.f90
-
-_cosh_r4.lo: generated/_cosh_r4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r4.lo `test -f 'generated/_cosh_r4.f90' || echo '$(srcdir)/'`generated/_cosh_r4.f90
-
-_cosh_r8.lo: generated/_cosh_r8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r8.lo `test -f 'generated/_cosh_r8.f90' || echo '$(srcdir)/'`generated/_cosh_r8.f90
-
-_tanh_r4.lo: generated/_tanh_r4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r4.lo `test -f 'generated/_tanh_r4.f90' || echo '$(srcdir)/'`generated/_tanh_r4.f90
-
-_tanh_r8.lo: generated/_tanh_r8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r8.lo `test -f 'generated/_tanh_r8.f90' || echo '$(srcdir)/'`generated/_tanh_r8.f90
-
-_conjg_c4.lo: generated/_conjg_c4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c4.lo `test -f 'generated/_conjg_c4.f90' || echo '$(srcdir)/'`generated/_conjg_c4.f90
-
-_conjg_c8.lo: generated/_conjg_c8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c8.lo `test -f 'generated/_conjg_c8.f90' || echo '$(srcdir)/'`generated/_conjg_c8.f90
-
-_aint_r4.lo: generated/_aint_r4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r4.lo `test -f 'generated/_aint_r4.f90' || echo '$(srcdir)/'`generated/_aint_r4.f90
-
-_aint_r8.lo: generated/_aint_r8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r8.lo `test -f 'generated/_aint_r8.f90' || echo '$(srcdir)/'`generated/_aint_r8.f90
-
-_anint_r4.lo: generated/_anint_r4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r4.lo `test -f 'generated/_anint_r4.f90' || echo '$(srcdir)/'`generated/_anint_r4.f90
-
-_anint_r8.lo: generated/_anint_r8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r8.lo `test -f 'generated/_anint_r8.f90' || echo '$(srcdir)/'`generated/_anint_r8.f90
-
-_sign_i4.lo: generated/_sign_i4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_i4.lo `test -f 'generated/_sign_i4.f90' || echo '$(srcdir)/'`generated/_sign_i4.f90
-
-_sign_i8.lo: generated/_sign_i8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_i8.lo `test -f 'generated/_sign_i8.f90' || echo '$(srcdir)/'`generated/_sign_i8.f90
-
-_sign_r4.lo: generated/_sign_r4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r4.lo `test -f 'generated/_sign_r4.f90' || echo '$(srcdir)/'`generated/_sign_r4.f90
-
-_sign_r8.lo: generated/_sign_r8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r8.lo `test -f 'generated/_sign_r8.f90' || echo '$(srcdir)/'`generated/_sign_r8.f90
-
-_dim_i4.lo: generated/_dim_i4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_i4.lo `test -f 'generated/_dim_i4.f90' || echo '$(srcdir)/'`generated/_dim_i4.f90
-
-_dim_i8.lo: generated/_dim_i8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_i8.lo `test -f 'generated/_dim_i8.f90' || echo '$(srcdir)/'`generated/_dim_i8.f90
-
-_dim_r4.lo: generated/_dim_r4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r4.lo `test -f 'generated/_dim_r4.f90' || echo '$(srcdir)/'`generated/_dim_r4.f90
-
-_dim_r8.lo: generated/_dim_r8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r8.lo `test -f 'generated/_dim_r8.f90' || echo '$(srcdir)/'`generated/_dim_r8.f90
-
-_atan2_r4.lo: generated/_atan2_r4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r4.lo `test -f 'generated/_atan2_r4.f90' || echo '$(srcdir)/'`generated/_atan2_r4.f90
-
-_atan2_r8.lo: generated/_atan2_r8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r8.lo `test -f 'generated/_atan2_r8.f90' || echo '$(srcdir)/'`generated/_atan2_r8.f90
-
-_mod_i4.lo: generated/_mod_i4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_i4.lo `test -f 'generated/_mod_i4.f90' || echo '$(srcdir)/'`generated/_mod_i4.f90
-
-_mod_i8.lo: generated/_mod_i8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_i8.lo `test -f 'generated/_mod_i8.f90' || echo '$(srcdir)/'`generated/_mod_i8.f90
-
-_mod_r4.lo: generated/_mod_r4.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_r4.lo `test -f 'generated/_mod_r4.f90' || echo '$(srcdir)/'`generated/_mod_r4.f90
-
-_mod_r8.lo: generated/_mod_r8.f90
- $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_r8.lo `test -f 'generated/_mod_r8.f90' || echo '$(srcdir)/'`generated/_mod_r8.f90
-
dprod_r8.lo: intrinsics/dprod_r8.f90
$(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o dprod_r8.lo `test -f 'intrinsics/dprod_r8.f90' || echo '$(srcdir)/'`intrinsics/dprod_r8.f90
kinds.h: $(srcdir)/mk-kinds-h.sh
$(SHELL) $(srcdir)/mk-kinds-h.sh '$(FCCOMPILE)' > $@
+kinds.inc: kinds.h
+ grep '^#' < kinds.h > $@
+
+c99_protos.inc: $(srcdir)/c99_protos.h
+ grep '^#' < $(srcdir)/c99_protos.h > $@
+
selected_int_kind.inc: $(srcdir)/mk-sik-inc.sh
$(SHELL) $(srcdir)/mk-sik-inc.sh '$(FCCOMPILE)' > $@
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+#ifdef HAVE_CABSL
+
+elemental function specific__abs_c10 (parm)
+ complex (kind=10), intent (in) :: parm
+ complex (kind=10) :: specific__abs_c10
+
+ specific__abs_c10 = abs (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+#ifdef HAVE_CABSL
+
+elemental function specific__abs_c16 (parm)
+ complex (kind=16), intent (in) :: parm
+ complex (kind=16) :: specific__abs_c16
+
+ specific__abs_c16 = abs (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_4)
+#ifdef HAVE_CABSF
+
elemental function specific__abs_c4 (parm)
complex (kind=4), intent (in) :: parm
complex (kind=4) :: specific__abs_c4
specific__abs_c4 = abs (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_8)
+#ifdef HAVE_CABS
+
elemental function specific__abs_c8 (parm)
complex (kind=8), intent (in) :: parm
complex (kind=8) :: specific__abs_c8
specific__abs_c8 = abs (parm)
end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+
+elemental function specific__abs_i16 (parm)
+ integer (kind=16), intent (in) :: parm
+ integer (kind=16) :: specific__abs_i16
+
+ specific__abs_i16 = abs (parm)
+end function
+
+
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_4)
+
+
elemental function specific__abs_i4 (parm)
integer (kind=4), intent (in) :: parm
integer (kind=4) :: specific__abs_i4
specific__abs_i4 = abs (parm)
end function
+
+
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_8)
+
+
elemental function specific__abs_i8 (parm)
integer (kind=8), intent (in) :: parm
integer (kind=8) :: specific__abs_i8
specific__abs_i8 = abs (parm)
end function
+
+
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_FABSL
+
+elemental function specific__abs_r10 (parm)
+ real (kind=10), intent (in) :: parm
+ real (kind=10) :: specific__abs_r10
+
+ specific__abs_r10 = abs (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_FABSL
+
+elemental function specific__abs_r16 (parm)
+ real (kind=16), intent (in) :: parm
+ real (kind=16) :: specific__abs_r16
+
+ specific__abs_r16 = abs (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_FABSF
+
elemental function specific__abs_r4 (parm)
real (kind=4), intent (in) :: parm
real (kind=4) :: specific__abs_r4
specific__abs_r4 = abs (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_FABS
+
elemental function specific__abs_r8 (parm)
real (kind=8), intent (in) :: parm
real (kind=8) :: specific__abs_r8
specific__abs_r8 = abs (parm)
end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_ACOSL
+
+elemental function specific__acos_r10 (parm)
+ real (kind=10), intent (in) :: parm
+ real (kind=10) :: specific__acos_r10
+
+ specific__acos_r10 = acos (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_ACOSL
+
+elemental function specific__acos_r16 (parm)
+ real (kind=16), intent (in) :: parm
+ real (kind=16) :: specific__acos_r16
+
+ specific__acos_r16 = acos (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_ACOSF
+
elemental function specific__acos_r4 (parm)
real (kind=4), intent (in) :: parm
real (kind=4) :: specific__acos_r4
specific__acos_r4 = acos (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_ACOS
+
elemental function specific__acos_r8 (parm)
real (kind=8), intent (in) :: parm
real (kind=8) :: specific__acos_r8
specific__acos_r8 = acos (parm)
end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_TRUNCL
+
+elemental function specific__aint_r10 (parm)
+ real (kind=10), intent (in) :: parm
+ real (kind=10) :: specific__aint_r10
+
+ specific__aint_r10 = aint (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_TRUNCL
+
+elemental function specific__aint_r16 (parm)
+ real (kind=16), intent (in) :: parm
+ real (kind=16) :: specific__aint_r16
+
+ specific__aint_r16 = aint (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_TRUNCF
+
elemental function specific__aint_r4 (parm)
real (kind=4), intent (in) :: parm
real (kind=4) :: specific__aint_r4
specific__aint_r4 = aint (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_TRUNC
+
elemental function specific__aint_r8 (parm)
real (kind=8), intent (in) :: parm
real (kind=8) :: specific__aint_r8
specific__aint_r8 = aint (parm)
end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_ROUNDL
+
+elemental function specific__anint_r10 (parm)
+ real (kind=10), intent (in) :: parm
+ real (kind=10) :: specific__anint_r10
+
+ specific__anint_r10 = anint (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_ROUNDL
+
+elemental function specific__anint_r16 (parm)
+ real (kind=16), intent (in) :: parm
+ real (kind=16) :: specific__anint_r16
+
+ specific__anint_r16 = anint (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_ROUNDF
+
elemental function specific__anint_r4 (parm)
real (kind=4), intent (in) :: parm
real (kind=4) :: specific__anint_r4
specific__anint_r4 = anint (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_ROUND
+
elemental function specific__anint_r8 (parm)
real (kind=8), intent (in) :: parm
real (kind=8) :: specific__anint_r8
specific__anint_r8 = anint (parm)
end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_ASINL
+
+elemental function specific__asin_r10 (parm)
+ real (kind=10), intent (in) :: parm
+ real (kind=10) :: specific__asin_r10
+
+ specific__asin_r10 = asin (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_ASINL
+
+elemental function specific__asin_r16 (parm)
+ real (kind=16), intent (in) :: parm
+ real (kind=16) :: specific__asin_r16
+
+ specific__asin_r16 = asin (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_ASINF
+
elemental function specific__asin_r4 (parm)
real (kind=4), intent (in) :: parm
real (kind=4) :: specific__asin_r4
specific__asin_r4 = asin (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_ASIN
+
elemental function specific__asin_r8 (parm)
real (kind=8), intent (in) :: parm
real (kind=8) :: specific__asin_r8
specific__asin_r8 = asin (parm)
end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+
+#ifdef HAVE_ATAN2L
+
+elemental function specific__atan2_r10 (p1, p2)
+ real (kind=10), intent (in) :: p1, p2
+ real (kind=10) :: specific__atan2_r10
+
+ specific__atan2_r10 = atan2 (p1, p2)
+end function
+
+#endif
+
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+
+#ifdef HAVE_ATAN2L
+
+elemental function specific__atan2_r16 (p1, p2)
+ real (kind=16), intent (in) :: p1, p2
+ real (kind=16) :: specific__atan2_r16
+
+ specific__atan2_r16 = atan2 (p1, p2)
+end function
+
+#endif
+
+#endif
!This file is machine generated.
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+
+#ifdef HAVE_ATAN2F
+
elemental function specific__atan2_r4 (p1, p2)
real (kind=4), intent (in) :: p1, p2
real (kind=4) :: specific__atan2_r4
specific__atan2_r4 = atan2 (p1, p2)
end function
+
+#endif
+
+#endif
!This file is machine generated.
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+
+#ifdef HAVE_ATAN2
+
elemental function specific__atan2_r8 (p1, p2)
real (kind=8), intent (in) :: p1, p2
real (kind=8) :: specific__atan2_r8
specific__atan2_r8 = atan2 (p1, p2)
end function
+
+#endif
+
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_ATANL
+
+elemental function specific__atan_r10 (parm)
+ real (kind=10), intent (in) :: parm
+ real (kind=10) :: specific__atan_r10
+
+ specific__atan_r10 = atan (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_ATANL
+
+elemental function specific__atan_r16 (parm)
+ real (kind=16), intent (in) :: parm
+ real (kind=16) :: specific__atan_r16
+
+ specific__atan_r16 = atan (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_ATANF
+
elemental function specific__atan_r4 (parm)
real (kind=4), intent (in) :: parm
real (kind=4) :: specific__atan_r4
specific__atan_r4 = atan (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_ATAN
+
elemental function specific__atan_r8 (parm)
real (kind=8), intent (in) :: parm
real (kind=8) :: specific__atan_r8
specific__atan_r8 = atan (parm)
end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+
+
+elemental function specific__conjg_c10 (parm)
+ complex (kind=10), intent (in) :: parm
+ complex (kind=10) :: specific__conjg_c10
+
+ specific__conjg_c10 = conjg (parm)
+end function
+
+
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+
+
+elemental function specific__conjg_c16 (parm)
+ complex (kind=16), intent (in) :: parm
+ complex (kind=16) :: specific__conjg_c16
+
+ specific__conjg_c16 = conjg (parm)
+end function
+
+
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_4)
+
+
elemental function specific__conjg_c4 (parm)
complex (kind=4), intent (in) :: parm
complex (kind=4) :: specific__conjg_c4
specific__conjg_c4 = conjg (parm)
end function
+
+
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_8)
+
+
elemental function specific__conjg_c8 (parm)
complex (kind=8), intent (in) :: parm
complex (kind=8) :: specific__conjg_c8
specific__conjg_c8 = conjg (parm)
end function
+
+
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+#ifdef HAVE_CCOSL
+
+elemental function specific__cos_c10 (parm)
+ complex (kind=10), intent (in) :: parm
+ complex (kind=10) :: specific__cos_c10
+
+ specific__cos_c10 = cos (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+#ifdef HAVE_CCOSL
+
+elemental function specific__cos_c16 (parm)
+ complex (kind=16), intent (in) :: parm
+ complex (kind=16) :: specific__cos_c16
+
+ specific__cos_c16 = cos (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_4)
+#ifdef HAVE_CCOSF
+
elemental function specific__cos_c4 (parm)
complex (kind=4), intent (in) :: parm
complex (kind=4) :: specific__cos_c4
specific__cos_c4 = cos (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_8)
+#ifdef HAVE_CCOS
+
elemental function specific__cos_c8 (parm)
complex (kind=8), intent (in) :: parm
complex (kind=8) :: specific__cos_c8
specific__cos_c8 = cos (parm)
end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_COSL
+
+elemental function specific__cos_r10 (parm)
+ real (kind=10), intent (in) :: parm
+ real (kind=10) :: specific__cos_r10
+
+ specific__cos_r10 = cos (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_COSL
+
+elemental function specific__cos_r16 (parm)
+ real (kind=16), intent (in) :: parm
+ real (kind=16) :: specific__cos_r16
+
+ specific__cos_r16 = cos (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_COSF
+
elemental function specific__cos_r4 (parm)
real (kind=4), intent (in) :: parm
real (kind=4) :: specific__cos_r4
specific__cos_r4 = cos (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_COS
+
elemental function specific__cos_r8 (parm)
real (kind=8), intent (in) :: parm
real (kind=8) :: specific__cos_r8
specific__cos_r8 = cos (parm)
end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_COSHL
+
+elemental function specific__cosh_r10 (parm)
+ real (kind=10), intent (in) :: parm
+ real (kind=10) :: specific__cosh_r10
+
+ specific__cosh_r10 = cosh (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_COSHL
+
+elemental function specific__cosh_r16 (parm)
+ real (kind=16), intent (in) :: parm
+ real (kind=16) :: specific__cosh_r16
+
+ specific__cosh_r16 = cosh (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_COSHF
+
elemental function specific__cosh_r4 (parm)
real (kind=4), intent (in) :: parm
real (kind=4) :: specific__cosh_r4
specific__cosh_r4 = cosh (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_COSH
+
elemental function specific__cosh_r8 (parm)
real (kind=8), intent (in) :: parm
real (kind=8) :: specific__cosh_r8
specific__cosh_r8 = cosh (parm)
end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+
+
+elemental function specific__dim_i16 (p1, p2)
+ integer (kind=16), intent (in) :: p1, p2
+ integer (kind=16) :: specific__dim_i16
+
+ specific__dim_i16 = dim (p1, p2)
+end function
+
+
+
+#endif
!This file is machine generated.
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_4)
+
+
+
elemental function specific__dim_i4 (p1, p2)
integer (kind=4), intent (in) :: p1, p2
integer (kind=4) :: specific__dim_i4
specific__dim_i4 = dim (p1, p2)
end function
+
+
+
+#endif
!This file is machine generated.
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_8)
+
+
+
elemental function specific__dim_i8 (p1, p2)
integer (kind=8), intent (in) :: p1, p2
integer (kind=8) :: specific__dim_i8
specific__dim_i8 = dim (p1, p2)
end function
+
+
+
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+
+
+
+elemental function specific__dim_r10 (p1, p2)
+ real (kind=10), intent (in) :: p1, p2
+ real (kind=10) :: specific__dim_r10
+
+ specific__dim_r10 = dim (p1, p2)
+end function
+
+
+
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+
+
+
+elemental function specific__dim_r16 (p1, p2)
+ real (kind=16), intent (in) :: p1, p2
+ real (kind=16) :: specific__dim_r16
+
+ specific__dim_r16 = dim (p1, p2)
+end function
+
+
+
+#endif
!This file is machine generated.
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+
+
+
elemental function specific__dim_r4 (p1, p2)
real (kind=4), intent (in) :: p1, p2
real (kind=4) :: specific__dim_r4
specific__dim_r4 = dim (p1, p2)
end function
+
+
+
+#endif
!This file is machine generated.
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+
+
+
elemental function specific__dim_r8 (p1, p2)
real (kind=8), intent (in) :: p1, p2
real (kind=8) :: specific__dim_r8
specific__dim_r8 = dim (p1, p2)
end function
+
+
+
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+#ifdef HAVE_CEXPL
+
+elemental function specific__exp_c10 (parm)
+ complex (kind=10), intent (in) :: parm
+ complex (kind=10) :: specific__exp_c10
+
+ specific__exp_c10 = exp (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+#ifdef HAVE_CEXPL
+
+elemental function specific__exp_c16 (parm)
+ complex (kind=16), intent (in) :: parm
+ complex (kind=16) :: specific__exp_c16
+
+ specific__exp_c16 = exp (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_4)
+#ifdef HAVE_CEXPF
+
elemental function specific__exp_c4 (parm)
complex (kind=4), intent (in) :: parm
complex (kind=4) :: specific__exp_c4
specific__exp_c4 = exp (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_8)
+#ifdef HAVE_CEXP
+
elemental function specific__exp_c8 (parm)
complex (kind=8), intent (in) :: parm
complex (kind=8) :: specific__exp_c8
specific__exp_c8 = exp (parm)
end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_EXPL
+
+elemental function specific__exp_r10 (parm)
+ real (kind=10), intent (in) :: parm
+ real (kind=10) :: specific__exp_r10
+
+ specific__exp_r10 = exp (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_EXPL
+
+elemental function specific__exp_r16 (parm)
+ real (kind=16), intent (in) :: parm
+ real (kind=16) :: specific__exp_r16
+
+ specific__exp_r16 = exp (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_EXPF
+
elemental function specific__exp_r4 (parm)
real (kind=4), intent (in) :: parm
real (kind=4) :: specific__exp_r4
specific__exp_r4 = exp (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_EXP
+
elemental function specific__exp_r8 (parm)
real (kind=8), intent (in) :: parm
real (kind=8) :: specific__exp_r8
specific__exp_r8 = exp (parm)
end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_LOG10L
+
+elemental function specific__log10_r10 (parm)
+ real (kind=10), intent (in) :: parm
+ real (kind=10) :: specific__log10_r10
+
+ specific__log10_r10 = log10 (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_LOG10L
+
+elemental function specific__log10_r16 (parm)
+ real (kind=16), intent (in) :: parm
+ real (kind=16) :: specific__log10_r16
+
+ specific__log10_r16 = log10 (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_LOG10F
+
elemental function specific__log10_r4 (parm)
real (kind=4), intent (in) :: parm
real (kind=4) :: specific__log10_r4
specific__log10_r4 = log10 (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_LOG10
+
elemental function specific__log10_r8 (parm)
real (kind=8), intent (in) :: parm
real (kind=8) :: specific__log10_r8
specific__log10_r8 = log10 (parm)
end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+#ifdef HAVE_CLOGL
+
+elemental function specific__log_c10 (parm)
+ complex (kind=10), intent (in) :: parm
+ complex (kind=10) :: specific__log_c10
+
+ specific__log_c10 = log (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+#ifdef HAVE_CLOGL
+
+elemental function specific__log_c16 (parm)
+ complex (kind=16), intent (in) :: parm
+ complex (kind=16) :: specific__log_c16
+
+ specific__log_c16 = log (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_4)
+#ifdef HAVE_CLOGF
+
elemental function specific__log_c4 (parm)
complex (kind=4), intent (in) :: parm
complex (kind=4) :: specific__log_c4
specific__log_c4 = log (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_8)
+#ifdef HAVE_CLOG
+
elemental function specific__log_c8 (parm)
complex (kind=8), intent (in) :: parm
complex (kind=8) :: specific__log_c8
specific__log_c8 = log (parm)
end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_LOGL
+
+elemental function specific__log_r10 (parm)
+ real (kind=10), intent (in) :: parm
+ real (kind=10) :: specific__log_r10
+
+ specific__log_r10 = log (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_LOGL
+
+elemental function specific__log_r16 (parm)
+ real (kind=16), intent (in) :: parm
+ real (kind=16) :: specific__log_r16
+
+ specific__log_r16 = log (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_LOGF
+
elemental function specific__log_r4 (parm)
real (kind=4), intent (in) :: parm
real (kind=4) :: specific__log_r4
specific__log_r4 = log (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_LOG
+
elemental function specific__log_r8 (parm)
real (kind=8), intent (in) :: parm
real (kind=8) :: specific__log_r8
specific__log_r8 = log (parm)
end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+
+
+elemental function specific__mod_i16 (p1, p2)
+ integer (kind=16), intent (in) :: p1, p2
+ integer (kind=16) :: specific__mod_i16
+
+ specific__mod_i16 = mod (p1, p2)
+end function
+
+
+
+#endif
!This file is machine generated.
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_4)
+
+
+
elemental function specific__mod_i4 (p1, p2)
integer (kind=4), intent (in) :: p1, p2
integer (kind=4) :: specific__mod_i4
specific__mod_i4 = mod (p1, p2)
end function
+
+
+
+#endif
!This file is machine generated.
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_8)
+
+
+
elemental function specific__mod_i8 (p1, p2)
integer (kind=8), intent (in) :: p1, p2
integer (kind=8) :: specific__mod_i8
specific__mod_i8 = mod (p1, p2)
end function
+
+
+
+#endif
!This file is machine generated.
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+
+
+
elemental function specific__mod_r4 (p1, p2)
real (kind=4), intent (in) :: p1, p2
real (kind=4) :: specific__mod_r4
specific__mod_r4 = mod (p1, p2)
end function
+
+
+
+#endif
!This file is machine generated.
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+
+
+
elemental function specific__mod_r8 (p1, p2)
real (kind=8), intent (in) :: p1, p2
real (kind=8) :: specific__mod_r8
specific__mod_r8 = mod (p1, p2)
end function
+
+
+
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+
+
+elemental function specific__sign_i16 (p1, p2)
+ integer (kind=16), intent (in) :: p1, p2
+ integer (kind=16) :: specific__sign_i16
+
+ specific__sign_i16 = sign (p1, p2)
+end function
+
+
+
+#endif
!This file is machine generated.
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_4)
+
+
+
elemental function specific__sign_i4 (p1, p2)
integer (kind=4), intent (in) :: p1, p2
integer (kind=4) :: specific__sign_i4
specific__sign_i4 = sign (p1, p2)
end function
+
+
+
+#endif
!This file is machine generated.
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_8)
+
+
+
elemental function specific__sign_i8 (p1, p2)
integer (kind=8), intent (in) :: p1, p2
integer (kind=8) :: specific__sign_i8
specific__sign_i8 = sign (p1, p2)
end function
+
+
+
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+
+
+
+elemental function specific__sign_r10 (p1, p2)
+ real (kind=10), intent (in) :: p1, p2
+ real (kind=10) :: specific__sign_r10
+
+ specific__sign_r10 = sign (p1, p2)
+end function
+
+
+
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+
+
+
+elemental function specific__sign_r16 (p1, p2)
+ real (kind=16), intent (in) :: p1, p2
+ real (kind=16) :: specific__sign_r16
+
+ specific__sign_r16 = sign (p1, p2)
+end function
+
+
+
+#endif
!This file is machine generated.
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+
+
+
elemental function specific__sign_r4 (p1, p2)
real (kind=4), intent (in) :: p1, p2
real (kind=4) :: specific__sign_r4
specific__sign_r4 = sign (p1, p2)
end function
+
+
+
+#endif
!This file is machine generated.
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+
+
+
elemental function specific__sign_r8 (p1, p2)
real (kind=8), intent (in) :: p1, p2
real (kind=8) :: specific__sign_r8
specific__sign_r8 = sign (p1, p2)
end function
+
+
+
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+#ifdef HAVE_CSINL
+
+elemental function specific__sin_c10 (parm)
+ complex (kind=10), intent (in) :: parm
+ complex (kind=10) :: specific__sin_c10
+
+ specific__sin_c10 = sin (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+#ifdef HAVE_CSINL
+
+elemental function specific__sin_c16 (parm)
+ complex (kind=16), intent (in) :: parm
+ complex (kind=16) :: specific__sin_c16
+
+ specific__sin_c16 = sin (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_4)
+#ifdef HAVE_CSINF
+
elemental function specific__sin_c4 (parm)
complex (kind=4), intent (in) :: parm
complex (kind=4) :: specific__sin_c4
specific__sin_c4 = sin (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_8)
+#ifdef HAVE_CSIN
+
elemental function specific__sin_c8 (parm)
complex (kind=8), intent (in) :: parm
complex (kind=8) :: specific__sin_c8
specific__sin_c8 = sin (parm)
end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_SINL
+
+elemental function specific__sin_r10 (parm)
+ real (kind=10), intent (in) :: parm
+ real (kind=10) :: specific__sin_r10
+
+ specific__sin_r10 = sin (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_SINL
+
+elemental function specific__sin_r16 (parm)
+ real (kind=16), intent (in) :: parm
+ real (kind=16) :: specific__sin_r16
+
+ specific__sin_r16 = sin (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_SINF
+
elemental function specific__sin_r4 (parm)
real (kind=4), intent (in) :: parm
real (kind=4) :: specific__sin_r4
specific__sin_r4 = sin (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_SIN
+
elemental function specific__sin_r8 (parm)
real (kind=8), intent (in) :: parm
real (kind=8) :: specific__sin_r8
specific__sin_r8 = sin (parm)
end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_SINHL
+
+elemental function specific__sinh_r10 (parm)
+ real (kind=10), intent (in) :: parm
+ real (kind=10) :: specific__sinh_r10
+
+ specific__sinh_r10 = sinh (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_SINHL
+
+elemental function specific__sinh_r16 (parm)
+ real (kind=16), intent (in) :: parm
+ real (kind=16) :: specific__sinh_r16
+
+ specific__sinh_r16 = sinh (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_SINHF
+
elemental function specific__sinh_r4 (parm)
real (kind=4), intent (in) :: parm
real (kind=4) :: specific__sinh_r4
specific__sinh_r4 = sinh (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_SINH
+
elemental function specific__sinh_r8 (parm)
real (kind=8), intent (in) :: parm
real (kind=8) :: specific__sinh_r8
specific__sinh_r8 = sinh (parm)
end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+#ifdef HAVE_CSQRTL
+
+elemental function specific__sqrt_c10 (parm)
+ complex (kind=10), intent (in) :: parm
+ complex (kind=10) :: specific__sqrt_c10
+
+ specific__sqrt_c10 = sqrt (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+#ifdef HAVE_CSQRTL
+
+elemental function specific__sqrt_c16 (parm)
+ complex (kind=16), intent (in) :: parm
+ complex (kind=16) :: specific__sqrt_c16
+
+ specific__sqrt_c16 = sqrt (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_4)
+#ifdef HAVE_CSQRTF
+
elemental function specific__sqrt_c4 (parm)
complex (kind=4), intent (in) :: parm
complex (kind=4) :: specific__sqrt_c4
specific__sqrt_c4 = sqrt (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_8)
+#ifdef HAVE_CSQRT
+
elemental function specific__sqrt_c8 (parm)
complex (kind=8), intent (in) :: parm
complex (kind=8) :: specific__sqrt_c8
specific__sqrt_c8 = sqrt (parm)
end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_SQRTL
+
+elemental function specific__sqrt_r10 (parm)
+ real (kind=10), intent (in) :: parm
+ real (kind=10) :: specific__sqrt_r10
+
+ specific__sqrt_r10 = sqrt (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_SQRTL
+
+elemental function specific__sqrt_r16 (parm)
+ real (kind=16), intent (in) :: parm
+ real (kind=16) :: specific__sqrt_r16
+
+ specific__sqrt_r16 = sqrt (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_SQRTF
+
elemental function specific__sqrt_r4 (parm)
real (kind=4), intent (in) :: parm
real (kind=4) :: specific__sqrt_r4
specific__sqrt_r4 = sqrt (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_SQRT
+
elemental function specific__sqrt_r8 (parm)
real (kind=8), intent (in) :: parm
real (kind=8) :: specific__sqrt_r8
specific__sqrt_r8 = sqrt (parm)
end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_TANL
+
+elemental function specific__tan_r10 (parm)
+ real (kind=10), intent (in) :: parm
+ real (kind=10) :: specific__tan_r10
+
+ specific__tan_r10 = tan (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_TANL
+
+elemental function specific__tan_r16 (parm)
+ real (kind=16), intent (in) :: parm
+ real (kind=16) :: specific__tan_r16
+
+ specific__tan_r16 = tan (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_TANF
+
elemental function specific__tan_r4 (parm)
real (kind=4), intent (in) :: parm
real (kind=4) :: specific__tan_r4
specific__tan_r4 = tan (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_TAN
+
elemental function specific__tan_r8 (parm)
real (kind=8), intent (in) :: parm
real (kind=8) :: specific__tan_r8
specific__tan_r8 = tan (parm)
end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_TANHL
+
+elemental function specific__tanh_r10 (parm)
+ real (kind=10), intent (in) :: parm
+ real (kind=10) :: specific__tanh_r10
+
+ specific__tanh_r10 = tanh (parm)
+end function
+
+#endif
+#endif
--- /dev/null
+! Copyright 2002 Free Software Foundation, Inc.
+! Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file. (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING. If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_TANHL
+
+elemental function specific__tanh_r16 (parm)
+ real (kind=16), intent (in) :: parm
+ real (kind=16) :: specific__tanh_r16
+
+ specific__tanh_r16 = tanh (parm)
+end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_TANHF
+
elemental function specific__tanh_r4 (parm)
real (kind=4), intent (in) :: parm
real (kind=4) :: specific__tanh_r4
specific__tanh_r4 = tanh (parm)
end function
+
+#endif
+#endif
!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_TANH
+
elemental function specific__tanh_r8 (parm)
real (kind=8), intent (in) :: parm
real (kind=8) :: specific__tanh_r8
specific__tanh_r8 = tanh (parm)
end function
+
+#endif
+#endif
--- /dev/null
+/* Implementation of the ALL intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_LOGICAL_16)
+
+
+extern void all_l16 (gfc_array_l16 *, gfc_array_l16 *, index_type *);
+export_proto(all_l16);
+
+void
+all_l16 (gfc_array_l16 *retarray, gfc_array_l16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_LOGICAL_16 *base;
+ GFC_LOGICAL_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_LOGICAL_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_LOGICAL_16 *src;
+ GFC_LOGICAL_16 result;
+ src = base;
+ {
+
+ /* Return true only if all the elements are set. */
+ result = 1;
+ if (len <= 0)
+ *dest = 1;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (! *src)
+ {
+ result = 0;
+ break;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_LOGICAL_4)
+
+
extern void all_l4 (gfc_array_l4 *, gfc_array_l4 *, index_type *);
export_proto(all_l4);
}
}
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_LOGICAL_8)
+
+
extern void all_l8 (gfc_array_l8 *, gfc_array_l8 *, index_type *);
export_proto(all_l8);
}
}
+#endif
--- /dev/null
+/* Implementation of the ANY intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_LOGICAL_16)
+
+
+extern void any_l16 (gfc_array_l16 *, gfc_array_l16 *, index_type *);
+export_proto(any_l16);
+
+void
+any_l16 (gfc_array_l16 *retarray, gfc_array_l16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_LOGICAL_16 *base;
+ GFC_LOGICAL_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_LOGICAL_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_LOGICAL_16 *src;
+ GFC_LOGICAL_16 result;
+ src = base;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ /* Return true if any of the elements are set. */
+ if (*src)
+ {
+ result = 1;
+ break;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_LOGICAL_4)
+
+
extern void any_l4 (gfc_array_l4 *, gfc_array_l4 *, index_type *);
export_proto(any_l4);
}
}
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_LOGICAL_8)
+
+
extern void any_l8 (gfc_array_l8 *, gfc_array_l8 *, index_type *);
export_proto(any_l8);
}
}
+#endif
--- /dev/null
+/* Implementation of the COUNT intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void count_16_l16 (gfc_array_i16 *, gfc_array_l16 *, index_type *);
+export_proto(count_16_l16);
+
+void
+count_16_l16 (gfc_array_i16 *retarray, gfc_array_l16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_LOGICAL_16 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_LOGICAL_16 *src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src)
+ result++;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the COUNT intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void count_16_l4 (gfc_array_i16 *, gfc_array_l4 *, index_type *);
+export_proto(count_16_l4);
+
+void
+count_16_l4 (gfc_array_i16 *retarray, gfc_array_l4 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_LOGICAL_4 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_LOGICAL_4 *src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src)
+ result++;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the COUNT intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void count_16_l8 (gfc_array_i16 *, gfc_array_l8 *, index_type *);
+export_proto(count_16_l8);
+
+void
+count_16_l8 (gfc_array_i16 *retarray, gfc_array_l8 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_LOGICAL_8 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_LOGICAL_8 *src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src)
+ result++;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the COUNT intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void count_4_l16 (gfc_array_i4 *, gfc_array_l16 *, index_type *);
+export_proto(count_4_l16);
+
+void
+count_4_l16 (gfc_array_i4 *retarray, gfc_array_l16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_LOGICAL_16 *base;
+ GFC_INTEGER_4 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_4)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_LOGICAL_16 *src;
+ GFC_INTEGER_4 result;
+ src = base;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src)
+ result++;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_INTEGER_4)
+
+
extern void count_4_l4 (gfc_array_i4 *, gfc_array_l4 *, index_type *);
export_proto(count_4_l4);
}
}
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_INTEGER_4)
+
+
extern void count_4_l8 (gfc_array_i4 *, gfc_array_l8 *, index_type *);
export_proto(count_4_l8);
}
}
+#endif
--- /dev/null
+/* Implementation of the COUNT intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void count_8_l16 (gfc_array_i8 *, gfc_array_l16 *, index_type *);
+export_proto(count_8_l16);
+
+void
+count_8_l16 (gfc_array_i8 *retarray, gfc_array_l16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_LOGICAL_16 *base;
+ GFC_INTEGER_8 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_8)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_LOGICAL_16 *src;
+ GFC_INTEGER_8 result;
+ src = base;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src)
+ result++;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_INTEGER_8)
+
+
extern void count_8_l4 (gfc_array_i8 *, gfc_array_l4 *, index_type *);
export_proto(count_8_l4);
}
}
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_INTEGER_8)
+
+
extern void count_8_l8 (gfc_array_i8 *, gfc_array_l8 *, index_type *);
export_proto(count_8_l8);
}
}
+#endif
--- /dev/null
+/* Implementation of the CSHIFT intrinsic
+ Copyright 2003 Free Software Foundation, Inc.
+ Contributed by Feng Wang <wf_cs@yahoo.com>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Ligbfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <string.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+static void
+cshift1 (gfc_array_char * ret, const gfc_array_char * array,
+ const gfc_array_i16 * h, const GFC_INTEGER_16 * pwhich, index_type size)
+{
+ /* r.* indicates the return array. */
+ index_type rstride[GFC_MAX_DIMENSIONS];
+ index_type rstride0;
+ index_type roffset;
+ char *rptr;
+ char *dest;
+ /* s.* indicates the source array. */
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type sstride0;
+ index_type soffset;
+ const char *sptr;
+ const char *src;
+ /* h.* indicates the array. */
+ index_type hstride[GFC_MAX_DIMENSIONS];
+ index_type hstride0;
+ const GFC_INTEGER_16 *hptr;
+
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dim;
+ index_type len;
+ index_type n;
+ int which;
+ GFC_INTEGER_16 sh;
+
+ if (pwhich)
+ which = *pwhich - 1;
+ else
+ which = 0;
+
+ if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array))
+ runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'");
+
+ if (ret->data == NULL)
+ {
+ int i;
+
+ ret->data = internal_malloc_size (size * size0 ((array_t *)array));
+ ret->offset = 0;
+ ret->dtype = array->dtype;
+ for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
+ {
+ ret->dim[i].lbound = 0;
+ ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+
+ if (i == 0)
+ ret->dim[i].stride = 1;
+ else
+ ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+ }
+ }
+
+ extent[0] = 1;
+ count[0] = 0;
+ n = 0;
+
+ /* Initialized for avoiding compiler warnings. */
+ roffset = size;
+ soffset = size;
+ len = 0;
+
+ for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ if (dim == which)
+ {
+ roffset = ret->dim[dim].stride * size;
+ if (roffset == 0)
+ roffset = size;
+ soffset = array->dim[dim].stride * size;
+ if (soffset == 0)
+ soffset = size;
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ }
+ else
+ {
+ count[n] = 0;
+ extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ rstride[n] = ret->dim[dim].stride * size;
+ sstride[n] = array->dim[dim].stride * size;
+
+ hstride[n] = h->dim[n].stride;
+ n++;
+ }
+ }
+ if (sstride[0] == 0)
+ sstride[0] = size;
+ if (rstride[0] == 0)
+ rstride[0] = size;
+ if (hstride[0] == 0)
+ hstride[0] = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (array);
+ rstride0 = rstride[0];
+ sstride0 = sstride[0];
+ hstride0 = hstride[0];
+ rptr = ret->data;
+ sptr = array->data;
+ hptr = h->data;
+
+ while (rptr)
+ {
+ /* Do the for this dimension. */
+ sh = *hptr;
+ sh = (div (sh, len)).rem;
+ if (sh < 0)
+ sh += len;
+
+ src = &sptr[sh * soffset];
+ dest = rptr;
+
+ for (n = 0; n < len; n++)
+ {
+ memcpy (dest, src, size);
+ dest += roffset;
+ if (n == len - sh - 1)
+ src = sptr;
+ else
+ src += soffset;
+ }
+
+ /* Advance to the next section. */
+ rptr += rstride0;
+ sptr += sstride0;
+ hptr += hstride0;
+ count[0]++;
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ rptr -= rstride[n] * extent[n];
+ sptr -= sstride[n] * extent[n];
+ hptr -= hstride[n] * extent[n];
+ n++;
+ if (n >= dim - 1)
+ {
+ /* Break out of the loop. */
+ rptr = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ rptr += rstride[n];
+ sptr += sstride[n];
+ hptr += hstride[n];
+ }
+ }
+ }
+}
+
+void cshift1_16 (gfc_array_char *, const gfc_array_char *,
+ const gfc_array_i16 *, const GFC_INTEGER_16 *);
+export_proto(cshift1_16);
+
+void
+cshift1_16 (gfc_array_char * ret,
+ const gfc_array_char * array,
+ const gfc_array_i16 * h, const GFC_INTEGER_16 * pwhich)
+{
+ cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array));
+}
+
+void cshift1_16_char (gfc_array_char * ret, GFC_INTEGER_4,
+ const gfc_array_char * array,
+ const gfc_array_i16 * h, const GFC_INTEGER_16 * pwhich,
+ GFC_INTEGER_4);
+export_proto(cshift1_16_char);
+
+void
+cshift1_16_char (gfc_array_char * ret,
+ GFC_INTEGER_4 ret_length __attribute__((unused)),
+ const gfc_array_char * array,
+ const gfc_array_i16 * h, const GFC_INTEGER_16 * pwhich,
+ GFC_INTEGER_4 array_length)
+{
+ cshift1 (ret, array, h, pwhich, array_length);
+}
+
+#endif
#include <string.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4)
+
static void
cshift1 (gfc_array_char * ret, const gfc_array_char * array,
const gfc_array_i4 * h, const GFC_INTEGER_4 * pwhich, index_type size)
{
cshift1 (ret, array, h, pwhich, array_length);
}
+
+#endif
#include <string.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8)
+
static void
cshift1 (gfc_array_char * ret, const gfc_array_char * array,
const gfc_array_i8 * h, const GFC_INTEGER_8 * pwhich, index_type size)
{
cshift1 (ret, array, h, pwhich, array_length);
}
+
+#endif
--- /dev/null
+/* Implementation of the DOT_PRODUCT intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+ and Feng Wang <fengwang@nudt.edu.cn>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+
+typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
+
+extern GFC_COMPLEX_10 dot_product_c10 (gfc_array_c10 * a, gfc_array_c10 * b);
+export_proto(dot_product_c10);
+
+/* Both parameters will already have been converted to the result type. */
+GFC_COMPLEX_10
+dot_product_c10 (gfc_array_c10 * a, gfc_array_c10 * b)
+{
+ GFC_COMPLEX_10 *pa;
+ GFC_COMPLEX_10 *pb;
+ GFC_COMPLEX_10 res;
+ GFC_COMPLEX_10 conjga;
+ index_type count;
+ index_type astride;
+ index_type bstride;
+
+ assert (GFC_DESCRIPTOR_RANK (a) == 1
+ && GFC_DESCRIPTOR_RANK (b) == 1);
+
+ if (a->dim[0].stride == 0)
+ a->dim[0].stride = 1;
+ if (b->dim[0].stride == 0)
+ b->dim[0].stride = 1;
+
+ astride = a->dim[0].stride;
+ bstride = b->dim[0].stride;
+ count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ res = 0;
+ pa = a->data;
+ pb = b->data;
+
+ while (count--)
+ {
+ COMPLEX_ASSIGN(conjga, REALPART (*pa), -IMAGPART (*pa));
+ res += conjga * *pb;
+ pa += astride;
+ pb += bstride;
+ }
+
+ return res;
+}
+
+#endif
--- /dev/null
+/* Implementation of the DOT_PRODUCT intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+ and Feng Wang <fengwang@nudt.edu.cn>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+
+typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
+
+extern GFC_COMPLEX_16 dot_product_c16 (gfc_array_c16 * a, gfc_array_c16 * b);
+export_proto(dot_product_c16);
+
+/* Both parameters will already have been converted to the result type. */
+GFC_COMPLEX_16
+dot_product_c16 (gfc_array_c16 * a, gfc_array_c16 * b)
+{
+ GFC_COMPLEX_16 *pa;
+ GFC_COMPLEX_16 *pb;
+ GFC_COMPLEX_16 res;
+ GFC_COMPLEX_16 conjga;
+ index_type count;
+ index_type astride;
+ index_type bstride;
+
+ assert (GFC_DESCRIPTOR_RANK (a) == 1
+ && GFC_DESCRIPTOR_RANK (b) == 1);
+
+ if (a->dim[0].stride == 0)
+ a->dim[0].stride = 1;
+ if (b->dim[0].stride == 0)
+ b->dim[0].stride = 1;
+
+ astride = a->dim[0].stride;
+ bstride = b->dim[0].stride;
+ count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ res = 0;
+ pa = a->data;
+ pb = b->data;
+
+ while (count--)
+ {
+ COMPLEX_ASSIGN(conjga, REALPART (*pa), -IMAGPART (*pa));
+ res += conjga * *pb;
+ pa += astride;
+ pb += bstride;
+ }
+
+ return res;
+}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_COMPLEX_4)
+
typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
extern GFC_COMPLEX_4 dot_product_c4 (gfc_array_c4 * a, gfc_array_c4 * b);
return res;
}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_COMPLEX_8)
+
typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
extern GFC_COMPLEX_8 dot_product_c8 (gfc_array_c8 * a, gfc_array_c8 * b);
return res;
}
+
+#endif
--- /dev/null
+/* Implementation of the DOT_PRODUCT intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
+
+extern GFC_INTEGER_16 dot_product_i16 (gfc_array_i16 * a, gfc_array_i16 * b);
+export_proto(dot_product_i16);
+
+/* Both parameters will already have been converted to the result type. */
+GFC_INTEGER_16
+dot_product_i16 (gfc_array_i16 * a, gfc_array_i16 * b)
+{
+ GFC_INTEGER_16 *pa;
+ GFC_INTEGER_16 *pb;
+ GFC_INTEGER_16 res;
+ index_type count;
+ index_type astride;
+ index_type bstride;
+
+ assert (GFC_DESCRIPTOR_RANK (a) == 1
+ && GFC_DESCRIPTOR_RANK (b) == 1);
+
+ if (a->dim[0].stride == 0)
+ a->dim[0].stride = 1;
+ if (b->dim[0].stride == 0)
+ b->dim[0].stride = 1;
+
+ astride = a->dim[0].stride;
+ bstride = b->dim[0].stride;
+ count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ res = 0;
+ pa = a->data;
+ pb = b->data;
+
+ while (count--)
+ {
+ res += *pa * *pb;
+ pa += astride;
+ pb += bstride;
+ }
+
+ return res;
+}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4)
+
typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
extern GFC_INTEGER_4 dot_product_i4 (gfc_array_i4 * a, gfc_array_i4 * b);
return res;
}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8)
+
typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
extern GFC_INTEGER_8 dot_product_i8 (gfc_array_i8 * a, gfc_array_i8 * b);
return res;
}
+
+#endif
--- /dev/null
+/* Implementation of the DOT_PRODUCT intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_LOGICAL_16)
+
+extern GFC_LOGICAL_16 dot_product_l16 (gfc_array_l4 *, gfc_array_l4 *);
+export_proto(dot_product_l16);
+
+GFC_LOGICAL_16
+dot_product_l16 (gfc_array_l4 * a, gfc_array_l4 * b)
+{
+ GFC_LOGICAL_4 *pa;
+ GFC_LOGICAL_4 *pb;
+ index_type count;
+ index_type astride;
+ index_type bstride;
+
+ assert (GFC_DESCRIPTOR_RANK (a) == 1
+ && GFC_DESCRIPTOR_RANK (b) == 1);
+
+ if (a->dim[0].stride == 0)
+ a->dim[0].stride = 1;
+ if (b->dim[0].stride == 0)
+ b->dim[0].stride = 1;
+
+ astride = a->dim[0].stride;
+ bstride = b->dim[0].stride;
+ count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+
+ pa = a->data;
+ if (GFC_DESCRIPTOR_SIZE (a) != 4)
+ {
+ assert (GFC_DESCRIPTOR_SIZE (a) == 8);
+ pa = GFOR_POINTER_L8_TO_L4 (pa);
+ astride <<= 1;
+ }
+ pb = b->data;
+ if (GFC_DESCRIPTOR_SIZE (b) != 4)
+ {
+ assert (GFC_DESCRIPTOR_SIZE (b) == 8);
+ pb = GFOR_POINTER_L8_TO_L4 (pb);
+ bstride <<= 1;
+ }
+
+ while (count--)
+ {
+ if (*pa && *pb)
+ return 1;
+
+ pa += astride;
+ pb += bstride;
+ }
+
+ return 0;
+}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_LOGICAL_4)
+
extern GFC_LOGICAL_4 dot_product_l4 (gfc_array_l4 *, gfc_array_l4 *);
export_proto(dot_product_l4);
return 0;
}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_LOGICAL_8)
+
extern GFC_LOGICAL_8 dot_product_l8 (gfc_array_l4 *, gfc_array_l4 *);
export_proto(dot_product_l8);
return 0;
}
+
+#endif
--- /dev/null
+/* Implementation of the DOT_PRODUCT intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_REAL_10)
+
+typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
+
+extern GFC_REAL_10 dot_product_r10 (gfc_array_r10 * a, gfc_array_r10 * b);
+export_proto(dot_product_r10);
+
+/* Both parameters will already have been converted to the result type. */
+GFC_REAL_10
+dot_product_r10 (gfc_array_r10 * a, gfc_array_r10 * b)
+{
+ GFC_REAL_10 *pa;
+ GFC_REAL_10 *pb;
+ GFC_REAL_10 res;
+ index_type count;
+ index_type astride;
+ index_type bstride;
+
+ assert (GFC_DESCRIPTOR_RANK (a) == 1
+ && GFC_DESCRIPTOR_RANK (b) == 1);
+
+ if (a->dim[0].stride == 0)
+ a->dim[0].stride = 1;
+ if (b->dim[0].stride == 0)
+ b->dim[0].stride = 1;
+
+ astride = a->dim[0].stride;
+ bstride = b->dim[0].stride;
+ count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ res = 0;
+ pa = a->data;
+ pb = b->data;
+
+ while (count--)
+ {
+ res += *pa * *pb;
+ pa += astride;
+ pb += bstride;
+ }
+
+ return res;
+}
+
+#endif
--- /dev/null
+/* Implementation of the DOT_PRODUCT intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_REAL_16)
+
+typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
+
+extern GFC_REAL_16 dot_product_r16 (gfc_array_r16 * a, gfc_array_r16 * b);
+export_proto(dot_product_r16);
+
+/* Both parameters will already have been converted to the result type. */
+GFC_REAL_16
+dot_product_r16 (gfc_array_r16 * a, gfc_array_r16 * b)
+{
+ GFC_REAL_16 *pa;
+ GFC_REAL_16 *pb;
+ GFC_REAL_16 res;
+ index_type count;
+ index_type astride;
+ index_type bstride;
+
+ assert (GFC_DESCRIPTOR_RANK (a) == 1
+ && GFC_DESCRIPTOR_RANK (b) == 1);
+
+ if (a->dim[0].stride == 0)
+ a->dim[0].stride = 1;
+ if (b->dim[0].stride == 0)
+ b->dim[0].stride = 1;
+
+ astride = a->dim[0].stride;
+ bstride = b->dim[0].stride;
+ count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ res = 0;
+ pa = a->data;
+ pb = b->data;
+
+ while (count--)
+ {
+ res += *pa * *pb;
+ pa += astride;
+ pb += bstride;
+ }
+
+ return res;
+}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_4)
+
typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
extern GFC_REAL_4 dot_product_r4 (gfc_array_r4 * a, gfc_array_r4 * b);
return res;
}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_8)
+
typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
extern GFC_REAL_8 dot_product_r8 (gfc_array_r8 * a, gfc_array_r8 * b);
return res;
}
+
+#endif
--- /dev/null
+/* Implementation of the EOSHIFT intrinsic
+ Copyright 2002, 2005 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <string.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+static void
+eoshift1 (gfc_array_char *ret, const gfc_array_char *array, const gfc_array_i16 *h,
+ const char *pbound, const GFC_INTEGER_16 *pwhich, index_type size,
+ char filler)
+{
+ /* r.* indicates the return array. */
+ index_type rstride[GFC_MAX_DIMENSIONS];
+ index_type rstride0;
+ index_type roffset;
+ char *rptr;
+ char *dest;
+ /* s.* indicates the source array. */
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type sstride0;
+ index_type soffset;
+ const char *sptr;
+ const char *src;
+ /* h.* indicates the shift array. */
+ index_type hstride[GFC_MAX_DIMENSIONS];
+ index_type hstride0;
+ const GFC_INTEGER_16 *hptr;
+
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dim;
+ index_type len;
+ index_type n;
+ int which;
+ GFC_INTEGER_16 sh;
+ GFC_INTEGER_16 delta;
+
+ /* The compiler cannot figure out that these are set, initialize
+ them to avoid warnings. */
+ len = 0;
+ soffset = 0;
+ roffset = 0;
+
+ if (pwhich)
+ which = *pwhich - 1;
+ else
+ which = 0;
+
+ extent[0] = 1;
+ count[0] = 0;
+
+ if (ret->data == NULL)
+ {
+ int i;
+
+ ret->data = internal_malloc_size (size * size0 ((array_t *)array));
+ ret->offset = 0;
+ ret->dtype = array->dtype;
+ for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
+ {
+ ret->dim[i].lbound = 0;
+ ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+
+ if (i == 0)
+ ret->dim[i].stride = 1;
+ else
+ ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+ }
+ }
+
+ n = 0;
+ for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ if (dim == which)
+ {
+ roffset = ret->dim[dim].stride * size;
+ if (roffset == 0)
+ roffset = size;
+ soffset = array->dim[dim].stride * size;
+ if (soffset == 0)
+ soffset = size;
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ }
+ else
+ {
+ count[n] = 0;
+ extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ rstride[n] = ret->dim[dim].stride * size;
+ sstride[n] = array->dim[dim].stride * size;
+
+ hstride[n] = h->dim[n].stride;
+ n++;
+ }
+ }
+ if (sstride[0] == 0)
+ sstride[0] = size;
+ if (rstride[0] == 0)
+ rstride[0] = size;
+ if (hstride[0] == 0)
+ hstride[0] = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (array);
+ rstride0 = rstride[0];
+ sstride0 = sstride[0];
+ hstride0 = hstride[0];
+ rptr = ret->data;
+ sptr = array->data;
+ hptr = h->data;
+
+ while (rptr)
+ {
+ /* Do the shift for this dimension. */
+ sh = *hptr;
+ if (( sh >= 0 ? sh : -sh ) > len)
+ {
+ delta = len;
+ sh = len;
+ }
+ else
+ delta = (sh >= 0) ? sh: -sh;
+
+ if (sh > 0)
+ {
+ src = &sptr[delta * soffset];
+ dest = rptr;
+ }
+ else
+ {
+ src = sptr;
+ dest = &rptr[delta * roffset];
+ }
+ for (n = 0; n < len - delta; n++)
+ {
+ memcpy (dest, src, size);
+ dest += roffset;
+ src += soffset;
+ }
+ if (sh < 0)
+ dest = rptr;
+ n = delta;
+
+ if (pbound)
+ while (n--)
+ {
+ memcpy (dest, pbound, size);
+ dest += roffset;
+ }
+ else
+ while (n--)
+ {
+ memset (dest, filler, size);
+ dest += roffset;
+ }
+
+ /* Advance to the next section. */
+ rptr += rstride0;
+ sptr += sstride0;
+ hptr += hstride0;
+ count[0]++;
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ rptr -= rstride[n] * extent[n];
+ sptr -= sstride[n] * extent[n];
+ hptr -= hstride[n] * extent[n];
+ n++;
+ if (n >= dim - 1)
+ {
+ /* Break out of the loop. */
+ rptr = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ rptr += rstride[n];
+ sptr += sstride[n];
+ hptr += hstride[n];
+ }
+ }
+ }
+}
+
+void eoshift1_16 (gfc_array_char *, const gfc_array_char *,
+ const gfc_array_i16 *, const char *, const GFC_INTEGER_16 *);
+export_proto(eoshift1_16);
+
+void
+eoshift1_16 (gfc_array_char *ret, const gfc_array_char *array,
+ const gfc_array_i16 *h, const char *pbound,
+ const GFC_INTEGER_16 *pwhich)
+{
+ eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0);
+}
+
+void eoshift1_16_char (gfc_array_char *, GFC_INTEGER_4,
+ const gfc_array_char *, const gfc_array_i16 *,
+ const char *, const GFC_INTEGER_16 *,
+ GFC_INTEGER_4, GFC_INTEGER_4);
+export_proto(eoshift1_16_char);
+
+void
+eoshift1_16_char (gfc_array_char *ret,
+ GFC_INTEGER_4 ret_length __attribute__((unused)),
+ const gfc_array_char *array, const gfc_array_i16 *h,
+ const char *pbound, const GFC_INTEGER_16 *pwhich,
+ GFC_INTEGER_4 array_length,
+ GFC_INTEGER_4 bound_length
+ __attribute__((unused)))
+{
+ eoshift1 (ret, array, h, pbound, pwhich, array_length, ' ');
+}
+
+#endif
#include <string.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4)
+
static void
eoshift1 (gfc_array_char *ret, const gfc_array_char *array, const gfc_array_i4 *h,
const char *pbound, const GFC_INTEGER_4 *pwhich, index_type size,
{
eoshift1 (ret, array, h, pbound, pwhich, array_length, ' ');
}
+
+#endif
#include <string.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8)
+
static void
eoshift1 (gfc_array_char *ret, const gfc_array_char *array, const gfc_array_i8 *h,
const char *pbound, const GFC_INTEGER_8 *pwhich, index_type size,
{
eoshift1 (ret, array, h, pbound, pwhich, array_length, ' ');
}
+
+#endif
--- /dev/null
+/* Implementation of the EOSHIFT intrinsic
+ Copyright 2002, 2005 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <string.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+static void
+eoshift3 (gfc_array_char *ret, const gfc_array_char *array, const gfc_array_i16 *h,
+ const gfc_array_char *bound, const GFC_INTEGER_16 *pwhich,
+ index_type size, char filler)
+{
+ /* r.* indicates the return array. */
+ index_type rstride[GFC_MAX_DIMENSIONS];
+ index_type rstride0;
+ index_type roffset;
+ char *rptr;
+ char *dest;
+ /* s.* indicates the source array. */
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type sstride0;
+ index_type soffset;
+ const char *sptr;
+ const char *src;
+ /* h.* indicates the shift array. */
+ index_type hstride[GFC_MAX_DIMENSIONS];
+ index_type hstride0;
+ const GFC_INTEGER_16 *hptr;
+ /* b.* indicates the bound array. */
+ index_type bstride[GFC_MAX_DIMENSIONS];
+ index_type bstride0;
+ const char *bptr;
+
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dim;
+ index_type len;
+ index_type n;
+ int which;
+ GFC_INTEGER_16 sh;
+ GFC_INTEGER_16 delta;
+
+ /* The compiler cannot figure out that these are set, initialize
+ them to avoid warnings. */
+ len = 0;
+ soffset = 0;
+ roffset = 0;
+
+ if (pwhich)
+ which = *pwhich - 1;
+ else
+ which = 0;
+
+ if (ret->data == NULL)
+ {
+ int i;
+
+ ret->data = internal_malloc_size (size * size0 ((array_t *)array));
+ ret->offset = 0;
+ ret->dtype = array->dtype;
+ for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
+ {
+ ret->dim[i].lbound = 0;
+ ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+
+ if (i == 0)
+ ret->dim[i].stride = 1;
+ else
+ ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+ }
+ }
+
+
+ extent[0] = 1;
+ count[0] = 0;
+ n = 0;
+ for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ if (dim == which)
+ {
+ roffset = ret->dim[dim].stride * size;
+ if (roffset == 0)
+ roffset = size;
+ soffset = array->dim[dim].stride * size;
+ if (soffset == 0)
+ soffset = size;
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ }
+ else
+ {
+ count[n] = 0;
+ extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ rstride[n] = ret->dim[dim].stride * size;
+ sstride[n] = array->dim[dim].stride * size;
+
+ hstride[n] = h->dim[n].stride;
+ if (bound)
+ bstride[n] = bound->dim[n].stride * size;
+ else
+ bstride[n] = 0;
+ n++;
+ }
+ }
+ if (sstride[0] == 0)
+ sstride[0] = size;
+ if (rstride[0] == 0)
+ rstride[0] = size;
+ if (hstride[0] == 0)
+ hstride[0] = 1;
+ if (bound && bstride[0] == 0)
+ bstride[0] = size;
+
+ dim = GFC_DESCRIPTOR_RANK (array);
+ rstride0 = rstride[0];
+ sstride0 = sstride[0];
+ hstride0 = hstride[0];
+ bstride0 = bstride[0];
+ rptr = ret->data;
+ sptr = array->data;
+ hptr = h->data;
+ if (bound)
+ bptr = bound->data;
+ else
+ bptr = NULL;
+
+ while (rptr)
+ {
+ /* Do the shift for this dimension. */
+ sh = *hptr;
+ if (( sh >= 0 ? sh : -sh ) > len)
+ {
+ delta = len;
+ sh = len;
+ }
+ else
+ delta = (sh >= 0) ? sh: -sh;
+
+ if (sh > 0)
+ {
+ src = &sptr[delta * soffset];
+ dest = rptr;
+ }
+ else
+ {
+ src = sptr;
+ dest = &rptr[delta * roffset];
+ }
+ for (n = 0; n < len - delta; n++)
+ {
+ memcpy (dest, src, size);
+ dest += roffset;
+ src += soffset;
+ }
+ if (sh < 0)
+ dest = rptr;
+ n = delta;
+
+ if (bptr)
+ while (n--)
+ {
+ memcpy (dest, bptr, size);
+ dest += roffset;
+ }
+ else
+ while (n--)
+ {
+ memset (dest, filler, size);
+ dest += roffset;
+ }
+
+ /* Advance to the next section. */
+ rptr += rstride0;
+ sptr += sstride0;
+ hptr += hstride0;
+ bptr += bstride0;
+ count[0]++;
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ rptr -= rstride[n] * extent[n];
+ sptr -= sstride[n] * extent[n];
+ hptr -= hstride[n] * extent[n];
+ bptr -= bstride[n] * extent[n];
+ n++;
+ if (n >= dim - 1)
+ {
+ /* Break out of the loop. */
+ rptr = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ rptr += rstride[n];
+ sptr += sstride[n];
+ hptr += hstride[n];
+ bptr += bstride[n];
+ }
+ }
+ }
+}
+
+extern void eoshift3_16 (gfc_array_char *, const gfc_array_char *,
+ const gfc_array_i16 *, const gfc_array_char *,
+ const GFC_INTEGER_16 *);
+export_proto(eoshift3_16);
+
+void
+eoshift3_16 (gfc_array_char *ret, const gfc_array_char *array,
+ const gfc_array_i16 *h, const gfc_array_char *bound,
+ const GFC_INTEGER_16 *pwhich)
+{
+ eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0);
+}
+
+extern void eoshift3_16_char (gfc_array_char *, GFC_INTEGER_4,
+ const gfc_array_char *,
+ const gfc_array_i16 *,
+ const gfc_array_char *,
+ const GFC_INTEGER_16 *, GFC_INTEGER_4,
+ GFC_INTEGER_4);
+export_proto(eoshift3_16_char);
+
+void
+eoshift3_16_char (gfc_array_char *ret,
+ GFC_INTEGER_4 ret_length __attribute__((unused)),
+ const gfc_array_char *array, const gfc_array_i16 *h,
+ const gfc_array_char *bound,
+ const GFC_INTEGER_16 *pwhich,
+ GFC_INTEGER_4 array_length,
+ GFC_INTEGER_4 bound_length
+ __attribute__((unused)))
+{
+ eoshift3 (ret, array, h, bound, pwhich, array_length, ' ');
+}
+
+#endif
#include <string.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4)
+
static void
eoshift3 (gfc_array_char *ret, const gfc_array_char *array, const gfc_array_i4 *h,
const gfc_array_char *bound, const GFC_INTEGER_4 *pwhich,
{
eoshift3 (ret, array, h, bound, pwhich, array_length, ' ');
}
+
+#endif
#include <string.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8)
+
static void
eoshift3 (gfc_array_char *ret, const gfc_array_char *array, const gfc_array_i8 *h,
const gfc_array_char *bound, const GFC_INTEGER_8 *pwhich,
{
eoshift3 (ret, array, h, bound, pwhich, array_length, ' ');
}
+
+#endif
--- /dev/null
+/* Implementation of the EXPONENT intrinsic
+ Copyright 2003 Free Software Foundation, Inc.
+ Contributed by Richard Henderson <rth@redhat.com>.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_FREXPL)
+
+extern GFC_INTEGER_4 exponent_r10 (GFC_REAL_10 s);
+export_proto(exponent_r10);
+
+GFC_INTEGER_4
+exponent_r10 (GFC_REAL_10 s)
+{
+ int ret;
+ frexpl (s, &ret);
+ return ret;
+}
+
+#endif
--- /dev/null
+/* Implementation of the EXPONENT intrinsic
+ Copyright 2003 Free Software Foundation, Inc.
+ Contributed by Richard Henderson <rth@redhat.com>.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_FREXPL)
+
+extern GFC_INTEGER_4 exponent_r16 (GFC_REAL_16 s);
+export_proto(exponent_r16);
+
+GFC_INTEGER_4
+exponent_r16 (GFC_REAL_16 s)
+{
+ int ret;
+ frexpl (s, &ret);
+ return ret;
+}
+
+#endif
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
+
+#include "config.h"
#include <math.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_FREXPF)
+
extern GFC_INTEGER_4 exponent_r4 (GFC_REAL_4 s);
export_proto(exponent_r4);
frexpf (s, &ret);
return ret;
}
+
+#endif
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
+
+#include "config.h"
#include <math.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_FREXP)
+
extern GFC_INTEGER_4 exponent_r8 (GFC_REAL_8 s);
export_proto(exponent_r8);
frexp (s, &ret);
return ret;
}
+
+#endif
--- /dev/null
+/* Implementation of the FRACTION intrinsic
+ Copyright 2003 Free Software Foundation, Inc.
+ Contributed by Richard Henderson <rth@redhat.com>.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_FREXPL)
+
+extern GFC_REAL_10 fraction_r10 (GFC_REAL_10 s);
+export_proto(fraction_r10);
+
+GFC_REAL_10
+fraction_r10 (GFC_REAL_10 s)
+{
+ int dummy_exp;
+ return frexpl (s, &dummy_exp);
+}
+
+#endif
--- /dev/null
+/* Implementation of the FRACTION intrinsic
+ Copyright 2003 Free Software Foundation, Inc.
+ Contributed by Richard Henderson <rth@redhat.com>.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_FREXPL)
+
+extern GFC_REAL_16 fraction_r16 (GFC_REAL_16 s);
+export_proto(fraction_r16);
+
+GFC_REAL_16
+fraction_r16 (GFC_REAL_16 s)
+{
+ int dummy_exp;
+ return frexpl (s, &dummy_exp);
+}
+
+#endif
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
+
+#include "config.h"
#include <math.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_FREXPF)
+
extern GFC_REAL_4 fraction_r4 (GFC_REAL_4 s);
export_proto(fraction_r4);
int dummy_exp;
return frexpf (s, &dummy_exp);
}
+
+#endif
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
+
+#include "config.h"
#include <math.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_FREXP)
+
extern GFC_REAL_8 fraction_r8 (GFC_REAL_8 s);
export_proto(fraction_r8);
int dummy_exp;
return frexp (s, &dummy_exp);
}
+
+#endif
--- /dev/null
+/* Helper function for repacking arrays.
+ Copyright 2003 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+
+/* Allocates a block of memory with internal_malloc if the array needs
+ repacking. */
+
+GFC_COMPLEX_10 *
+internal_pack_c10 (gfc_array_c10 * source)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type stride[GFC_MAX_DIMENSIONS];
+ index_type stride0;
+ index_type dim;
+ index_type ssize;
+ const GFC_COMPLEX_10 *src;
+ GFC_COMPLEX_10 *dest;
+ GFC_COMPLEX_10 *destptr;
+ int n;
+ int packed;
+
+ if (source->dim[0].stride == 0)
+ {
+ source->dim[0].stride = 1;
+ return source->data;
+ }
+
+ dim = GFC_DESCRIPTOR_RANK (source);
+ ssize = 1;
+ packed = 1;
+ for (n = 0; n < dim; n++)
+ {
+ count[n] = 0;
+ stride[n] = source->dim[n].stride;
+ extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ if (extent[n] <= 0)
+ {
+ /* Do nothing. */
+ packed = 1;
+ break;
+ }
+
+ if (ssize != stride[n])
+ packed = 0;
+
+ ssize *= extent[n];
+ }
+
+ if (packed)
+ return source->data;
+
+ /* Allocate storage for the destination. */
+ destptr = (GFC_COMPLEX_10 *)internal_malloc_size (ssize * sizeof (GFC_COMPLEX_10));
+ dest = destptr;
+ src = source->data;
+ stride0 = stride[0];
+
+
+ while (src)
+ {
+ /* Copy the data. */
+ *(dest++) = *src;
+ /* Advance to the next element. */
+ src += stride0;
+ count[0]++;
+ /* Advance to the next source element. */
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ src -= stride[n] * extent[n];
+ n++;
+ if (n == dim)
+ {
+ src = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ src += stride[n];
+ }
+ }
+ }
+ return destptr;
+}
+
+#endif
--- /dev/null
+/* Helper function for repacking arrays.
+ Copyright 2003 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+
+/* Allocates a block of memory with internal_malloc if the array needs
+ repacking. */
+
+GFC_COMPLEX_16 *
+internal_pack_c16 (gfc_array_c16 * source)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type stride[GFC_MAX_DIMENSIONS];
+ index_type stride0;
+ index_type dim;
+ index_type ssize;
+ const GFC_COMPLEX_16 *src;
+ GFC_COMPLEX_16 *dest;
+ GFC_COMPLEX_16 *destptr;
+ int n;
+ int packed;
+
+ if (source->dim[0].stride == 0)
+ {
+ source->dim[0].stride = 1;
+ return source->data;
+ }
+
+ dim = GFC_DESCRIPTOR_RANK (source);
+ ssize = 1;
+ packed = 1;
+ for (n = 0; n < dim; n++)
+ {
+ count[n] = 0;
+ stride[n] = source->dim[n].stride;
+ extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ if (extent[n] <= 0)
+ {
+ /* Do nothing. */
+ packed = 1;
+ break;
+ }
+
+ if (ssize != stride[n])
+ packed = 0;
+
+ ssize *= extent[n];
+ }
+
+ if (packed)
+ return source->data;
+
+ /* Allocate storage for the destination. */
+ destptr = (GFC_COMPLEX_16 *)internal_malloc_size (ssize * sizeof (GFC_COMPLEX_16));
+ dest = destptr;
+ src = source->data;
+ stride0 = stride[0];
+
+
+ while (src)
+ {
+ /* Copy the data. */
+ *(dest++) = *src;
+ /* Advance to the next element. */
+ src += stride0;
+ count[0]++;
+ /* Advance to the next source element. */
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ src -= stride[n] * extent[n];
+ n++;
+ if (n == dim)
+ {
+ src = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ src += stride[n];
+ }
+ }
+ }
+ return destptr;
+}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_COMPLEX_4)
+
/* Allocates a block of memory with internal_malloc if the array needs
repacking. */
return destptr;
}
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_COMPLEX_8)
+
/* Allocates a block of memory with internal_malloc if the array needs
repacking. */
return destptr;
}
+#endif
--- /dev/null
+/* Helper function for repacking arrays.
+ Copyright 2003 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+/* Allocates a block of memory with internal_malloc if the array needs
+ repacking. */
+
+GFC_INTEGER_16 *
+internal_pack_16 (gfc_array_i16 * source)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type stride[GFC_MAX_DIMENSIONS];
+ index_type stride0;
+ index_type dim;
+ index_type ssize;
+ const GFC_INTEGER_16 *src;
+ GFC_INTEGER_16 *dest;
+ GFC_INTEGER_16 *destptr;
+ int n;
+ int packed;
+
+ if (source->dim[0].stride == 0)
+ {
+ source->dim[0].stride = 1;
+ return source->data;
+ }
+
+ dim = GFC_DESCRIPTOR_RANK (source);
+ ssize = 1;
+ packed = 1;
+ for (n = 0; n < dim; n++)
+ {
+ count[n] = 0;
+ stride[n] = source->dim[n].stride;
+ extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ if (extent[n] <= 0)
+ {
+ /* Do nothing. */
+ packed = 1;
+ break;
+ }
+
+ if (ssize != stride[n])
+ packed = 0;
+
+ ssize *= extent[n];
+ }
+
+ if (packed)
+ return source->data;
+
+ /* Allocate storage for the destination. */
+ destptr = (GFC_INTEGER_16 *)internal_malloc_size (ssize * sizeof (GFC_INTEGER_16));
+ dest = destptr;
+ src = source->data;
+ stride0 = stride[0];
+
+
+ while (src)
+ {
+ /* Copy the data. */
+ *(dest++) = *src;
+ /* Advance to the next element. */
+ src += stride0;
+ count[0]++;
+ /* Advance to the next source element. */
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ src -= stride[n] * extent[n];
+ n++;
+ if (n == dim)
+ {
+ src = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ src += stride[n];
+ }
+ }
+ }
+ return destptr;
+}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4)
+
/* Allocates a block of memory with internal_malloc if the array needs
repacking. */
return destptr;
}
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8)
+
/* Allocates a block of memory with internal_malloc if the array needs
repacking. */
return destptr;
}
+#endif
--- /dev/null
+/* Helper function for repacking arrays.
+ Copyright 2003 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <string.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+
+void
+internal_unpack_c10 (gfc_array_c10 * d, const GFC_COMPLEX_10 * src)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type stride[GFC_MAX_DIMENSIONS];
+ index_type stride0;
+ index_type dim;
+ index_type dsize;
+ GFC_COMPLEX_10 *dest;
+ int n;
+
+ dest = d->data;
+ if (src == dest || !src)
+ return;
+
+ if (d->dim[0].stride == 0)
+ d->dim[0].stride = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (d);
+ dsize = 1;
+ for (n = 0; n < dim; n++)
+ {
+ count[n] = 0;
+ stride[n] = d->dim[n].stride;
+ extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+ if (extent[n] <= 0)
+ abort ();
+
+ if (dsize == stride[n])
+ dsize *= extent[n];
+ else
+ dsize = 0;
+ }
+
+ if (dsize != 0)
+ {
+ memcpy (dest, src, dsize * sizeof (GFC_COMPLEX_10));
+ return;
+ }
+
+ stride0 = stride[0];
+
+ while (dest)
+ {
+ /* Copy the data. */
+ *dest = *(src++);
+ /* Advance to the next element. */
+ dest += stride0;
+ count[0]++;
+ /* Advance to the next source element. */
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ dest -= stride[n] * extent[n];
+ n++;
+ if (n == dim)
+ {
+ dest = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ dest += stride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Helper function for repacking arrays.
+ Copyright 2003 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <string.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+
+void
+internal_unpack_c16 (gfc_array_c16 * d, const GFC_COMPLEX_16 * src)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type stride[GFC_MAX_DIMENSIONS];
+ index_type stride0;
+ index_type dim;
+ index_type dsize;
+ GFC_COMPLEX_16 *dest;
+ int n;
+
+ dest = d->data;
+ if (src == dest || !src)
+ return;
+
+ if (d->dim[0].stride == 0)
+ d->dim[0].stride = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (d);
+ dsize = 1;
+ for (n = 0; n < dim; n++)
+ {
+ count[n] = 0;
+ stride[n] = d->dim[n].stride;
+ extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+ if (extent[n] <= 0)
+ abort ();
+
+ if (dsize == stride[n])
+ dsize *= extent[n];
+ else
+ dsize = 0;
+ }
+
+ if (dsize != 0)
+ {
+ memcpy (dest, src, dsize * sizeof (GFC_COMPLEX_16));
+ return;
+ }
+
+ stride0 = stride[0];
+
+ while (dest)
+ {
+ /* Copy the data. */
+ *dest = *(src++);
+ /* Advance to the next element. */
+ dest += stride0;
+ count[0]++;
+ /* Advance to the next source element. */
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ dest -= stride[n] * extent[n];
+ n++;
+ if (n == dim)
+ {
+ dest = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ dest += stride[n];
+ }
+ }
+ }
+}
+
+#endif
#include <string.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_COMPLEX_4)
+
void
internal_unpack_c4 (gfc_array_c4 * d, const GFC_COMPLEX_4 * src)
{
}
}
+#endif
#include <string.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_COMPLEX_8)
+
void
internal_unpack_c8 (gfc_array_c8 * d, const GFC_COMPLEX_8 * src)
{
}
}
+#endif
--- /dev/null
+/* Helper function for repacking arrays.
+ Copyright 2003 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <string.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+void
+internal_unpack_16 (gfc_array_i16 * d, const GFC_INTEGER_16 * src)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type stride[GFC_MAX_DIMENSIONS];
+ index_type stride0;
+ index_type dim;
+ index_type dsize;
+ GFC_INTEGER_16 *dest;
+ int n;
+
+ dest = d->data;
+ if (src == dest || !src)
+ return;
+
+ if (d->dim[0].stride == 0)
+ d->dim[0].stride = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (d);
+ dsize = 1;
+ for (n = 0; n < dim; n++)
+ {
+ count[n] = 0;
+ stride[n] = d->dim[n].stride;
+ extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+ if (extent[n] <= 0)
+ abort ();
+
+ if (dsize == stride[n])
+ dsize *= extent[n];
+ else
+ dsize = 0;
+ }
+
+ if (dsize != 0)
+ {
+ memcpy (dest, src, dsize * sizeof (GFC_INTEGER_16));
+ return;
+ }
+
+ stride0 = stride[0];
+
+ while (dest)
+ {
+ /* Copy the data. */
+ *dest = *(src++);
+ /* Advance to the next element. */
+ dest += stride0;
+ count[0]++;
+ /* Advance to the next source element. */
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ dest -= stride[n] * extent[n];
+ n++;
+ if (n == dim)
+ {
+ dest = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ dest += stride[n];
+ }
+ }
+ }
+}
+
+#endif
#include <string.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4)
+
void
internal_unpack_4 (gfc_array_i4 * d, const GFC_INTEGER_4 * src)
{
}
}
+#endif
#include <string.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8)
+
void
internal_unpack_8 (gfc_array_i8 * d, const GFC_INTEGER_8 * src)
{
}
}
+#endif
--- /dev/null
+/* Implementation of the MATMUL intrinsic
+ Copyright 2002, 2005 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+
+/* This is a C version of the following fortran pseudo-code. The key
+ point is the loop order -- we access all arrays column-first, which
+ improves the performance enough to boost galgel spec score by 50%.
+
+ DIMENSION A(M,COUNT), B(COUNT,N), C(M,N)
+ C = 0
+ DO J=1,N
+ DO K=1,COUNT
+ DO I=1,M
+ C(I,J) = C(I,J)+A(I,K)*B(K,J)
+*/
+
+extern void matmul_c10 (gfc_array_c10 * retarray, gfc_array_c10 * a, gfc_array_c10 * b);
+export_proto(matmul_c10);
+
+void
+matmul_c10 (gfc_array_c10 * retarray, gfc_array_c10 * a, gfc_array_c10 * b)
+{
+ GFC_COMPLEX_10 *abase;
+ GFC_COMPLEX_10 *bbase;
+ GFC_COMPLEX_10 *dest;
+
+ index_type rxstride, rystride, axstride, aystride, bxstride, bystride;
+ index_type x, y, n, count, xcount, ycount;
+
+ assert (GFC_DESCRIPTOR_RANK (a) == 2
+ || GFC_DESCRIPTOR_RANK (b) == 2);
+
+/* C[xcount,ycount] = A[xcount, count] * B[count,ycount]
+
+ Either A or B (but not both) can be rank 1:
+
+ o One-dimensional argument A is implicitly treated as a row matrix
+ dimensioned [1,count], so xcount=1.
+
+ o One-dimensional argument B is implicitly treated as a column matrix
+ dimensioned [count, 1], so ycount=1.
+ */
+
+ if (retarray->data == NULL)
+ {
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+ retarray->dim[0].stride = 1;
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+ retarray->dim[0].stride = 1;
+ }
+ else
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+ retarray->dim[0].stride = 1;
+
+ retarray->dim[1].lbound = 0;
+ retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+ retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_COMPLEX_10) * size0 ((array_t *) retarray));
+ retarray->offset = 0;
+ }
+
+ abase = a->data;
+ bbase = b->data;
+ dest = retarray->data;
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ if (a->dim[0].stride == 0)
+ a->dim[0].stride = 1;
+ if (b->dim[0].stride == 0)
+ b->dim[0].stride = 1;
+
+
+ if (GFC_DESCRIPTOR_RANK (retarray) == 1)
+ {
+ /* One-dimensional result may be addressed in the code below
+ either as a row or a column matrix. We want both cases to
+ work. */
+ rxstride = rystride = retarray->dim[0].stride;
+ }
+ else
+ {
+ rxstride = retarray->dim[0].stride;
+ rystride = retarray->dim[1].stride;
+ }
+
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ /* Treat it as a a row matrix A[1,count]. */
+ axstride = a->dim[0].stride;
+ aystride = 1;
+
+ xcount = 1;
+ count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ }
+ else
+ {
+ axstride = a->dim[0].stride;
+ aystride = a->dim[1].stride;
+
+ count = a->dim[1].ubound + 1 - a->dim[1].lbound;
+ xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ }
+
+ assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
+
+ if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ /* Treat it as a column matrix B[count,1] */
+ bxstride = b->dim[0].stride;
+
+ /* bystride should never be used for 1-dimensional b.
+ in case it is we want it to cause a segfault, rather than
+ an incorrect result. */
+ bystride = 0xDEADBEEF;
+ ycount = 1;
+ }
+ else
+ {
+ bxstride = b->dim[0].stride;
+ bystride = b->dim[1].stride;
+ ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ }
+
+ abase = a->data;
+ bbase = b->data;
+ dest = retarray->data;
+
+ if (rxstride == 1 && axstride == 1 && bxstride == 1)
+ {
+ GFC_COMPLEX_10 *bbase_y;
+ GFC_COMPLEX_10 *dest_y;
+ GFC_COMPLEX_10 *abase_n;
+ GFC_COMPLEX_10 bbase_yn;
+
+ if (rystride == ycount)
+ memset (dest, 0, (sizeof (GFC_COMPLEX_10) * size0((array_t *) retarray)));
+ else
+ {
+ for (y = 0; y < ycount; y++)
+ for (x = 0; x < xcount; x++)
+ dest[x + y*rystride] = (GFC_COMPLEX_10)0;
+ }
+
+ for (y = 0; y < ycount; y++)
+ {
+ bbase_y = bbase + y*bystride;
+ dest_y = dest + y*rystride;
+ for (n = 0; n < count; n++)
+ {
+ abase_n = abase + n*aystride;
+ bbase_yn = bbase_y[n];
+ for (x = 0; x < xcount; x++)
+ {
+ dest_y[x] += abase_n[x] * bbase_yn;
+ }
+ }
+ }
+ }
+ else
+ {
+ for (y = 0; y < ycount; y++)
+ for (x = 0; x < xcount; x++)
+ dest[x*rxstride + y*rystride] = (GFC_COMPLEX_10)0;
+
+ for (y = 0; y < ycount; y++)
+ for (n = 0; n < count; n++)
+ for (x = 0; x < xcount; x++)
+ /* dest[x,y] += a[x,n] * b[n,y] */
+ dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MATMUL intrinsic
+ Copyright 2002, 2005 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+
+/* This is a C version of the following fortran pseudo-code. The key
+ point is the loop order -- we access all arrays column-first, which
+ improves the performance enough to boost galgel spec score by 50%.
+
+ DIMENSION A(M,COUNT), B(COUNT,N), C(M,N)
+ C = 0
+ DO J=1,N
+ DO K=1,COUNT
+ DO I=1,M
+ C(I,J) = C(I,J)+A(I,K)*B(K,J)
+*/
+
+extern void matmul_c16 (gfc_array_c16 * retarray, gfc_array_c16 * a, gfc_array_c16 * b);
+export_proto(matmul_c16);
+
+void
+matmul_c16 (gfc_array_c16 * retarray, gfc_array_c16 * a, gfc_array_c16 * b)
+{
+ GFC_COMPLEX_16 *abase;
+ GFC_COMPLEX_16 *bbase;
+ GFC_COMPLEX_16 *dest;
+
+ index_type rxstride, rystride, axstride, aystride, bxstride, bystride;
+ index_type x, y, n, count, xcount, ycount;
+
+ assert (GFC_DESCRIPTOR_RANK (a) == 2
+ || GFC_DESCRIPTOR_RANK (b) == 2);
+
+/* C[xcount,ycount] = A[xcount, count] * B[count,ycount]
+
+ Either A or B (but not both) can be rank 1:
+
+ o One-dimensional argument A is implicitly treated as a row matrix
+ dimensioned [1,count], so xcount=1.
+
+ o One-dimensional argument B is implicitly treated as a column matrix
+ dimensioned [count, 1], so ycount=1.
+ */
+
+ if (retarray->data == NULL)
+ {
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+ retarray->dim[0].stride = 1;
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+ retarray->dim[0].stride = 1;
+ }
+ else
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+ retarray->dim[0].stride = 1;
+
+ retarray->dim[1].lbound = 0;
+ retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+ retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_COMPLEX_16) * size0 ((array_t *) retarray));
+ retarray->offset = 0;
+ }
+
+ abase = a->data;
+ bbase = b->data;
+ dest = retarray->data;
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ if (a->dim[0].stride == 0)
+ a->dim[0].stride = 1;
+ if (b->dim[0].stride == 0)
+ b->dim[0].stride = 1;
+
+
+ if (GFC_DESCRIPTOR_RANK (retarray) == 1)
+ {
+ /* One-dimensional result may be addressed in the code below
+ either as a row or a column matrix. We want both cases to
+ work. */
+ rxstride = rystride = retarray->dim[0].stride;
+ }
+ else
+ {
+ rxstride = retarray->dim[0].stride;
+ rystride = retarray->dim[1].stride;
+ }
+
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ /* Treat it as a a row matrix A[1,count]. */
+ axstride = a->dim[0].stride;
+ aystride = 1;
+
+ xcount = 1;
+ count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ }
+ else
+ {
+ axstride = a->dim[0].stride;
+ aystride = a->dim[1].stride;
+
+ count = a->dim[1].ubound + 1 - a->dim[1].lbound;
+ xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ }
+
+ assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
+
+ if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ /* Treat it as a column matrix B[count,1] */
+ bxstride = b->dim[0].stride;
+
+ /* bystride should never be used for 1-dimensional b.
+ in case it is we want it to cause a segfault, rather than
+ an incorrect result. */
+ bystride = 0xDEADBEEF;
+ ycount = 1;
+ }
+ else
+ {
+ bxstride = b->dim[0].stride;
+ bystride = b->dim[1].stride;
+ ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ }
+
+ abase = a->data;
+ bbase = b->data;
+ dest = retarray->data;
+
+ if (rxstride == 1 && axstride == 1 && bxstride == 1)
+ {
+ GFC_COMPLEX_16 *bbase_y;
+ GFC_COMPLEX_16 *dest_y;
+ GFC_COMPLEX_16 *abase_n;
+ GFC_COMPLEX_16 bbase_yn;
+
+ if (rystride == ycount)
+ memset (dest, 0, (sizeof (GFC_COMPLEX_16) * size0((array_t *) retarray)));
+ else
+ {
+ for (y = 0; y < ycount; y++)
+ for (x = 0; x < xcount; x++)
+ dest[x + y*rystride] = (GFC_COMPLEX_16)0;
+ }
+
+ for (y = 0; y < ycount; y++)
+ {
+ bbase_y = bbase + y*bystride;
+ dest_y = dest + y*rystride;
+ for (n = 0; n < count; n++)
+ {
+ abase_n = abase + n*aystride;
+ bbase_yn = bbase_y[n];
+ for (x = 0; x < xcount; x++)
+ {
+ dest_y[x] += abase_n[x] * bbase_yn;
+ }
+ }
+ }
+ }
+ else
+ {
+ for (y = 0; y < ycount; y++)
+ for (x = 0; x < xcount; x++)
+ dest[x*rxstride + y*rystride] = (GFC_COMPLEX_16)0;
+
+ for (y = 0; y < ycount; y++)
+ for (n = 0; n < count; n++)
+ for (x = 0; x < xcount; x++)
+ /* dest[x,y] += a[x,n] * b[n,y] */
+ dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
+ }
+}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_COMPLEX_4)
+
/* This is a C version of the following fortran pseudo-code. The key
point is the loop order -- we access all arrays column-first, which
improves the performance enough to boost galgel spec score by 50%.
dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
}
}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_COMPLEX_8)
+
/* This is a C version of the following fortran pseudo-code. The key
point is the loop order -- we access all arrays column-first, which
improves the performance enough to boost galgel spec score by 50%.
dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
}
}
+
+#endif
--- /dev/null
+/* Implementation of the MATMUL intrinsic
+ Copyright 2002, 2005 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+/* This is a C version of the following fortran pseudo-code. The key
+ point is the loop order -- we access all arrays column-first, which
+ improves the performance enough to boost galgel spec score by 50%.
+
+ DIMENSION A(M,COUNT), B(COUNT,N), C(M,N)
+ C = 0
+ DO J=1,N
+ DO K=1,COUNT
+ DO I=1,M
+ C(I,J) = C(I,J)+A(I,K)*B(K,J)
+*/
+
+extern void matmul_i16 (gfc_array_i16 * retarray, gfc_array_i16 * a, gfc_array_i16 * b);
+export_proto(matmul_i16);
+
+void
+matmul_i16 (gfc_array_i16 * retarray, gfc_array_i16 * a, gfc_array_i16 * b)
+{
+ GFC_INTEGER_16 *abase;
+ GFC_INTEGER_16 *bbase;
+ GFC_INTEGER_16 *dest;
+
+ index_type rxstride, rystride, axstride, aystride, bxstride, bystride;
+ index_type x, y, n, count, xcount, ycount;
+
+ assert (GFC_DESCRIPTOR_RANK (a) == 2
+ || GFC_DESCRIPTOR_RANK (b) == 2);
+
+/* C[xcount,ycount] = A[xcount, count] * B[count,ycount]
+
+ Either A or B (but not both) can be rank 1:
+
+ o One-dimensional argument A is implicitly treated as a row matrix
+ dimensioned [1,count], so xcount=1.
+
+ o One-dimensional argument B is implicitly treated as a column matrix
+ dimensioned [count, 1], so ycount=1.
+ */
+
+ if (retarray->data == NULL)
+ {
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+ retarray->dim[0].stride = 1;
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+ retarray->dim[0].stride = 1;
+ }
+ else
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+ retarray->dim[0].stride = 1;
+
+ retarray->dim[1].lbound = 0;
+ retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+ retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16) * size0 ((array_t *) retarray));
+ retarray->offset = 0;
+ }
+
+ abase = a->data;
+ bbase = b->data;
+ dest = retarray->data;
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ if (a->dim[0].stride == 0)
+ a->dim[0].stride = 1;
+ if (b->dim[0].stride == 0)
+ b->dim[0].stride = 1;
+
+
+ if (GFC_DESCRIPTOR_RANK (retarray) == 1)
+ {
+ /* One-dimensional result may be addressed in the code below
+ either as a row or a column matrix. We want both cases to
+ work. */
+ rxstride = rystride = retarray->dim[0].stride;
+ }
+ else
+ {
+ rxstride = retarray->dim[0].stride;
+ rystride = retarray->dim[1].stride;
+ }
+
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ /* Treat it as a a row matrix A[1,count]. */
+ axstride = a->dim[0].stride;
+ aystride = 1;
+
+ xcount = 1;
+ count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ }
+ else
+ {
+ axstride = a->dim[0].stride;
+ aystride = a->dim[1].stride;
+
+ count = a->dim[1].ubound + 1 - a->dim[1].lbound;
+ xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ }
+
+ assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
+
+ if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ /* Treat it as a column matrix B[count,1] */
+ bxstride = b->dim[0].stride;
+
+ /* bystride should never be used for 1-dimensional b.
+ in case it is we want it to cause a segfault, rather than
+ an incorrect result. */
+ bystride = 0xDEADBEEF;
+ ycount = 1;
+ }
+ else
+ {
+ bxstride = b->dim[0].stride;
+ bystride = b->dim[1].stride;
+ ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ }
+
+ abase = a->data;
+ bbase = b->data;
+ dest = retarray->data;
+
+ if (rxstride == 1 && axstride == 1 && bxstride == 1)
+ {
+ GFC_INTEGER_16 *bbase_y;
+ GFC_INTEGER_16 *dest_y;
+ GFC_INTEGER_16 *abase_n;
+ GFC_INTEGER_16 bbase_yn;
+
+ if (rystride == ycount)
+ memset (dest, 0, (sizeof (GFC_INTEGER_16) * size0((array_t *) retarray)));
+ else
+ {
+ for (y = 0; y < ycount; y++)
+ for (x = 0; x < xcount; x++)
+ dest[x + y*rystride] = (GFC_INTEGER_16)0;
+ }
+
+ for (y = 0; y < ycount; y++)
+ {
+ bbase_y = bbase + y*bystride;
+ dest_y = dest + y*rystride;
+ for (n = 0; n < count; n++)
+ {
+ abase_n = abase + n*aystride;
+ bbase_yn = bbase_y[n];
+ for (x = 0; x < xcount; x++)
+ {
+ dest_y[x] += abase_n[x] * bbase_yn;
+ }
+ }
+ }
+ }
+ else
+ {
+ for (y = 0; y < ycount; y++)
+ for (x = 0; x < xcount; x++)
+ dest[x*rxstride + y*rystride] = (GFC_INTEGER_16)0;
+
+ for (y = 0; y < ycount; y++)
+ for (n = 0; n < count; n++)
+ for (x = 0; x < xcount; x++)
+ /* dest[x,y] += a[x,n] * b[n,y] */
+ dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
+ }
+}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4)
+
/* This is a C version of the following fortran pseudo-code. The key
point is the loop order -- we access all arrays column-first, which
improves the performance enough to boost galgel spec score by 50%.
dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
}
}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8)
+
/* This is a C version of the following fortran pseudo-code. The key
point is the loop order -- we access all arrays column-first, which
improves the performance enough to boost galgel spec score by 50%.
dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
}
}
+
+#endif
--- /dev/null
+/* Implementation of the MATMUL intrinsic
+ Copyright 2002, 2005 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_LOGICAL_16)
+
+/* Dimensions: retarray(x,y) a(x, count) b(count,y).
+ Either a or b can be rank 1. In this case x or y is 1. */
+
+extern void matmul_l16 (gfc_array_l16 *, gfc_array_l4 *, gfc_array_l4 *);
+export_proto(matmul_l16);
+
+void
+matmul_l16 (gfc_array_l16 * retarray, gfc_array_l4 * a, gfc_array_l4 * b)
+{
+ GFC_INTEGER_4 *abase;
+ GFC_INTEGER_4 *bbase;
+ GFC_LOGICAL_16 *dest;
+ index_type rxstride;
+ index_type rystride;
+ index_type xcount;
+ index_type ycount;
+ index_type xstride;
+ index_type ystride;
+ index_type x;
+ index_type y;
+
+ GFC_INTEGER_4 *pa;
+ GFC_INTEGER_4 *pb;
+ index_type astride;
+ index_type bstride;
+ index_type count;
+ index_type n;
+
+ assert (GFC_DESCRIPTOR_RANK (a) == 2
+ || GFC_DESCRIPTOR_RANK (b) == 2);
+
+ if (retarray->data == NULL)
+ {
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+ retarray->dim[0].stride = 1;
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+ retarray->dim[0].stride = 1;
+ }
+ else
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+ retarray->dim[0].stride = 1;
+
+ retarray->dim[1].lbound = 0;
+ retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+ retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_LOGICAL_16) * size0 ((array_t *) retarray));
+ retarray->offset = 0;
+ }
+
+ abase = a->data;
+ if (GFC_DESCRIPTOR_SIZE (a) != 4)
+ {
+ assert (GFC_DESCRIPTOR_SIZE (a) == 8);
+ abase = GFOR_POINTER_L8_TO_L4 (abase);
+ }
+ bbase = b->data;
+ if (GFC_DESCRIPTOR_SIZE (b) != 4)
+ {
+ assert (GFC_DESCRIPTOR_SIZE (b) == 8);
+ bbase = GFOR_POINTER_L8_TO_L4 (bbase);
+ }
+ dest = retarray->data;
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ if (a->dim[0].stride == 0)
+ a->dim[0].stride = 1;
+ if (b->dim[0].stride == 0)
+ b->dim[0].stride = 1;
+
+
+ if (GFC_DESCRIPTOR_RANK (retarray) == 1)
+ {
+ rxstride = retarray->dim[0].stride;
+ rystride = rxstride;
+ }
+ else
+ {
+ rxstride = retarray->dim[0].stride;
+ rystride = retarray->dim[1].stride;
+ }
+
+ /* If we have rank 1 parameters, zero the absent stride, and set the size to
+ one. */
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ astride = a->dim[0].stride;
+ count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ xstride = 0;
+ rxstride = 0;
+ xcount = 1;
+ }
+ else
+ {
+ astride = a->dim[1].stride;
+ count = a->dim[1].ubound + 1 - a->dim[1].lbound;
+ xstride = a->dim[0].stride;
+ xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ }
+ if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ bstride = b->dim[0].stride;
+ assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
+ ystride = 0;
+ rystride = 0;
+ ycount = 1;
+ }
+ else
+ {
+ bstride = b->dim[0].stride;
+ assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
+ ystride = b->dim[1].stride;
+ ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ }
+
+ for (y = 0; y < ycount; y++)
+ {
+ for (x = 0; x < xcount; x++)
+ {
+ /* Do the summation for this element. For real and integer types
+ this is the same as DOT_PRODUCT. For complex types we use do
+ a*b, not conjg(a)*b. */
+ pa = abase;
+ pb = bbase;
+ *dest = 0;
+
+ for (n = 0; n < count; n++)
+ {
+ if (*pa && *pb)
+ {
+ *dest = 1;
+ break;
+ }
+ pa += astride;
+ pb += bstride;
+ }
+
+ dest += rxstride;
+ abase += xstride;
+ }
+ abase -= xstride * xcount;
+ bbase += ystride;
+ dest += rystride - (rxstride * xcount);
+ }
+}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_LOGICAL_4)
+
/* Dimensions: retarray(x,y) a(x, count) b(count,y).
Either a or b can be rank 1. In this case x or y is 1. */
dest += rystride - (rxstride * xcount);
}
}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_LOGICAL_8)
+
/* Dimensions: retarray(x,y) a(x, count) b(count,y).
Either a or b can be rank 1. In this case x or y is 1. */
dest += rystride - (rxstride * xcount);
}
}
+
+#endif
--- /dev/null
+/* Implementation of the MATMUL intrinsic
+ Copyright 2002, 2005 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_REAL_10)
+
+/* This is a C version of the following fortran pseudo-code. The key
+ point is the loop order -- we access all arrays column-first, which
+ improves the performance enough to boost galgel spec score by 50%.
+
+ DIMENSION A(M,COUNT), B(COUNT,N), C(M,N)
+ C = 0
+ DO J=1,N
+ DO K=1,COUNT
+ DO I=1,M
+ C(I,J) = C(I,J)+A(I,K)*B(K,J)
+*/
+
+extern void matmul_r10 (gfc_array_r10 * retarray, gfc_array_r10 * a, gfc_array_r10 * b);
+export_proto(matmul_r10);
+
+void
+matmul_r10 (gfc_array_r10 * retarray, gfc_array_r10 * a, gfc_array_r10 * b)
+{
+ GFC_REAL_10 *abase;
+ GFC_REAL_10 *bbase;
+ GFC_REAL_10 *dest;
+
+ index_type rxstride, rystride, axstride, aystride, bxstride, bystride;
+ index_type x, y, n, count, xcount, ycount;
+
+ assert (GFC_DESCRIPTOR_RANK (a) == 2
+ || GFC_DESCRIPTOR_RANK (b) == 2);
+
+/* C[xcount,ycount] = A[xcount, count] * B[count,ycount]
+
+ Either A or B (but not both) can be rank 1:
+
+ o One-dimensional argument A is implicitly treated as a row matrix
+ dimensioned [1,count], so xcount=1.
+
+ o One-dimensional argument B is implicitly treated as a column matrix
+ dimensioned [count, 1], so ycount=1.
+ */
+
+ if (retarray->data == NULL)
+ {
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+ retarray->dim[0].stride = 1;
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+ retarray->dim[0].stride = 1;
+ }
+ else
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+ retarray->dim[0].stride = 1;
+
+ retarray->dim[1].lbound = 0;
+ retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+ retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_REAL_10) * size0 ((array_t *) retarray));
+ retarray->offset = 0;
+ }
+
+ abase = a->data;
+ bbase = b->data;
+ dest = retarray->data;
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ if (a->dim[0].stride == 0)
+ a->dim[0].stride = 1;
+ if (b->dim[0].stride == 0)
+ b->dim[0].stride = 1;
+
+
+ if (GFC_DESCRIPTOR_RANK (retarray) == 1)
+ {
+ /* One-dimensional result may be addressed in the code below
+ either as a row or a column matrix. We want both cases to
+ work. */
+ rxstride = rystride = retarray->dim[0].stride;
+ }
+ else
+ {
+ rxstride = retarray->dim[0].stride;
+ rystride = retarray->dim[1].stride;
+ }
+
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ /* Treat it as a a row matrix A[1,count]. */
+ axstride = a->dim[0].stride;
+ aystride = 1;
+
+ xcount = 1;
+ count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ }
+ else
+ {
+ axstride = a->dim[0].stride;
+ aystride = a->dim[1].stride;
+
+ count = a->dim[1].ubound + 1 - a->dim[1].lbound;
+ xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ }
+
+ assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
+
+ if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ /* Treat it as a column matrix B[count,1] */
+ bxstride = b->dim[0].stride;
+
+ /* bystride should never be used for 1-dimensional b.
+ in case it is we want it to cause a segfault, rather than
+ an incorrect result. */
+ bystride = 0xDEADBEEF;
+ ycount = 1;
+ }
+ else
+ {
+ bxstride = b->dim[0].stride;
+ bystride = b->dim[1].stride;
+ ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ }
+
+ abase = a->data;
+ bbase = b->data;
+ dest = retarray->data;
+
+ if (rxstride == 1 && axstride == 1 && bxstride == 1)
+ {
+ GFC_REAL_10 *bbase_y;
+ GFC_REAL_10 *dest_y;
+ GFC_REAL_10 *abase_n;
+ GFC_REAL_10 bbase_yn;
+
+ if (rystride == ycount)
+ memset (dest, 0, (sizeof (GFC_REAL_10) * size0((array_t *) retarray)));
+ else
+ {
+ for (y = 0; y < ycount; y++)
+ for (x = 0; x < xcount; x++)
+ dest[x + y*rystride] = (GFC_REAL_10)0;
+ }
+
+ for (y = 0; y < ycount; y++)
+ {
+ bbase_y = bbase + y*bystride;
+ dest_y = dest + y*rystride;
+ for (n = 0; n < count; n++)
+ {
+ abase_n = abase + n*aystride;
+ bbase_yn = bbase_y[n];
+ for (x = 0; x < xcount; x++)
+ {
+ dest_y[x] += abase_n[x] * bbase_yn;
+ }
+ }
+ }
+ }
+ else
+ {
+ for (y = 0; y < ycount; y++)
+ for (x = 0; x < xcount; x++)
+ dest[x*rxstride + y*rystride] = (GFC_REAL_10)0;
+
+ for (y = 0; y < ycount; y++)
+ for (n = 0; n < count; n++)
+ for (x = 0; x < xcount; x++)
+ /* dest[x,y] += a[x,n] * b[n,y] */
+ dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MATMUL intrinsic
+ Copyright 2002, 2005 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_REAL_16)
+
+/* This is a C version of the following fortran pseudo-code. The key
+ point is the loop order -- we access all arrays column-first, which
+ improves the performance enough to boost galgel spec score by 50%.
+
+ DIMENSION A(M,COUNT), B(COUNT,N), C(M,N)
+ C = 0
+ DO J=1,N
+ DO K=1,COUNT
+ DO I=1,M
+ C(I,J) = C(I,J)+A(I,K)*B(K,J)
+*/
+
+extern void matmul_r16 (gfc_array_r16 * retarray, gfc_array_r16 * a, gfc_array_r16 * b);
+export_proto(matmul_r16);
+
+void
+matmul_r16 (gfc_array_r16 * retarray, gfc_array_r16 * a, gfc_array_r16 * b)
+{
+ GFC_REAL_16 *abase;
+ GFC_REAL_16 *bbase;
+ GFC_REAL_16 *dest;
+
+ index_type rxstride, rystride, axstride, aystride, bxstride, bystride;
+ index_type x, y, n, count, xcount, ycount;
+
+ assert (GFC_DESCRIPTOR_RANK (a) == 2
+ || GFC_DESCRIPTOR_RANK (b) == 2);
+
+/* C[xcount,ycount] = A[xcount, count] * B[count,ycount]
+
+ Either A or B (but not both) can be rank 1:
+
+ o One-dimensional argument A is implicitly treated as a row matrix
+ dimensioned [1,count], so xcount=1.
+
+ o One-dimensional argument B is implicitly treated as a column matrix
+ dimensioned [count, 1], so ycount=1.
+ */
+
+ if (retarray->data == NULL)
+ {
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+ retarray->dim[0].stride = 1;
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+ retarray->dim[0].stride = 1;
+ }
+ else
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+ retarray->dim[0].stride = 1;
+
+ retarray->dim[1].lbound = 0;
+ retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+ retarray->dim[1].stride = retarray->dim[0].ubound+1;
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_REAL_16) * size0 ((array_t *) retarray));
+ retarray->offset = 0;
+ }
+
+ abase = a->data;
+ bbase = b->data;
+ dest = retarray->data;
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ if (a->dim[0].stride == 0)
+ a->dim[0].stride = 1;
+ if (b->dim[0].stride == 0)
+ b->dim[0].stride = 1;
+
+
+ if (GFC_DESCRIPTOR_RANK (retarray) == 1)
+ {
+ /* One-dimensional result may be addressed in the code below
+ either as a row or a column matrix. We want both cases to
+ work. */
+ rxstride = rystride = retarray->dim[0].stride;
+ }
+ else
+ {
+ rxstride = retarray->dim[0].stride;
+ rystride = retarray->dim[1].stride;
+ }
+
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ /* Treat it as a a row matrix A[1,count]. */
+ axstride = a->dim[0].stride;
+ aystride = 1;
+
+ xcount = 1;
+ count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ }
+ else
+ {
+ axstride = a->dim[0].stride;
+ aystride = a->dim[1].stride;
+
+ count = a->dim[1].ubound + 1 - a->dim[1].lbound;
+ xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ }
+
+ assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
+
+ if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ /* Treat it as a column matrix B[count,1] */
+ bxstride = b->dim[0].stride;
+
+ /* bystride should never be used for 1-dimensional b.
+ in case it is we want it to cause a segfault, rather than
+ an incorrect result. */
+ bystride = 0xDEADBEEF;
+ ycount = 1;
+ }
+ else
+ {
+ bxstride = b->dim[0].stride;
+ bystride = b->dim[1].stride;
+ ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ }
+
+ abase = a->data;
+ bbase = b->data;
+ dest = retarray->data;
+
+ if (rxstride == 1 && axstride == 1 && bxstride == 1)
+ {
+ GFC_REAL_16 *bbase_y;
+ GFC_REAL_16 *dest_y;
+ GFC_REAL_16 *abase_n;
+ GFC_REAL_16 bbase_yn;
+
+ if (rystride == ycount)
+ memset (dest, 0, (sizeof (GFC_REAL_16) * size0((array_t *) retarray)));
+ else
+ {
+ for (y = 0; y < ycount; y++)
+ for (x = 0; x < xcount; x++)
+ dest[x + y*rystride] = (GFC_REAL_16)0;
+ }
+
+ for (y = 0; y < ycount; y++)
+ {
+ bbase_y = bbase + y*bystride;
+ dest_y = dest + y*rystride;
+ for (n = 0; n < count; n++)
+ {
+ abase_n = abase + n*aystride;
+ bbase_yn = bbase_y[n];
+ for (x = 0; x < xcount; x++)
+ {
+ dest_y[x] += abase_n[x] * bbase_yn;
+ }
+ }
+ }
+ }
+ else
+ {
+ for (y = 0; y < ycount; y++)
+ for (x = 0; x < xcount; x++)
+ dest[x*rxstride + y*rystride] = (GFC_REAL_16)0;
+
+ for (y = 0; y < ycount; y++)
+ for (n = 0; n < count; n++)
+ for (x = 0; x < xcount; x++)
+ /* dest[x,y] += a[x,n] * b[n,y] */
+ dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
+ }
+}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_4)
+
/* This is a C version of the following fortran pseudo-code. The key
point is the loop order -- we access all arrays column-first, which
improves the performance enough to boost galgel spec score by 50%.
dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
}
}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_8)
+
/* This is a C version of the following fortran pseudo-code. The key
point is the loop order -- we access all arrays column-first, which
improves the performance enough to boost galgel spec score by 50%.
dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
}
}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array);
+export_proto(maxloc0_16_i16);
+
+void
+maxloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_16 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_INTEGER_16 maxval;
+
+ maxval = -GFC_INTEGER_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc0_16_i16 (gfc_array_i16 *, gfc_array_i16 *, gfc_array_l4 *);
+export_proto(mmaxloc0_16_i16);
+
+void
+mmaxloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_16 *dest;
+ GFC_INTEGER_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_INTEGER_16 maxval;
+
+ maxval = -GFC_INTEGER_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc0_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 *array);
+export_proto(maxloc0_16_i4);
+
+void
+maxloc0_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_4 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_INTEGER_4 maxval;
+
+ maxval = -GFC_INTEGER_4_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc0_16_i4 (gfc_array_i16 *, gfc_array_i4 *, gfc_array_l4 *);
+export_proto(mmaxloc0_16_i4);
+
+void
+mmaxloc0_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_16 *dest;
+ GFC_INTEGER_4 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_INTEGER_4 maxval;
+
+ maxval = -GFC_INTEGER_4_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc0_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 *array);
+export_proto(maxloc0_16_i8);
+
+void
+maxloc0_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_8 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_INTEGER_8 maxval;
+
+ maxval = -GFC_INTEGER_8_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc0_16_i8 (gfc_array_i16 *, gfc_array_i8 *, gfc_array_l4 *);
+export_proto(mmaxloc0_16_i8);
+
+void
+mmaxloc0_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_16 *dest;
+ GFC_INTEGER_8 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_INTEGER_8 maxval;
+
+ maxval = -GFC_INTEGER_8_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc0_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 *array);
+export_proto(maxloc0_16_r10);
+
+void
+maxloc0_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_REAL_10 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_10 maxval;
+
+ maxval = -GFC_REAL_10_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc0_16_r10 (gfc_array_i16 *, gfc_array_r10 *, gfc_array_l4 *);
+export_proto(mmaxloc0_16_r10);
+
+void
+mmaxloc0_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_16 *dest;
+ GFC_REAL_10 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_10 maxval;
+
+ maxval = -GFC_REAL_10_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc0_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 *array);
+export_proto(maxloc0_16_r16);
+
+void
+maxloc0_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_REAL_16 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_16 maxval;
+
+ maxval = -GFC_REAL_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc0_16_r16 (gfc_array_i16 *, gfc_array_r16 *, gfc_array_l4 *);
+export_proto(mmaxloc0_16_r16);
+
+void
+mmaxloc0_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_16 *dest;
+ GFC_REAL_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_16 maxval;
+
+ maxval = -GFC_REAL_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc0_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 *array);
+export_proto(maxloc0_16_r4);
+
+void
+maxloc0_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_REAL_4 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_4 maxval;
+
+ maxval = -GFC_REAL_4_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc0_16_r4 (gfc_array_i16 *, gfc_array_r4 *, gfc_array_l4 *);
+export_proto(mmaxloc0_16_r4);
+
+void
+mmaxloc0_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_16 *dest;
+ GFC_REAL_4 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_4 maxval;
+
+ maxval = -GFC_REAL_4_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc0_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 *array);
+export_proto(maxloc0_16_r8);
+
+void
+maxloc0_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_REAL_8 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_8 maxval;
+
+ maxval = -GFC_REAL_8_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc0_16_r8 (gfc_array_i16 *, gfc_array_r8 *, gfc_array_l4 *);
+export_proto(mmaxloc0_16_r8);
+
+void
+mmaxloc0_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_16 *dest;
+ GFC_REAL_8 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_8 maxval;
+
+ maxval = -GFC_REAL_8_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void maxloc0_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 *array);
+export_proto(maxloc0_4_i16);
+
+void
+maxloc0_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_16 *base;
+ GFC_INTEGER_4 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_INTEGER_16 maxval;
+
+ maxval = -GFC_INTEGER_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc0_4_i16 (gfc_array_i4 *, gfc_array_i16 *, gfc_array_l4 *);
+export_proto(mmaxloc0_4_i16);
+
+void
+mmaxloc0_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_4 *dest;
+ GFC_INTEGER_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_INTEGER_16 maxval;
+
+ maxval = -GFC_INTEGER_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
extern void maxloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array);
export_proto(maxloc0_4_i4);
}
}
}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4)
+
extern void maxloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array);
export_proto(maxloc0_4_i8);
}
}
}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void maxloc0_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 *array);
+export_proto(maxloc0_4_r10);
+
+void
+maxloc0_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_REAL_10 *base;
+ GFC_INTEGER_4 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_10 maxval;
+
+ maxval = -GFC_REAL_10_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc0_4_r10 (gfc_array_i4 *, gfc_array_r10 *, gfc_array_l4 *);
+export_proto(mmaxloc0_4_r10);
+
+void
+mmaxloc0_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_4 *dest;
+ GFC_REAL_10 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_10 maxval;
+
+ maxval = -GFC_REAL_10_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void maxloc0_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 *array);
+export_proto(maxloc0_4_r16);
+
+void
+maxloc0_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_REAL_16 *base;
+ GFC_INTEGER_4 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_16 maxval;
+
+ maxval = -GFC_REAL_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc0_4_r16 (gfc_array_i4 *, gfc_array_r16 *, gfc_array_l4 *);
+export_proto(mmaxloc0_4_r16);
+
+void
+mmaxloc0_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_4 *dest;
+ GFC_REAL_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_16 maxval;
+
+ maxval = -GFC_REAL_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_4)
+
extern void maxloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array);
export_proto(maxloc0_4_r4);
}
}
}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_4)
+
extern void maxloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array);
export_proto(maxloc0_4_r8);
}
}
}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void maxloc0_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 *array);
+export_proto(maxloc0_8_i16);
+
+void
+maxloc0_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_16 *base;
+ GFC_INTEGER_8 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_INTEGER_16 maxval;
+
+ maxval = -GFC_INTEGER_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc0_8_i16 (gfc_array_i8 *, gfc_array_i16 *, gfc_array_l4 *);
+export_proto(mmaxloc0_8_i16);
+
+void
+mmaxloc0_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_8 *dest;
+ GFC_INTEGER_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_INTEGER_16 maxval;
+
+ maxval = -GFC_INTEGER_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
+
extern void maxloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array);
export_proto(maxloc0_8_i4);
}
}
}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
extern void maxloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array);
export_proto(maxloc0_8_i8);
}
}
}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void maxloc0_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 *array);
+export_proto(maxloc0_8_r10);
+
+void
+maxloc0_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_REAL_10 *base;
+ GFC_INTEGER_8 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_10 maxval;
+
+ maxval = -GFC_REAL_10_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc0_8_r10 (gfc_array_i8 *, gfc_array_r10 *, gfc_array_l4 *);
+export_proto(mmaxloc0_8_r10);
+
+void
+mmaxloc0_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_8 *dest;
+ GFC_REAL_10 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_10 maxval;
+
+ maxval = -GFC_REAL_10_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void maxloc0_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 *array);
+export_proto(maxloc0_8_r16);
+
+void
+maxloc0_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_REAL_16 *base;
+ GFC_INTEGER_8 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_16 maxval;
+
+ maxval = -GFC_REAL_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc0_8_r16 (gfc_array_i8 *, gfc_array_r16 *, gfc_array_l4 *);
+export_proto(mmaxloc0_8_r16);
+
+void
+mmaxloc0_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_8 *dest;
+ GFC_REAL_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_16 maxval;
+
+ maxval = -GFC_REAL_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base > maxval)
+ {
+ maxval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_8)
+
extern void maxloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array);
export_proto(maxloc0_8_r4);
}
}
}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_8)
+
extern void maxloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array);
export_proto(maxloc0_8_r8);
}
}
}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc1_16_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *);
+export_proto(maxloc1_16_i16);
+
+void
+maxloc1_16_i16 (gfc_array_i16 *retarray, gfc_array_i16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_INTEGER_16 *src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ GFC_INTEGER_16 maxval;
+ maxval = -GFC_INTEGER_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc1_16_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mmaxloc1_16_i16);
+
+void
+mmaxloc1_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *dest;
+ GFC_INTEGER_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_INTEGER_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_INTEGER_16 maxval;
+ maxval = -GFC_INTEGER_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc1_16_i4 (gfc_array_i16 *, gfc_array_i4 *, index_type *);
+export_proto(maxloc1_16_i4);
+
+void
+maxloc1_16_i4 (gfc_array_i16 *retarray, gfc_array_i4 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_4 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_INTEGER_4 *src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ GFC_INTEGER_4 maxval;
+ maxval = -GFC_INTEGER_4_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc1_16_i4 (gfc_array_i16 *, gfc_array_i4 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mmaxloc1_16_i4);
+
+void
+mmaxloc1_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *dest;
+ GFC_INTEGER_4 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_INTEGER_4 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_INTEGER_4 maxval;
+ maxval = -GFC_INTEGER_4_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc1_16_i8 (gfc_array_i16 *, gfc_array_i8 *, index_type *);
+export_proto(maxloc1_16_i8);
+
+void
+maxloc1_16_i8 (gfc_array_i16 *retarray, gfc_array_i8 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_8 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_INTEGER_8 *src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ GFC_INTEGER_8 maxval;
+ maxval = -GFC_INTEGER_8_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc1_16_i8 (gfc_array_i16 *, gfc_array_i8 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mmaxloc1_16_i8);
+
+void
+mmaxloc1_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *dest;
+ GFC_INTEGER_8 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_INTEGER_8 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_INTEGER_8 maxval;
+ maxval = -GFC_INTEGER_8_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc1_16_r10 (gfc_array_i16 *, gfc_array_r10 *, index_type *);
+export_proto(maxloc1_16_r10);
+
+void
+maxloc1_16_r10 (gfc_array_i16 *retarray, gfc_array_r10 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_10 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_10 *src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ GFC_REAL_10 maxval;
+ maxval = -GFC_REAL_10_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc1_16_r10 (gfc_array_i16 *, gfc_array_r10 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mmaxloc1_16_r10);
+
+void
+mmaxloc1_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *dest;
+ GFC_REAL_10 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_10 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_REAL_10 maxval;
+ maxval = -GFC_REAL_10_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc1_16_r16 (gfc_array_i16 *, gfc_array_r16 *, index_type *);
+export_proto(maxloc1_16_r16);
+
+void
+maxloc1_16_r16 (gfc_array_i16 *retarray, gfc_array_r16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_16 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_16 *src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ GFC_REAL_16 maxval;
+ maxval = -GFC_REAL_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc1_16_r16 (gfc_array_i16 *, gfc_array_r16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mmaxloc1_16_r16);
+
+void
+mmaxloc1_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *dest;
+ GFC_REAL_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_REAL_16 maxval;
+ maxval = -GFC_REAL_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc1_16_r4 (gfc_array_i16 *, gfc_array_r4 *, index_type *);
+export_proto(maxloc1_16_r4);
+
+void
+maxloc1_16_r4 (gfc_array_i16 *retarray, gfc_array_r4 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_4 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_4 *src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ GFC_REAL_4 maxval;
+ maxval = -GFC_REAL_4_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc1_16_r4 (gfc_array_i16 *, gfc_array_r4 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mmaxloc1_16_r4);
+
+void
+mmaxloc1_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *dest;
+ GFC_REAL_4 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_4 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_REAL_4 maxval;
+ maxval = -GFC_REAL_4_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc1_16_r8 (gfc_array_i16 *, gfc_array_r8 *, index_type *);
+export_proto(maxloc1_16_r8);
+
+void
+maxloc1_16_r8 (gfc_array_i16 *retarray, gfc_array_r8 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_8 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_8 *src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ GFC_REAL_8 maxval;
+ maxval = -GFC_REAL_8_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc1_16_r8 (gfc_array_i16 *, gfc_array_r8 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mmaxloc1_16_r8);
+
+void
+mmaxloc1_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *dest;
+ GFC_REAL_8 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_8 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_REAL_8 maxval;
+ maxval = -GFC_REAL_8_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void maxloc1_4_i16 (gfc_array_i4 *, gfc_array_i16 *, index_type *);
+export_proto(maxloc1_4_i16);
+
+void
+maxloc1_4_i16 (gfc_array_i4 *retarray, gfc_array_i16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *base;
+ GFC_INTEGER_4 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_4)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_INTEGER_16 *src;
+ GFC_INTEGER_4 result;
+ src = base;
+ {
+
+ GFC_INTEGER_16 maxval;
+ maxval = -GFC_INTEGER_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_4)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc1_4_i16 (gfc_array_i4 *, gfc_array_i16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mmaxloc1_4_i16);
+
+void
+mmaxloc1_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_4 *dest;
+ GFC_INTEGER_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_4)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_INTEGER_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_4 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_INTEGER_16 maxval;
+ maxval = -GFC_INTEGER_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_4)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
+
extern void maxloc1_4_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *);
export_proto(maxloc1_4_i4);
}
}
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4)
+
+
extern void maxloc1_4_i8 (gfc_array_i4 *, gfc_array_i8 *, index_type *);
export_proto(maxloc1_4_i8);
}
}
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void maxloc1_4_r10 (gfc_array_i4 *, gfc_array_r10 *, index_type *);
+export_proto(maxloc1_4_r10);
+
+void
+maxloc1_4_r10 (gfc_array_i4 *retarray, gfc_array_r10 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_10 *base;
+ GFC_INTEGER_4 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_4)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_10 *src;
+ GFC_INTEGER_4 result;
+ src = base;
+ {
+
+ GFC_REAL_10 maxval;
+ maxval = -GFC_REAL_10_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_4)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc1_4_r10 (gfc_array_i4 *, gfc_array_r10 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mmaxloc1_4_r10);
+
+void
+mmaxloc1_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_4 *dest;
+ GFC_REAL_10 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_4)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_10 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_4 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_REAL_10 maxval;
+ maxval = -GFC_REAL_10_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_4)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void maxloc1_4_r16 (gfc_array_i4 *, gfc_array_r16 *, index_type *);
+export_proto(maxloc1_4_r16);
+
+void
+maxloc1_4_r16 (gfc_array_i4 *retarray, gfc_array_r16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_16 *base;
+ GFC_INTEGER_4 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_4)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_16 *src;
+ GFC_INTEGER_4 result;
+ src = base;
+ {
+
+ GFC_REAL_16 maxval;
+ maxval = -GFC_REAL_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_4)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc1_4_r16 (gfc_array_i4 *, gfc_array_r16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mmaxloc1_4_r16);
+
+void
+mmaxloc1_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_4 *dest;
+ GFC_REAL_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_4)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_4 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_REAL_16 maxval;
+ maxval = -GFC_REAL_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_4)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_4)
+
+
extern void maxloc1_4_r4 (gfc_array_i4 *, gfc_array_r4 *, index_type *);
export_proto(maxloc1_4_r4);
}
}
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_4)
+
+
extern void maxloc1_4_r8 (gfc_array_i4 *, gfc_array_r8 *, index_type *);
export_proto(maxloc1_4_r8);
}
}
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void maxloc1_8_i16 (gfc_array_i8 *, gfc_array_i16 *, index_type *);
+export_proto(maxloc1_8_i16);
+
+void
+maxloc1_8_i16 (gfc_array_i8 *retarray, gfc_array_i16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *base;
+ GFC_INTEGER_8 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_8)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_INTEGER_16 *src;
+ GFC_INTEGER_8 result;
+ src = base;
+ {
+
+ GFC_INTEGER_16 maxval;
+ maxval = -GFC_INTEGER_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_8)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc1_8_i16 (gfc_array_i8 *, gfc_array_i16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mmaxloc1_8_i16);
+
+void
+mmaxloc1_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_8 *dest;
+ GFC_INTEGER_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_8)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_INTEGER_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_8 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_INTEGER_16 maxval;
+ maxval = -GFC_INTEGER_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_8)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
+
+
extern void maxloc1_8_i4 (gfc_array_i8 *, gfc_array_i4 *, index_type *);
export_proto(maxloc1_8_i4);
}
}
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
+
extern void maxloc1_8_i8 (gfc_array_i8 *, gfc_array_i8 *, index_type *);
export_proto(maxloc1_8_i8);
}
}
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void maxloc1_8_r10 (gfc_array_i8 *, gfc_array_r10 *, index_type *);
+export_proto(maxloc1_8_r10);
+
+void
+maxloc1_8_r10 (gfc_array_i8 *retarray, gfc_array_r10 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_10 *base;
+ GFC_INTEGER_8 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_8)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_10 *src;
+ GFC_INTEGER_8 result;
+ src = base;
+ {
+
+ GFC_REAL_10 maxval;
+ maxval = -GFC_REAL_10_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_8)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc1_8_r10 (gfc_array_i8 *, gfc_array_r10 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mmaxloc1_8_r10);
+
+void
+mmaxloc1_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_8 *dest;
+ GFC_REAL_10 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_8)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_10 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_8 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_REAL_10 maxval;
+ maxval = -GFC_REAL_10_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_8)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MAXLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void maxloc1_8_r16 (gfc_array_i8 *, gfc_array_r16 *, index_type *);
+export_proto(maxloc1_8_r16);
+
+void
+maxloc1_8_r16 (gfc_array_i8 *retarray, gfc_array_r16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_16 *base;
+ GFC_INTEGER_8 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_8)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_16 *src;
+ GFC_INTEGER_8 result;
+ src = base;
+ {
+
+ GFC_REAL_16 maxval;
+ maxval = -GFC_REAL_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_8)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mmaxloc1_8_r16 (gfc_array_i8 *, gfc_array_r16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mmaxloc1_8_r16);
+
+void
+mmaxloc1_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_8 *dest;
+ GFC_REAL_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_8)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_8 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_REAL_16 maxval;
+ maxval = -GFC_REAL_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src > maxval)
+ {
+ maxval = *src;
+ result = (GFC_INTEGER_8)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_8)
+
+
extern void maxloc1_8_r4 (gfc_array_i8 *, gfc_array_r4 *, index_type *);
export_proto(maxloc1_8_r4);
}
}
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_8)
+
+
extern void maxloc1_8_r8 (gfc_array_i8 *, gfc_array_r8 *, index_type *);
export_proto(maxloc1_8_r8);
}
}
+#endif
--- /dev/null
+/* Implementation of the MAXVAL intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxval_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *);
+export_proto(maxval_i16);
+
+void
+maxval_i16 (gfc_array_i16 *retarray, gfc_array_i16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_INTEGER_16 *src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ result = -GFC_INTEGER_16_HUGE;
+ if (len <= 0)
+ *dest = -GFC_INTEGER_16_HUGE;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src > result)
+ result = *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mmaxval_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mmaxval_i16);
+
+void
+mmaxval_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *dest;
+ GFC_INTEGER_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_INTEGER_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = -GFC_INTEGER_16_HUGE;
+ if (len <= 0)
+ *dest = -GFC_INTEGER_16_HUGE;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src > result)
+ result = *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
+
extern void maxval_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *);
export_proto(maxval_i4);
}
}
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
+
extern void maxval_i8 (gfc_array_i8 *, gfc_array_i8 *, index_type *);
export_proto(maxval_i8);
}
}
+#endif
--- /dev/null
+/* Implementation of the MAXVAL intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_REAL_10)
+
+
+extern void maxval_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *);
+export_proto(maxval_r10);
+
+void
+maxval_r10 (gfc_array_r10 *retarray, gfc_array_r10 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_10 *base;
+ GFC_REAL_10 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_REAL_10)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_10 *src;
+ GFC_REAL_10 result;
+ src = base;
+ {
+
+ result = -GFC_REAL_10_HUGE;
+ if (len <= 0)
+ *dest = -GFC_REAL_10_HUGE;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src > result)
+ result = *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mmaxval_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mmaxval_r10);
+
+void
+mmaxval_r10 (gfc_array_r10 * retarray, gfc_array_r10 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_10 *dest;
+ GFC_REAL_10 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_REAL_10)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_10 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_REAL_10 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = -GFC_REAL_10_HUGE;
+ if (len <= 0)
+ *dest = -GFC_REAL_10_HUGE;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src > result)
+ result = *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MAXVAL intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_REAL_16)
+
+
+extern void maxval_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *);
+export_proto(maxval_r16);
+
+void
+maxval_r16 (gfc_array_r16 *retarray, gfc_array_r16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_16 *base;
+ GFC_REAL_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_REAL_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_16 *src;
+ GFC_REAL_16 result;
+ src = base;
+ {
+
+ result = -GFC_REAL_16_HUGE;
+ if (len <= 0)
+ *dest = -GFC_REAL_16_HUGE;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src > result)
+ result = *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mmaxval_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mmaxval_r16);
+
+void
+mmaxval_r16 (gfc_array_r16 * retarray, gfc_array_r16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_16 *dest;
+ GFC_REAL_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_REAL_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_REAL_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = -GFC_REAL_16_HUGE;
+ if (len <= 0)
+ *dest = -GFC_REAL_16_HUGE;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src > result)
+ result = *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_REAL_4)
+
+
extern void maxval_r4 (gfc_array_r4 *, gfc_array_r4 *, index_type *);
export_proto(maxval_r4);
}
}
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_REAL_8)
+
+
extern void maxval_r8 (gfc_array_r8 *, gfc_array_r8 *, index_type *);
export_proto(maxval_r8);
}
}
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array);
+export_proto(minloc0_16_i16);
+
+void
+minloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_16 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_INTEGER_16 minval;
+
+ minval = GFC_INTEGER_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mminloc0_16_i16 (gfc_array_i16 *, gfc_array_i16 *, gfc_array_l4 *);
+export_proto(mminloc0_16_i16);
+
+void
+mminloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_16 *dest;
+ GFC_INTEGER_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_INTEGER_16 minval;
+
+ minval = GFC_INTEGER_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc0_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 *array);
+export_proto(minloc0_16_i4);
+
+void
+minloc0_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_4 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_INTEGER_4 minval;
+
+ minval = GFC_INTEGER_4_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mminloc0_16_i4 (gfc_array_i16 *, gfc_array_i4 *, gfc_array_l4 *);
+export_proto(mminloc0_16_i4);
+
+void
+mminloc0_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_16 *dest;
+ GFC_INTEGER_4 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_INTEGER_4 minval;
+
+ minval = GFC_INTEGER_4_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc0_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 *array);
+export_proto(minloc0_16_i8);
+
+void
+minloc0_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_8 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_INTEGER_8 minval;
+
+ minval = GFC_INTEGER_8_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mminloc0_16_i8 (gfc_array_i16 *, gfc_array_i8 *, gfc_array_l4 *);
+export_proto(mminloc0_16_i8);
+
+void
+mminloc0_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_16 *dest;
+ GFC_INTEGER_8 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_INTEGER_8 minval;
+
+ minval = GFC_INTEGER_8_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc0_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 *array);
+export_proto(minloc0_16_r10);
+
+void
+minloc0_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_REAL_10 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_10 minval;
+
+ minval = GFC_REAL_10_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mminloc0_16_r10 (gfc_array_i16 *, gfc_array_r10 *, gfc_array_l4 *);
+export_proto(mminloc0_16_r10);
+
+void
+mminloc0_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_16 *dest;
+ GFC_REAL_10 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_10 minval;
+
+ minval = GFC_REAL_10_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc0_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 *array);
+export_proto(minloc0_16_r16);
+
+void
+minloc0_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_REAL_16 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_16 minval;
+
+ minval = GFC_REAL_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mminloc0_16_r16 (gfc_array_i16 *, gfc_array_r16 *, gfc_array_l4 *);
+export_proto(mminloc0_16_r16);
+
+void
+mminloc0_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_16 *dest;
+ GFC_REAL_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_16 minval;
+
+ minval = GFC_REAL_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc0_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 *array);
+export_proto(minloc0_16_r4);
+
+void
+minloc0_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_REAL_4 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_4 minval;
+
+ minval = GFC_REAL_4_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mminloc0_16_r4 (gfc_array_i16 *, gfc_array_r4 *, gfc_array_l4 *);
+export_proto(mminloc0_16_r4);
+
+void
+mminloc0_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_16 *dest;
+ GFC_REAL_4 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_4 minval;
+
+ minval = GFC_REAL_4_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc0_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 *array);
+export_proto(minloc0_16_r8);
+
+void
+minloc0_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_REAL_8 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_8 minval;
+
+ minval = GFC_REAL_8_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mminloc0_16_r8 (gfc_array_i16 *, gfc_array_r8 *, gfc_array_l4 *);
+export_proto(mminloc0_16_r8);
+
+void
+mminloc0_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_16 *dest;
+ GFC_REAL_8 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_8 minval;
+
+ minval = GFC_REAL_8_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void minloc0_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 *array);
+export_proto(minloc0_4_i16);
+
+void
+minloc0_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_16 *base;
+ GFC_INTEGER_4 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_INTEGER_16 minval;
+
+ minval = GFC_INTEGER_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mminloc0_4_i16 (gfc_array_i4 *, gfc_array_i16 *, gfc_array_l4 *);
+export_proto(mminloc0_4_i16);
+
+void
+mminloc0_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_4 *dest;
+ GFC_INTEGER_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_INTEGER_16 minval;
+
+ minval = GFC_INTEGER_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
extern void minloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array);
export_proto(minloc0_4_i4);
}
}
}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4)
+
extern void minloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array);
export_proto(minloc0_4_i8);
}
}
}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void minloc0_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 *array);
+export_proto(minloc0_4_r10);
+
+void
+minloc0_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_REAL_10 *base;
+ GFC_INTEGER_4 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_10 minval;
+
+ minval = GFC_REAL_10_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mminloc0_4_r10 (gfc_array_i4 *, gfc_array_r10 *, gfc_array_l4 *);
+export_proto(mminloc0_4_r10);
+
+void
+mminloc0_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_4 *dest;
+ GFC_REAL_10 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_10 minval;
+
+ minval = GFC_REAL_10_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void minloc0_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 *array);
+export_proto(minloc0_4_r16);
+
+void
+minloc0_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_REAL_16 *base;
+ GFC_INTEGER_4 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_16 minval;
+
+ minval = GFC_REAL_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mminloc0_4_r16 (gfc_array_i4 *, gfc_array_r16 *, gfc_array_l4 *);
+export_proto(mminloc0_4_r16);
+
+void
+mminloc0_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_4 *dest;
+ GFC_REAL_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_16 minval;
+
+ minval = GFC_REAL_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_4)
+
extern void minloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array);
export_proto(minloc0_4_r4);
}
}
}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_4)
+
extern void minloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array);
export_proto(minloc0_4_r8);
}
}
}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void minloc0_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 *array);
+export_proto(minloc0_8_i16);
+
+void
+minloc0_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_16 *base;
+ GFC_INTEGER_8 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_INTEGER_16 minval;
+
+ minval = GFC_INTEGER_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mminloc0_8_i16 (gfc_array_i8 *, gfc_array_i16 *, gfc_array_l4 *);
+export_proto(mminloc0_8_i16);
+
+void
+mminloc0_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_8 *dest;
+ GFC_INTEGER_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_INTEGER_16 minval;
+
+ minval = GFC_INTEGER_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
+
extern void minloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array);
export_proto(minloc0_8_i4);
}
}
}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
extern void minloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array);
export_proto(minloc0_8_i8);
}
}
}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void minloc0_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 *array);
+export_proto(minloc0_8_r10);
+
+void
+minloc0_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_REAL_10 *base;
+ GFC_INTEGER_8 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_10 minval;
+
+ minval = GFC_REAL_10_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mminloc0_8_r10 (gfc_array_i8 *, gfc_array_r10 *, gfc_array_l4 *);
+export_proto(mminloc0_8_r10);
+
+void
+mminloc0_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_8 *dest;
+ GFC_REAL_10 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_10 minval;
+
+ minval = GFC_REAL_10_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void minloc0_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 *array);
+export_proto(minloc0_8_r16);
+
+void
+minloc0_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 *array)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_REAL_16 *base;
+ GFC_INTEGER_8 *dest;
+ index_type rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ base = array->data;
+
+ /* Initialize the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_16 minval;
+
+ minval = GFC_REAL_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ }
+ }
+ }
+ }
+}
+
+
+extern void mminloc0_8_r16 (gfc_array_i8 *, gfc_array_r16 *, gfc_array_l4 *);
+export_proto(mminloc0_8_r16);
+
+void
+mminloc0_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 *array,
+ gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ GFC_INTEGER_8 *dest;
+ GFC_REAL_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ index_type n;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->data == NULL)
+ {
+ retarray->dim[0].lbound = 0;
+ retarray->dim[0].ubound = rank-1;
+ retarray->dim[0].stride = 1;
+ retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+ retarray->offset = 0;
+ retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+ }
+ else
+ {
+ if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+ runtime_error ("rank of return array does not equal 1");
+
+ if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+ runtime_error ("dimension of return array incorrect");
+
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+ }
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ dstride = retarray->dim[0].stride;
+ dest = retarray->data;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ count[n] = 0;
+ if (extent[n] <= 0)
+ {
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+ return;
+ }
+ }
+
+ 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. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 1;
+ {
+
+ GFC_REAL_16 minval;
+
+ minval = GFC_REAL_16_HUGE;
+
+ while (base)
+ {
+ {
+ /* Implementation start. */
+
+ if (*mbase && *base < minval)
+ {
+ minval = *base;
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+ }
+ /* Implementation end. */
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the loop. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ }
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_8)
+
extern void minloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array);
export_proto(minloc0_8_r4);
}
}
}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_8)
+
extern void minloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array);
export_proto(minloc0_8_r8);
}
}
}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc1_16_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *);
+export_proto(minloc1_16_i16);
+
+void
+minloc1_16_i16 (gfc_array_i16 *retarray, gfc_array_i16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_INTEGER_16 *src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ GFC_INTEGER_16 minval;
+ minval = GFC_INTEGER_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mminloc1_16_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mminloc1_16_i16);
+
+void
+mminloc1_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *dest;
+ GFC_INTEGER_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_INTEGER_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_INTEGER_16 minval;
+ minval = GFC_INTEGER_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc1_16_i4 (gfc_array_i16 *, gfc_array_i4 *, index_type *);
+export_proto(minloc1_16_i4);
+
+void
+minloc1_16_i4 (gfc_array_i16 *retarray, gfc_array_i4 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_4 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_INTEGER_4 *src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ GFC_INTEGER_4 minval;
+ minval = GFC_INTEGER_4_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mminloc1_16_i4 (gfc_array_i16 *, gfc_array_i4 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mminloc1_16_i4);
+
+void
+mminloc1_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *dest;
+ GFC_INTEGER_4 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_INTEGER_4 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_INTEGER_4 minval;
+ minval = GFC_INTEGER_4_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc1_16_i8 (gfc_array_i16 *, gfc_array_i8 *, index_type *);
+export_proto(minloc1_16_i8);
+
+void
+minloc1_16_i8 (gfc_array_i16 *retarray, gfc_array_i8 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_8 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_INTEGER_8 *src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ GFC_INTEGER_8 minval;
+ minval = GFC_INTEGER_8_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mminloc1_16_i8 (gfc_array_i16 *, gfc_array_i8 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mminloc1_16_i8);
+
+void
+mminloc1_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *dest;
+ GFC_INTEGER_8 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_INTEGER_8 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_INTEGER_8 minval;
+ minval = GFC_INTEGER_8_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc1_16_r10 (gfc_array_i16 *, gfc_array_r10 *, index_type *);
+export_proto(minloc1_16_r10);
+
+void
+minloc1_16_r10 (gfc_array_i16 *retarray, gfc_array_r10 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_10 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_10 *src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ GFC_REAL_10 minval;
+ minval = GFC_REAL_10_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mminloc1_16_r10 (gfc_array_i16 *, gfc_array_r10 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mminloc1_16_r10);
+
+void
+mminloc1_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *dest;
+ GFC_REAL_10 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_10 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_REAL_10 minval;
+ minval = GFC_REAL_10_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc1_16_r16 (gfc_array_i16 *, gfc_array_r16 *, index_type *);
+export_proto(minloc1_16_r16);
+
+void
+minloc1_16_r16 (gfc_array_i16 *retarray, gfc_array_r16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_16 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_16 *src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ GFC_REAL_16 minval;
+ minval = GFC_REAL_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mminloc1_16_r16 (gfc_array_i16 *, gfc_array_r16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mminloc1_16_r16);
+
+void
+mminloc1_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *dest;
+ GFC_REAL_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_REAL_16 minval;
+ minval = GFC_REAL_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc1_16_r4 (gfc_array_i16 *, gfc_array_r4 *, index_type *);
+export_proto(minloc1_16_r4);
+
+void
+minloc1_16_r4 (gfc_array_i16 *retarray, gfc_array_r4 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_4 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_4 *src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ GFC_REAL_4 minval;
+ minval = GFC_REAL_4_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mminloc1_16_r4 (gfc_array_i16 *, gfc_array_r4 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mminloc1_16_r4);
+
+void
+mminloc1_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *dest;
+ GFC_REAL_4 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_4 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_REAL_4 minval;
+ minval = GFC_REAL_4_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc1_16_r8 (gfc_array_i16 *, gfc_array_r8 *, index_type *);
+export_proto(minloc1_16_r8);
+
+void
+minloc1_16_r8 (gfc_array_i16 *retarray, gfc_array_r8 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_8 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_8 *src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ GFC_REAL_8 minval;
+ minval = GFC_REAL_8_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mminloc1_16_r8 (gfc_array_i16 *, gfc_array_r8 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mminloc1_16_r8);
+
+void
+mminloc1_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *dest;
+ GFC_REAL_8 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_8 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_REAL_8 minval;
+ minval = GFC_REAL_8_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_16)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void minloc1_4_i16 (gfc_array_i4 *, gfc_array_i16 *, index_type *);
+export_proto(minloc1_4_i16);
+
+void
+minloc1_4_i16 (gfc_array_i4 *retarray, gfc_array_i16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *base;
+ GFC_INTEGER_4 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_4)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_INTEGER_16 *src;
+ GFC_INTEGER_4 result;
+ src = base;
+ {
+
+ GFC_INTEGER_16 minval;
+ minval = GFC_INTEGER_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_4)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mminloc1_4_i16 (gfc_array_i4 *, gfc_array_i16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mminloc1_4_i16);
+
+void
+mminloc1_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_4 *dest;
+ GFC_INTEGER_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_4)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_INTEGER_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_4 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_INTEGER_16 minval;
+ minval = GFC_INTEGER_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_4)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
+
extern void minloc1_4_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *);
export_proto(minloc1_4_i4);
}
}
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4)
+
+
extern void minloc1_4_i8 (gfc_array_i4 *, gfc_array_i8 *, index_type *);
export_proto(minloc1_4_i8);
}
}
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void minloc1_4_r10 (gfc_array_i4 *, gfc_array_r10 *, index_type *);
+export_proto(minloc1_4_r10);
+
+void
+minloc1_4_r10 (gfc_array_i4 *retarray, gfc_array_r10 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_10 *base;
+ GFC_INTEGER_4 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_4)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_10 *src;
+ GFC_INTEGER_4 result;
+ src = base;
+ {
+
+ GFC_REAL_10 minval;
+ minval = GFC_REAL_10_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_4)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mminloc1_4_r10 (gfc_array_i4 *, gfc_array_r10 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mminloc1_4_r10);
+
+void
+mminloc1_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_4 *dest;
+ GFC_REAL_10 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_4)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_10 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_4 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_REAL_10 minval;
+ minval = GFC_REAL_10_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_4)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void minloc1_4_r16 (gfc_array_i4 *, gfc_array_r16 *, index_type *);
+export_proto(minloc1_4_r16);
+
+void
+minloc1_4_r16 (gfc_array_i4 *retarray, gfc_array_r16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_16 *base;
+ GFC_INTEGER_4 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_4)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_16 *src;
+ GFC_INTEGER_4 result;
+ src = base;
+ {
+
+ GFC_REAL_16 minval;
+ minval = GFC_REAL_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_4)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mminloc1_4_r16 (gfc_array_i4 *, gfc_array_r16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mminloc1_4_r16);
+
+void
+mminloc1_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_4 *dest;
+ GFC_REAL_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_4)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_4 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_REAL_16 minval;
+ minval = GFC_REAL_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_4)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_4)
+
+
extern void minloc1_4_r4 (gfc_array_i4 *, gfc_array_r4 *, index_type *);
export_proto(minloc1_4_r4);
}
}
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_4)
+
+
extern void minloc1_4_r8 (gfc_array_i4 *, gfc_array_r8 *, index_type *);
export_proto(minloc1_4_r8);
}
}
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void minloc1_8_i16 (gfc_array_i8 *, gfc_array_i16 *, index_type *);
+export_proto(minloc1_8_i16);
+
+void
+minloc1_8_i16 (gfc_array_i8 *retarray, gfc_array_i16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *base;
+ GFC_INTEGER_8 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_8)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_INTEGER_16 *src;
+ GFC_INTEGER_8 result;
+ src = base;
+ {
+
+ GFC_INTEGER_16 minval;
+ minval = GFC_INTEGER_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_8)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mminloc1_8_i16 (gfc_array_i8 *, gfc_array_i16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mminloc1_8_i16);
+
+void
+mminloc1_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_8 *dest;
+ GFC_INTEGER_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_8)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_INTEGER_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_8 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_INTEGER_16 minval;
+ minval = GFC_INTEGER_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_8)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
+
+
extern void minloc1_8_i4 (gfc_array_i8 *, gfc_array_i4 *, index_type *);
export_proto(minloc1_8_i4);
}
}
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
+
extern void minloc1_8_i8 (gfc_array_i8 *, gfc_array_i8 *, index_type *);
export_proto(minloc1_8_i8);
}
}
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void minloc1_8_r10 (gfc_array_i8 *, gfc_array_r10 *, index_type *);
+export_proto(minloc1_8_r10);
+
+void
+minloc1_8_r10 (gfc_array_i8 *retarray, gfc_array_r10 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_10 *base;
+ GFC_INTEGER_8 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_8)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_10 *src;
+ GFC_INTEGER_8 result;
+ src = base;
+ {
+
+ GFC_REAL_10 minval;
+ minval = GFC_REAL_10_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_8)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mminloc1_8_r10 (gfc_array_i8 *, gfc_array_r10 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mminloc1_8_r10);
+
+void
+mminloc1_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_8 *dest;
+ GFC_REAL_10 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_8)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_10 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_8 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_REAL_10 minval;
+ minval = GFC_REAL_10_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_8)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MINLOC intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void minloc1_8_r16 (gfc_array_i8 *, gfc_array_r16 *, index_type *);
+export_proto(minloc1_8_r16);
+
+void
+minloc1_8_r16 (gfc_array_i8 *retarray, gfc_array_r16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_16 *base;
+ GFC_INTEGER_8 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_8)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_16 *src;
+ GFC_INTEGER_8 result;
+ src = base;
+ {
+
+ GFC_REAL_16 minval;
+ minval = GFC_REAL_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_8)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mminloc1_8_r16 (gfc_array_i8 *, gfc_array_r16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mminloc1_8_r16);
+
+void
+mminloc1_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_8 *dest;
+ GFC_REAL_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_8)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_8 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ GFC_REAL_16 minval;
+ minval = GFC_REAL_16_HUGE;
+ result = 1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src < minval)
+ {
+ minval = *src;
+ result = (GFC_INTEGER_8)n + 1;
+ }
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_8)
+
+
extern void minloc1_8_r4 (gfc_array_i8 *, gfc_array_r4 *, index_type *);
export_proto(minloc1_8_r4);
}
}
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_8)
+
+
extern void minloc1_8_r8 (gfc_array_i8 *, gfc_array_r8 *, index_type *);
export_proto(minloc1_8_r8);
}
}
+#endif
--- /dev/null
+/* Implementation of the MINVAL intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minval_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *);
+export_proto(minval_i16);
+
+void
+minval_i16 (gfc_array_i16 *retarray, gfc_array_i16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_INTEGER_16 *src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ result = GFC_INTEGER_16_HUGE;
+ if (len <= 0)
+ *dest = GFC_INTEGER_16_HUGE;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src < result)
+ result = *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mminval_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mminval_i16);
+
+void
+mminval_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *dest;
+ GFC_INTEGER_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_INTEGER_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = GFC_INTEGER_16_HUGE;
+ if (len <= 0)
+ *dest = GFC_INTEGER_16_HUGE;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src < result)
+ result = *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
+
extern void minval_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *);
export_proto(minval_i4);
}
}
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
+
extern void minval_i8 (gfc_array_i8 *, gfc_array_i8 *, index_type *);
export_proto(minval_i8);
}
}
+#endif
--- /dev/null
+/* Implementation of the MINVAL intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_REAL_10)
+
+
+extern void minval_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *);
+export_proto(minval_r10);
+
+void
+minval_r10 (gfc_array_r10 *retarray, gfc_array_r10 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_10 *base;
+ GFC_REAL_10 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_REAL_10)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_10 *src;
+ GFC_REAL_10 result;
+ src = base;
+ {
+
+ result = GFC_REAL_10_HUGE;
+ if (len <= 0)
+ *dest = GFC_REAL_10_HUGE;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src < result)
+ result = *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mminval_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mminval_r10);
+
+void
+mminval_r10 (gfc_array_r10 * retarray, gfc_array_r10 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_10 *dest;
+ GFC_REAL_10 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_REAL_10)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_10 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_REAL_10 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = GFC_REAL_10_HUGE;
+ if (len <= 0)
+ *dest = GFC_REAL_10_HUGE;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src < result)
+ result = *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the MINVAL intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_REAL_16)
+
+
+extern void minval_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *);
+export_proto(minval_r16);
+
+void
+minval_r16 (gfc_array_r16 *retarray, gfc_array_r16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_16 *base;
+ GFC_REAL_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_REAL_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_16 *src;
+ GFC_REAL_16 result;
+ src = base;
+ {
+
+ result = GFC_REAL_16_HUGE;
+ if (len <= 0)
+ *dest = GFC_REAL_16_HUGE;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ if (*src < result)
+ result = *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mminval_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mminval_r16);
+
+void
+mminval_r16 (gfc_array_r16 * retarray, gfc_array_r16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_16 *dest;
+ GFC_REAL_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_REAL_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_REAL_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = GFC_REAL_16_HUGE;
+ if (len <= 0)
+ *dest = GFC_REAL_16_HUGE;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc && *src < result)
+ result = *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_REAL_4)
+
+
extern void minval_r4 (gfc_array_r4 *, gfc_array_r4 *, index_type *);
export_proto(minval_r4);
}
}
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_REAL_8)
+
+
extern void minval_r8 (gfc_array_r8 *, gfc_array_r8 *, index_type *);
export_proto(minval_r8);
}
}
+#endif
--- /dev/null
+/* Implementation of the NEAREST intrinsic
+ Copyright 2003 Free Software Foundation, Inc.
+ Contributed by Richard Henderson <rth@redhat.com>.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <math.h>
+#include <float.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_COPYSIGNL) && defined (HAVE_NEXTAFTERL)
+
+extern GFC_REAL_10 nearest_r10 (GFC_REAL_10 s, GFC_REAL_10 dir);
+export_proto(nearest_r10);
+
+GFC_REAL_10
+nearest_r10 (GFC_REAL_10 s, GFC_REAL_10 dir)
+{
+ dir = copysignl (__builtin_infl (), dir);
+ if (FLT_EVAL_METHOD != 0)
+ {
+ /* ??? Work around glibc bug on x86. */
+ volatile GFC_REAL_10 r = nextafterl (s, dir);
+ return r;
+ }
+ else
+ return nextafterl (s, dir);
+}
+
+#endif
--- /dev/null
+/* Implementation of the NEAREST intrinsic
+ Copyright 2003 Free Software Foundation, Inc.
+ Contributed by Richard Henderson <rth@redhat.com>.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <math.h>
+#include <float.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_COPYSIGNL) && defined (HAVE_NEXTAFTERL)
+
+extern GFC_REAL_16 nearest_r16 (GFC_REAL_16 s, GFC_REAL_16 dir);
+export_proto(nearest_r16);
+
+GFC_REAL_16
+nearest_r16 (GFC_REAL_16 s, GFC_REAL_16 dir)
+{
+ dir = copysignl (__builtin_infl (), dir);
+ if (FLT_EVAL_METHOD != 0)
+ {
+ /* ??? Work around glibc bug on x86. */
+ volatile GFC_REAL_16 r = nextafterl (s, dir);
+ return r;
+ }
+ else
+ return nextafterl (s, dir);
+}
+
+#endif
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
+
+#include "config.h"
#include <math.h>
#include <float.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_COPYSIGNF) && defined (HAVE_NEXTAFTERF)
+
extern GFC_REAL_4 nearest_r4 (GFC_REAL_4 s, GFC_REAL_4 dir);
export_proto(nearest_r4);
else
return nextafterf (s, dir);
}
+
+#endif
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
+
+#include "config.h"
#include <math.h>
#include <float.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_COPYSIGN) && defined (HAVE_NEXTAFTER)
+
extern GFC_REAL_8 nearest_r8 (GFC_REAL_8 s, GFC_REAL_8 dir);
export_proto(nearest_r8);
else
return nextafter (s, dir);
}
+
+#endif
--- /dev/null
+/* Support routines for the intrinsic power (**) operator.
+ Copyright 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+ a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+ Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+ of Computer Programming", 3rd Edition, 1998. */
+
+#if defined (HAVE_GFC_COMPLEX_10) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_COMPLEX_10 pow_c10_i16 (GFC_COMPLEX_10 a, GFC_INTEGER_16 b);
+export_proto(pow_c10_i16);
+
+GFC_COMPLEX_10
+pow_c10_i16 (GFC_COMPLEX_10 a, GFC_INTEGER_16 b)
+{
+ GFC_COMPLEX_10 pow, x;
+ GFC_INTEGER_16 n, u;
+
+ n = b;
+ x = a;
+ pow = 1;
+ if (n != 0)
+ {
+ if (n < 0)
+ {
+
+ n = -n;
+ x = pow / x;
+ }
+ u = n;
+ for (;;)
+ {
+ if (u & 1)
+ pow *= x;
+ u >>= 1;
+ if (u)
+ x *= x;
+ else
+ break;
+ }
+ }
+ return pow;
+}
+
+#endif
--- /dev/null
+/* Support routines for the intrinsic power (**) operator.
+ Copyright 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+ a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+ Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+ of Computer Programming", 3rd Edition, 1998. */
+
+#if defined (HAVE_GFC_COMPLEX_10) && defined (HAVE_GFC_INTEGER_4)
+
+GFC_COMPLEX_10 pow_c10_i4 (GFC_COMPLEX_10 a, GFC_INTEGER_4 b);
+export_proto(pow_c10_i4);
+
+GFC_COMPLEX_10
+pow_c10_i4 (GFC_COMPLEX_10 a, GFC_INTEGER_4 b)
+{
+ GFC_COMPLEX_10 pow, x;
+ GFC_INTEGER_4 n, u;
+
+ n = b;
+ x = a;
+ pow = 1;
+ if (n != 0)
+ {
+ if (n < 0)
+ {
+
+ n = -n;
+ x = pow / x;
+ }
+ u = n;
+ for (;;)
+ {
+ if (u & 1)
+ pow *= x;
+ u >>= 1;
+ if (u)
+ x *= x;
+ else
+ break;
+ }
+ }
+ return pow;
+}
+
+#endif
--- /dev/null
+/* Support routines for the intrinsic power (**) operator.
+ Copyright 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+ a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+ Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+ of Computer Programming", 3rd Edition, 1998. */
+
+#if defined (HAVE_GFC_COMPLEX_10) && defined (HAVE_GFC_INTEGER_8)
+
+GFC_COMPLEX_10 pow_c10_i8 (GFC_COMPLEX_10 a, GFC_INTEGER_8 b);
+export_proto(pow_c10_i8);
+
+GFC_COMPLEX_10
+pow_c10_i8 (GFC_COMPLEX_10 a, GFC_INTEGER_8 b)
+{
+ GFC_COMPLEX_10 pow, x;
+ GFC_INTEGER_8 n, u;
+
+ n = b;
+ x = a;
+ pow = 1;
+ if (n != 0)
+ {
+ if (n < 0)
+ {
+
+ n = -n;
+ x = pow / x;
+ }
+ u = n;
+ for (;;)
+ {
+ if (u & 1)
+ pow *= x;
+ u >>= 1;
+ if (u)
+ x *= x;
+ else
+ break;
+ }
+ }
+ return pow;
+}
+
+#endif
--- /dev/null
+/* Support routines for the intrinsic power (**) operator.
+ Copyright 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+ a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+ Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+ of Computer Programming", 3rd Edition, 1998. */
+
+#if defined (HAVE_GFC_COMPLEX_16) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_COMPLEX_16 pow_c16_i16 (GFC_COMPLEX_16 a, GFC_INTEGER_16 b);
+export_proto(pow_c16_i16);
+
+GFC_COMPLEX_16
+pow_c16_i16 (GFC_COMPLEX_16 a, GFC_INTEGER_16 b)
+{
+ GFC_COMPLEX_16 pow, x;
+ GFC_INTEGER_16 n, u;
+
+ n = b;
+ x = a;
+ pow = 1;
+ if (n != 0)
+ {
+ if (n < 0)
+ {
+
+ n = -n;
+ x = pow / x;
+ }
+ u = n;
+ for (;;)
+ {
+ if (u & 1)
+ pow *= x;
+ u >>= 1;
+ if (u)
+ x *= x;
+ else
+ break;
+ }
+ }
+ return pow;
+}
+
+#endif
--- /dev/null
+/* Support routines for the intrinsic power (**) operator.
+ Copyright 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+ a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+ Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+ of Computer Programming", 3rd Edition, 1998. */
+
+#if defined (HAVE_GFC_COMPLEX_16) && defined (HAVE_GFC_INTEGER_4)
+
+GFC_COMPLEX_16 pow_c16_i4 (GFC_COMPLEX_16 a, GFC_INTEGER_4 b);
+export_proto(pow_c16_i4);
+
+GFC_COMPLEX_16
+pow_c16_i4 (GFC_COMPLEX_16 a, GFC_INTEGER_4 b)
+{
+ GFC_COMPLEX_16 pow, x;
+ GFC_INTEGER_4 n, u;
+
+ n = b;
+ x = a;
+ pow = 1;
+ if (n != 0)
+ {
+ if (n < 0)
+ {
+
+ n = -n;
+ x = pow / x;
+ }
+ u = n;
+ for (;;)
+ {
+ if (u & 1)
+ pow *= x;
+ u >>= 1;
+ if (u)
+ x *= x;
+ else
+ break;
+ }
+ }
+ return pow;
+}
+
+#endif
--- /dev/null
+/* Support routines for the intrinsic power (**) operator.
+ Copyright 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+ a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+ Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+ of Computer Programming", 3rd Edition, 1998. */
+
+#if defined (HAVE_GFC_COMPLEX_16) && defined (HAVE_GFC_INTEGER_8)
+
+GFC_COMPLEX_16 pow_c16_i8 (GFC_COMPLEX_16 a, GFC_INTEGER_8 b);
+export_proto(pow_c16_i8);
+
+GFC_COMPLEX_16
+pow_c16_i8 (GFC_COMPLEX_16 a, GFC_INTEGER_8 b)
+{
+ GFC_COMPLEX_16 pow, x;
+ GFC_INTEGER_8 n, u;
+
+ n = b;
+ x = a;
+ pow = 1;
+ if (n != 0)
+ {
+ if (n < 0)
+ {
+
+ n = -n;
+ x = pow / x;
+ }
+ u = n;
+ for (;;)
+ {
+ if (u & 1)
+ pow *= x;
+ u >>= 1;
+ if (u)
+ x *= x;
+ else
+ break;
+ }
+ }
+ return pow;
+}
+
+#endif
--- /dev/null
+/* Support routines for the intrinsic power (**) operator.
+ Copyright 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+ a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+ Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+ of Computer Programming", 3rd Edition, 1998. */
+
+#if defined (HAVE_GFC_COMPLEX_4) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_COMPLEX_4 pow_c4_i16 (GFC_COMPLEX_4 a, GFC_INTEGER_16 b);
+export_proto(pow_c4_i16);
+
+GFC_COMPLEX_4
+pow_c4_i16 (GFC_COMPLEX_4 a, GFC_INTEGER_16 b)
+{
+ GFC_COMPLEX_4 pow, x;
+ GFC_INTEGER_16 n, u;
+
+ n = b;
+ x = a;
+ pow = 1;
+ if (n != 0)
+ {
+ if (n < 0)
+ {
+
+ n = -n;
+ x = pow / x;
+ }
+ u = n;
+ for (;;)
+ {
+ if (u & 1)
+ pow *= x;
+ u >>= 1;
+ if (u)
+ x *= x;
+ else
+ break;
+ }
+ }
+ return pow;
+}
+
+#endif
Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
of Computer Programming", 3rd Edition, 1998. */
+#if defined (HAVE_GFC_COMPLEX_4) && defined (HAVE_GFC_INTEGER_4)
+
GFC_COMPLEX_4 pow_c4_i4 (GFC_COMPLEX_4 a, GFC_INTEGER_4 b);
export_proto(pow_c4_i4);
}
return pow;
}
+
+#endif
Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
of Computer Programming", 3rd Edition, 1998. */
+#if defined (HAVE_GFC_COMPLEX_4) && defined (HAVE_GFC_INTEGER_8)
+
GFC_COMPLEX_4 pow_c4_i8 (GFC_COMPLEX_4 a, GFC_INTEGER_8 b);
export_proto(pow_c4_i8);
}
return pow;
}
+
+#endif
--- /dev/null
+/* Support routines for the intrinsic power (**) operator.
+ Copyright 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+ a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+ Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+ of Computer Programming", 3rd Edition, 1998. */
+
+#if defined (HAVE_GFC_COMPLEX_8) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_COMPLEX_8 pow_c8_i16 (GFC_COMPLEX_8 a, GFC_INTEGER_16 b);
+export_proto(pow_c8_i16);
+
+GFC_COMPLEX_8
+pow_c8_i16 (GFC_COMPLEX_8 a, GFC_INTEGER_16 b)
+{
+ GFC_COMPLEX_8 pow, x;
+ GFC_INTEGER_16 n, u;
+
+ n = b;
+ x = a;
+ pow = 1;
+ if (n != 0)
+ {
+ if (n < 0)
+ {
+
+ n = -n;
+ x = pow / x;
+ }
+ u = n;
+ for (;;)
+ {
+ if (u & 1)
+ pow *= x;
+ u >>= 1;
+ if (u)
+ x *= x;
+ else
+ break;
+ }
+ }
+ return pow;
+}
+
+#endif
Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
of Computer Programming", 3rd Edition, 1998. */
+#if defined (HAVE_GFC_COMPLEX_8) && defined (HAVE_GFC_INTEGER_4)
+
GFC_COMPLEX_8 pow_c8_i4 (GFC_COMPLEX_8 a, GFC_INTEGER_4 b);
export_proto(pow_c8_i4);
}
return pow;
}
+
+#endif
Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
of Computer Programming", 3rd Edition, 1998. */
+#if defined (HAVE_GFC_COMPLEX_8) && defined (HAVE_GFC_INTEGER_8)
+
GFC_COMPLEX_8 pow_c8_i8 (GFC_COMPLEX_8 a, GFC_INTEGER_8 b);
export_proto(pow_c8_i8);
}
return pow;
}
+
+#endif
--- /dev/null
+/* Support routines for the intrinsic power (**) operator.
+ Copyright 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+ a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+ Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+ of Computer Programming", 3rd Edition, 1998. */
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_INTEGER_16 pow_i16_i16 (GFC_INTEGER_16 a, GFC_INTEGER_16 b);
+export_proto(pow_i16_i16);
+
+GFC_INTEGER_16
+pow_i16_i16 (GFC_INTEGER_16 a, GFC_INTEGER_16 b)
+{
+ GFC_INTEGER_16 pow, x;
+ GFC_INTEGER_16 n, u;
+
+ n = b;
+ x = a;
+ pow = 1;
+ if (n != 0)
+ {
+ if (n < 0)
+ {
+ if (x == 1)
+ return 1;
+ if (x == -1)
+ return (n & 1) ? -1 : 1;
+ return (x == 0) ? 1 / x : 0;
+ }
+ u = n;
+ for (;;)
+ {
+ if (u & 1)
+ pow *= x;
+ u >>= 1;
+ if (u)
+ x *= x;
+ else
+ break;
+ }
+ }
+ return pow;
+}
+
+#endif
--- /dev/null
+/* Support routines for the intrinsic power (**) operator.
+ Copyright 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+ a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+ Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+ of Computer Programming", 3rd Edition, 1998. */
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4)
+
+GFC_INTEGER_16 pow_i16_i4 (GFC_INTEGER_16 a, GFC_INTEGER_4 b);
+export_proto(pow_i16_i4);
+
+GFC_INTEGER_16
+pow_i16_i4 (GFC_INTEGER_16 a, GFC_INTEGER_4 b)
+{
+ GFC_INTEGER_16 pow, x;
+ GFC_INTEGER_4 n, u;
+
+ n = b;
+ x = a;
+ pow = 1;
+ if (n != 0)
+ {
+ if (n < 0)
+ {
+ if (x == 1)
+ return 1;
+ if (x == -1)
+ return (n & 1) ? -1 : 1;
+ return (x == 0) ? 1 / x : 0;
+ }
+ u = n;
+ for (;;)
+ {
+ if (u & 1)
+ pow *= x;
+ u >>= 1;
+ if (u)
+ x *= x;
+ else
+ break;
+ }
+ }
+ return pow;
+}
+
+#endif
--- /dev/null
+/* Support routines for the intrinsic power (**) operator.
+ Copyright 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+ a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+ Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+ of Computer Programming", 3rd Edition, 1998. */
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8)
+
+GFC_INTEGER_16 pow_i16_i8 (GFC_INTEGER_16 a, GFC_INTEGER_8 b);
+export_proto(pow_i16_i8);
+
+GFC_INTEGER_16
+pow_i16_i8 (GFC_INTEGER_16 a, GFC_INTEGER_8 b)
+{
+ GFC_INTEGER_16 pow, x;
+ GFC_INTEGER_8 n, u;
+
+ n = b;
+ x = a;
+ pow = 1;
+ if (n != 0)
+ {
+ if (n < 0)
+ {
+ if (x == 1)
+ return 1;
+ if (x == -1)
+ return (n & 1) ? -1 : 1;
+ return (x == 0) ? 1 / x : 0;
+ }
+ u = n;
+ for (;;)
+ {
+ if (u & 1)
+ pow *= x;
+ u >>= 1;
+ if (u)
+ x *= x;
+ else
+ break;
+ }
+ }
+ return pow;
+}
+
+#endif
--- /dev/null
+/* Support routines for the intrinsic power (**) operator.
+ Copyright 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+ a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+ Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+ of Computer Programming", 3rd Edition, 1998. */
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_INTEGER_4 pow_i4_i16 (GFC_INTEGER_4 a, GFC_INTEGER_16 b);
+export_proto(pow_i4_i16);
+
+GFC_INTEGER_4
+pow_i4_i16 (GFC_INTEGER_4 a, GFC_INTEGER_16 b)
+{
+ GFC_INTEGER_4 pow, x;
+ GFC_INTEGER_16 n, u;
+
+ n = b;
+ x = a;
+ pow = 1;
+ if (n != 0)
+ {
+ if (n < 0)
+ {
+ if (x == 1)
+ return 1;
+ if (x == -1)
+ return (n & 1) ? -1 : 1;
+ return (x == 0) ? 1 / x : 0;
+ }
+ u = n;
+ for (;;)
+ {
+ if (u & 1)
+ pow *= x;
+ u >>= 1;
+ if (u)
+ x *= x;
+ else
+ break;
+ }
+ }
+ return pow;
+}
+
+#endif
Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
of Computer Programming", 3rd Edition, 1998. */
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
GFC_INTEGER_4 pow_i4_i4 (GFC_INTEGER_4 a, GFC_INTEGER_4 b);
export_proto(pow_i4_i4);
}
return pow;
}
+
+#endif
Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
of Computer Programming", 3rd Edition, 1998. */
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
+
GFC_INTEGER_4 pow_i4_i8 (GFC_INTEGER_4 a, GFC_INTEGER_8 b);
export_proto(pow_i4_i8);
}
return pow;
}
+
+#endif
--- /dev/null
+/* Support routines for the intrinsic power (**) operator.
+ Copyright 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+ a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+ Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+ of Computer Programming", 3rd Edition, 1998. */
+
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_INTEGER_8 pow_i8_i16 (GFC_INTEGER_8 a, GFC_INTEGER_16 b);
+export_proto(pow_i8_i16);
+
+GFC_INTEGER_8
+pow_i8_i16 (GFC_INTEGER_8 a, GFC_INTEGER_16 b)
+{
+ GFC_INTEGER_8 pow, x;
+ GFC_INTEGER_16 n, u;
+
+ n = b;
+ x = a;
+ pow = 1;
+ if (n != 0)
+ {
+ if (n < 0)
+ {
+ if (x == 1)
+ return 1;
+ if (x == -1)
+ return (n & 1) ? -1 : 1;
+ return (x == 0) ? 1 / x : 0;
+ }
+ u = n;
+ for (;;)
+ {
+ if (u & 1)
+ pow *= x;
+ u >>= 1;
+ if (u)
+ x *= x;
+ else
+ break;
+ }
+ }
+ return pow;
+}
+
+#endif
Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
of Computer Programming", 3rd Edition, 1998. */
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4)
+
GFC_INTEGER_8 pow_i8_i4 (GFC_INTEGER_8 a, GFC_INTEGER_4 b);
export_proto(pow_i8_i4);
}
return pow;
}
+
+#endif
Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
of Computer Programming", 3rd Edition, 1998. */
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
GFC_INTEGER_8 pow_i8_i8 (GFC_INTEGER_8 a, GFC_INTEGER_8 b);
export_proto(pow_i8_i8);
}
return pow;
}
+
+#endif
--- /dev/null
+/* Support routines for the intrinsic power (**) operator.
+ Copyright 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+ a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+ Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+ of Computer Programming", 3rd Edition, 1998. */
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_REAL_10 pow_r10_i16 (GFC_REAL_10 a, GFC_INTEGER_16 b);
+export_proto(pow_r10_i16);
+
+GFC_REAL_10
+pow_r10_i16 (GFC_REAL_10 a, GFC_INTEGER_16 b)
+{
+ GFC_REAL_10 pow, x;
+ GFC_INTEGER_16 n, u;
+
+ n = b;
+ x = a;
+ pow = 1;
+ if (n != 0)
+ {
+ if (n < 0)
+ {
+
+ n = -n;
+ x = pow / x;
+ }
+ u = n;
+ for (;;)
+ {
+ if (u & 1)
+ pow *= x;
+ u >>= 1;
+ if (u)
+ x *= x;
+ else
+ break;
+ }
+ }
+ return pow;
+}
+
+#endif
--- /dev/null
+/* Support routines for the intrinsic power (**) operator.
+ Copyright 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+ a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+ Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+ of Computer Programming", 3rd Edition, 1998. */
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4)
+
+GFC_REAL_10 pow_r10_i4 (GFC_REAL_10 a, GFC_INTEGER_4 b);
+export_proto(pow_r10_i4);
+
+GFC_REAL_10
+pow_r10_i4 (GFC_REAL_10 a, GFC_INTEGER_4 b)
+{
+ GFC_REAL_10 pow, x;
+ GFC_INTEGER_4 n, u;
+
+ n = b;
+ x = a;
+ pow = 1;
+ if (n != 0)
+ {
+ if (n < 0)
+ {
+
+ n = -n;
+ x = pow / x;
+ }
+ u = n;
+ for (;;)
+ {
+ if (u & 1)
+ pow *= x;
+ u >>= 1;
+ if (u)
+ x *= x;
+ else
+ break;
+ }
+ }
+ return pow;
+}
+
+#endif
--- /dev/null
+/* Support routines for the intrinsic power (**) operator.
+ Copyright 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+ a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+ Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+ of Computer Programming", 3rd Edition, 1998. */
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_8)
+
+GFC_REAL_10 pow_r10_i8 (GFC_REAL_10 a, GFC_INTEGER_8 b);
+export_proto(pow_r10_i8);
+
+GFC_REAL_10
+pow_r10_i8 (GFC_REAL_10 a, GFC_INTEGER_8 b)
+{
+ GFC_REAL_10 pow, x;
+ GFC_INTEGER_8 n, u;
+
+ n = b;
+ x = a;
+ pow = 1;
+ if (n != 0)
+ {
+ if (n < 0)
+ {
+
+ n = -n;
+ x = pow / x;
+ }
+ u = n;
+ for (;;)
+ {
+ if (u & 1)
+ pow *= x;
+ u >>= 1;
+ if (u)
+ x *= x;
+ else
+ break;
+ }
+ }
+ return pow;
+}
+
+#endif
--- /dev/null
+/* Support routines for the intrinsic power (**) operator.
+ Copyright 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+ a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+ Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+ of Computer Programming", 3rd Edition, 1998. */
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_REAL_16 pow_r16_i16 (GFC_REAL_16 a, GFC_INTEGER_16 b);
+export_proto(pow_r16_i16);
+
+GFC_REAL_16
+pow_r16_i16 (GFC_REAL_16 a, GFC_INTEGER_16 b)
+{
+ GFC_REAL_16 pow, x;
+ GFC_INTEGER_16 n, u;
+
+ n = b;
+ x = a;
+ pow = 1;
+ if (n != 0)
+ {
+ if (n < 0)
+ {
+
+ n = -n;
+ x = pow / x;
+ }
+ u = n;
+ for (;;)
+ {
+ if (u & 1)
+ pow *= x;
+ u >>= 1;
+ if (u)
+ x *= x;
+ else
+ break;
+ }
+ }
+ return pow;
+}
+
+#endif
--- /dev/null
+/* Support routines for the intrinsic power (**) operator.
+ Copyright 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+ a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+ Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+ of Computer Programming", 3rd Edition, 1998. */
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4)
+
+GFC_REAL_16 pow_r16_i4 (GFC_REAL_16 a, GFC_INTEGER_4 b);
+export_proto(pow_r16_i4);
+
+GFC_REAL_16
+pow_r16_i4 (GFC_REAL_16 a, GFC_INTEGER_4 b)
+{
+ GFC_REAL_16 pow, x;
+ GFC_INTEGER_4 n, u;
+
+ n = b;
+ x = a;
+ pow = 1;
+ if (n != 0)
+ {
+ if (n < 0)
+ {
+
+ n = -n;
+ x = pow / x;
+ }
+ u = n;
+ for (;;)
+ {
+ if (u & 1)
+ pow *= x;
+ u >>= 1;
+ if (u)
+ x *= x;
+ else
+ break;
+ }
+ }
+ return pow;
+}
+
+#endif
--- /dev/null
+/* Support routines for the intrinsic power (**) operator.
+ Copyright 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+ a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+ Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+ of Computer Programming", 3rd Edition, 1998. */
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_8)
+
+GFC_REAL_16 pow_r16_i8 (GFC_REAL_16 a, GFC_INTEGER_8 b);
+export_proto(pow_r16_i8);
+
+GFC_REAL_16
+pow_r16_i8 (GFC_REAL_16 a, GFC_INTEGER_8 b)
+{
+ GFC_REAL_16 pow, x;
+ GFC_INTEGER_8 n, u;
+
+ n = b;
+ x = a;
+ pow = 1;
+ if (n != 0)
+ {
+ if (n < 0)
+ {
+
+ n = -n;
+ x = pow / x;
+ }
+ u = n;
+ for (;;)
+ {
+ if (u & 1)
+ pow *= x;
+ u >>= 1;
+ if (u)
+ x *= x;
+ else
+ break;
+ }
+ }
+ return pow;
+}
+
+#endif
--- /dev/null
+/* Support routines for the intrinsic power (**) operator.
+ Copyright 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+ a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+ Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+ of Computer Programming", 3rd Edition, 1998. */
+
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_REAL_4 pow_r4_i16 (GFC_REAL_4 a, GFC_INTEGER_16 b);
+export_proto(pow_r4_i16);
+
+GFC_REAL_4
+pow_r4_i16 (GFC_REAL_4 a, GFC_INTEGER_16 b)
+{
+ GFC_REAL_4 pow, x;
+ GFC_INTEGER_16 n, u;
+
+ n = b;
+ x = a;
+ pow = 1;
+ if (n != 0)
+ {
+ if (n < 0)
+ {
+
+ n = -n;
+ x = pow / x;
+ }
+ u = n;
+ for (;;)
+ {
+ if (u & 1)
+ pow *= x;
+ u >>= 1;
+ if (u)
+ x *= x;
+ else
+ break;
+ }
+ }
+ return pow;
+}
+
+#endif
Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
of Computer Programming", 3rd Edition, 1998. */
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_4)
+
GFC_REAL_4 pow_r4_i4 (GFC_REAL_4 a, GFC_INTEGER_4 b);
export_proto(pow_r4_i4);
}
return pow;
}
+
+#endif
Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
of Computer Programming", 3rd Edition, 1998. */
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_8)
+
GFC_REAL_4 pow_r4_i8 (GFC_REAL_4 a, GFC_INTEGER_8 b);
export_proto(pow_r4_i8);
}
return pow;
}
+
+#endif
--- /dev/null
+/* Support routines for the intrinsic power (**) operator.
+ Copyright 2004 Free Software Foundation, Inc.
+ Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+ a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+ Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+ of Computer Programming", 3rd Edition, 1998. */
+
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_REAL_8 pow_r8_i16 (GFC_REAL_8 a, GFC_INTEGER_16 b);
+export_proto(pow_r8_i16);
+
+GFC_REAL_8
+pow_r8_i16 (GFC_REAL_8 a, GFC_INTEGER_16 b)
+{
+ GFC_REAL_8 pow, x;
+ GFC_INTEGER_16 n, u;
+
+ n = b;
+ x = a;
+ pow = 1;
+ if (n != 0)
+ {
+ if (n < 0)
+ {
+
+ n = -n;
+ x = pow / x;
+ }
+ u = n;
+ for (;;)
+ {
+ if (u & 1)
+ pow *= x;
+ u >>= 1;
+ if (u)
+ x *= x;
+ else
+ break;
+ }
+ }
+ return pow;
+}
+
+#endif
Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
of Computer Programming", 3rd Edition, 1998. */
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_4)
+
GFC_REAL_8 pow_r8_i4 (GFC_REAL_8 a, GFC_INTEGER_4 b);
export_proto(pow_r8_i4);
}
return pow;
}
+
+#endif
Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
of Computer Programming", 3rd Edition, 1998. */
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_8)
+
GFC_REAL_8 pow_r8_i8 (GFC_REAL_8 a, GFC_INTEGER_8 b);
export_proto(pow_r8_i8);
}
return pow;
}
+
+#endif
--- /dev/null
+/* Implementation of the PRODUCT intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_COMPLEX_10) && defined (HAVE_GFC_COMPLEX_10)
+
+
+extern void product_c10 (gfc_array_c10 *, gfc_array_c10 *, index_type *);
+export_proto(product_c10);
+
+void
+product_c10 (gfc_array_c10 *retarray, gfc_array_c10 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_COMPLEX_10 *base;
+ GFC_COMPLEX_10 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_COMPLEX_10)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_COMPLEX_10 *src;
+ GFC_COMPLEX_10 result;
+ src = base;
+ {
+
+ result = 1;
+ if (len <= 0)
+ *dest = 1;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result *= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mproduct_c10 (gfc_array_c10 *, gfc_array_c10 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mproduct_c10);
+
+void
+mproduct_c10 (gfc_array_c10 * retarray, gfc_array_c10 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_COMPLEX_10 *dest;
+ GFC_COMPLEX_10 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_COMPLEX_10)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_COMPLEX_10 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_COMPLEX_10 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 1;
+ if (len <= 0)
+ *dest = 1;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result *= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the PRODUCT intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_COMPLEX_16) && defined (HAVE_GFC_COMPLEX_16)
+
+
+extern void product_c16 (gfc_array_c16 *, gfc_array_c16 *, index_type *);
+export_proto(product_c16);
+
+void
+product_c16 (gfc_array_c16 *retarray, gfc_array_c16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_COMPLEX_16 *base;
+ GFC_COMPLEX_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_COMPLEX_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_COMPLEX_16 *src;
+ GFC_COMPLEX_16 result;
+ src = base;
+ {
+
+ result = 1;
+ if (len <= 0)
+ *dest = 1;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result *= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mproduct_c16 (gfc_array_c16 *, gfc_array_c16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mproduct_c16);
+
+void
+mproduct_c16 (gfc_array_c16 * retarray, gfc_array_c16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_COMPLEX_16 *dest;
+ GFC_COMPLEX_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_COMPLEX_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_COMPLEX_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_COMPLEX_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 1;
+ if (len <= 0)
+ *dest = 1;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result *= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_COMPLEX_4) && defined (HAVE_GFC_COMPLEX_4)
+
+
extern void product_c4 (gfc_array_c4 *, gfc_array_c4 *, index_type *);
export_proto(product_c4);
}
}
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_COMPLEX_8) && defined (HAVE_GFC_COMPLEX_8)
+
+
extern void product_c8 (gfc_array_c8 *, gfc_array_c8 *, index_type *);
export_proto(product_c8);
}
}
+#endif
--- /dev/null
+/* Implementation of the PRODUCT intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void product_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *);
+export_proto(product_i16);
+
+void
+product_i16 (gfc_array_i16 *retarray, gfc_array_i16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_INTEGER_16 *src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ result = 1;
+ if (len <= 0)
+ *dest = 1;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result *= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mproduct_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mproduct_i16);
+
+void
+mproduct_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *dest;
+ GFC_INTEGER_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_INTEGER_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 1;
+ if (len <= 0)
+ *dest = 1;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result *= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
+
extern void product_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *);
export_proto(product_i4);
}
}
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
+
extern void product_i8 (gfc_array_i8 *, gfc_array_i8 *, index_type *);
export_proto(product_i8);
}
}
+#endif
--- /dev/null
+/* Implementation of the PRODUCT intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_REAL_10)
+
+
+extern void product_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *);
+export_proto(product_r10);
+
+void
+product_r10 (gfc_array_r10 *retarray, gfc_array_r10 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_10 *base;
+ GFC_REAL_10 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_REAL_10)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_10 *src;
+ GFC_REAL_10 result;
+ src = base;
+ {
+
+ result = 1;
+ if (len <= 0)
+ *dest = 1;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result *= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mproduct_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mproduct_r10);
+
+void
+mproduct_r10 (gfc_array_r10 * retarray, gfc_array_r10 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_10 *dest;
+ GFC_REAL_10 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_REAL_10)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_10 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_REAL_10 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 1;
+ if (len <= 0)
+ *dest = 1;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result *= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the PRODUCT intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_REAL_16)
+
+
+extern void product_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *);
+export_proto(product_r16);
+
+void
+product_r16 (gfc_array_r16 *retarray, gfc_array_r16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_16 *base;
+ GFC_REAL_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_REAL_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_16 *src;
+ GFC_REAL_16 result;
+ src = base;
+ {
+
+ result = 1;
+ if (len <= 0)
+ *dest = 1;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result *= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void mproduct_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(mproduct_r16);
+
+void
+mproduct_r16 (gfc_array_r16 * retarray, gfc_array_r16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_16 *dest;
+ GFC_REAL_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_REAL_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_REAL_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 1;
+ if (len <= 0)
+ *dest = 1;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result *= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_REAL_4)
+
+
extern void product_r4 (gfc_array_r4 *, gfc_array_r4 *, index_type *);
export_proto(product_r4);
}
}
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_REAL_8)
+
+
extern void product_r8 (gfc_array_r8 *, gfc_array_r8 *, index_type *);
export_proto(product_r8);
}
}
+#endif
--- /dev/null
+/* Implementation of the RESHAPE
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+
+typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
+
+/* The shape parameter is ignored. We can currently deduce the shape from the
+ return array. */
+
+extern void reshape_c10 (gfc_array_c10 *, gfc_array_c10 *, shape_type *,
+ gfc_array_c10 *, shape_type *);
+export_proto(reshape_c10);
+
+void
+reshape_c10 (gfc_array_c10 * ret, gfc_array_c10 * source, shape_type * shape,
+ gfc_array_c10 * pad, shape_type * order)
+{
+ /* r.* indicates the return array. */
+ index_type rcount[GFC_MAX_DIMENSIONS];
+ index_type rextent[GFC_MAX_DIMENSIONS];
+ index_type rstride[GFC_MAX_DIMENSIONS];
+ index_type rstride0;
+ index_type rdim;
+ index_type rsize;
+ index_type rs;
+ index_type rex;
+ GFC_COMPLEX_10 *rptr;
+ /* s.* indicates the source array. */
+ index_type scount[GFC_MAX_DIMENSIONS];
+ index_type sextent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type sstride0;
+ index_type sdim;
+ index_type ssize;
+ const GFC_COMPLEX_10 *sptr;
+ /* p.* indicates the pad array. */
+ index_type pcount[GFC_MAX_DIMENSIONS];
+ index_type pextent[GFC_MAX_DIMENSIONS];
+ index_type pstride[GFC_MAX_DIMENSIONS];
+ index_type pdim;
+ index_type psize;
+ const GFC_COMPLEX_10 *pptr;
+
+ const GFC_COMPLEX_10 *src;
+ int n;
+ int dim;
+
+ if (source->dim[0].stride == 0)
+ source->dim[0].stride = 1;
+ if (shape->dim[0].stride == 0)
+ shape->dim[0].stride = 1;
+ if (pad && pad->dim[0].stride == 0)
+ pad->dim[0].stride = 1;
+ if (order && order->dim[0].stride == 0)
+ order->dim[0].stride = 1;
+
+ if (ret->data == NULL)
+ {
+ rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+ rs = 1;
+ for (n=0; n < rdim; n++)
+ {
+ ret->dim[n].lbound = 0;
+ rex = shape->data[n * shape->dim[0].stride];
+ ret->dim[n].ubound = rex - 1;
+ ret->dim[n].stride = rs;
+ rs *= rex;
+ }
+ ret->offset = 0;
+ ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_10));
+ ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim;
+ }
+ else
+ {
+ rdim = GFC_DESCRIPTOR_RANK (ret);
+ if (ret->dim[0].stride == 0)
+ ret->dim[0].stride = 1;
+ }
+
+ rsize = 1;
+ for (n = 0; n < rdim; n++)
+ {
+ if (order)
+ dim = order->data[n * order->dim[0].stride] - 1;
+ else
+ dim = n;
+
+ rcount[n] = 0;
+ rstride[n] = ret->dim[dim].stride;
+ rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+
+ if (rextent[n] != shape->data[dim * shape->dim[0].stride])
+ runtime_error ("shape and target do not conform");
+
+ if (rsize == rstride[n])
+ rsize *= rextent[n];
+ else
+ rsize = 0;
+ if (rextent[n] <= 0)
+ return;
+ }
+
+ sdim = GFC_DESCRIPTOR_RANK (source);
+ ssize = 1;
+ for (n = 0; n < sdim; n++)
+ {
+ scount[n] = 0;
+ sstride[n] = source->dim[n].stride;
+ sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ if (sextent[n] <= 0)
+ abort ();
+
+ if (ssize == sstride[n])
+ ssize *= sextent[n];
+ else
+ ssize = 0;
+ }
+
+ if (pad)
+ {
+ pdim = GFC_DESCRIPTOR_RANK (pad);
+ psize = 1;
+ for (n = 0; n < pdim; n++)
+ {
+ pcount[n] = 0;
+ pstride[n] = pad->dim[n].stride;
+ pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
+ if (pextent[n] <= 0)
+ abort ();
+ if (psize == pstride[n])
+ psize *= pextent[n];
+ else
+ psize = 0;
+ }
+ pptr = pad->data;
+ }
+ else
+ {
+ pdim = 0;
+ psize = 1;
+ pptr = NULL;
+ }
+
+ if (rsize != 0 && ssize != 0 && psize != 0)
+ {
+ rsize *= sizeof (GFC_COMPLEX_10);
+ ssize *= sizeof (GFC_COMPLEX_10);
+ psize *= sizeof (GFC_COMPLEX_10);
+ reshape_packed ((char *)ret->data, rsize, (char *)source->data,
+ ssize, pad ? (char *)pad->data : NULL, psize);
+ return;
+ }
+ rptr = ret->data;
+ src = sptr = source->data;
+ rstride0 = rstride[0];
+ sstride0 = sstride[0];
+
+ while (rptr)
+ {
+ /* Select between the source and pad arrays. */
+ *rptr = *src;
+ /* Advance to the next element. */
+ rptr += rstride0;
+ src += sstride0;
+ rcount[0]++;
+ scount[0]++;
+ /* Advance to the next destination element. */
+ n = 0;
+ while (rcount[n] == rextent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ rcount[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ rptr -= rstride[n] * rextent[n];
+ n++;
+ if (n == rdim)
+ {
+ /* Break out of the loop. */
+ rptr = NULL;
+ break;
+ }
+ else
+ {
+ rcount[n]++;
+ rptr += rstride[n];
+ }
+ }
+ /* Advance to the next source element. */
+ n = 0;
+ while (scount[n] == sextent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ scount[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ src -= sstride[n] * sextent[n];
+ n++;
+ if (n == sdim)
+ {
+ if (sptr && pad)
+ {
+ /* Switch to the pad array. */
+ sptr = NULL;
+ sdim = pdim;
+ for (dim = 0; dim < pdim; dim++)
+ {
+ scount[dim] = pcount[dim];
+ sextent[dim] = pextent[dim];
+ sstride[dim] = pstride[dim];
+ sstride0 = sstride[0];
+ }
+ }
+ /* We now start again from the beginning of the pad array. */
+ src = pptr;
+ break;
+ }
+ else
+ {
+ scount[n]++;
+ src += sstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the RESHAPE
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+
+typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
+
+/* The shape parameter is ignored. We can currently deduce the shape from the
+ return array. */
+
+extern void reshape_c16 (gfc_array_c16 *, gfc_array_c16 *, shape_type *,
+ gfc_array_c16 *, shape_type *);
+export_proto(reshape_c16);
+
+void
+reshape_c16 (gfc_array_c16 * ret, gfc_array_c16 * source, shape_type * shape,
+ gfc_array_c16 * pad, shape_type * order)
+{
+ /* r.* indicates the return array. */
+ index_type rcount[GFC_MAX_DIMENSIONS];
+ index_type rextent[GFC_MAX_DIMENSIONS];
+ index_type rstride[GFC_MAX_DIMENSIONS];
+ index_type rstride0;
+ index_type rdim;
+ index_type rsize;
+ index_type rs;
+ index_type rex;
+ GFC_COMPLEX_16 *rptr;
+ /* s.* indicates the source array. */
+ index_type scount[GFC_MAX_DIMENSIONS];
+ index_type sextent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type sstride0;
+ index_type sdim;
+ index_type ssize;
+ const GFC_COMPLEX_16 *sptr;
+ /* p.* indicates the pad array. */
+ index_type pcount[GFC_MAX_DIMENSIONS];
+ index_type pextent[GFC_MAX_DIMENSIONS];
+ index_type pstride[GFC_MAX_DIMENSIONS];
+ index_type pdim;
+ index_type psize;
+ const GFC_COMPLEX_16 *pptr;
+
+ const GFC_COMPLEX_16 *src;
+ int n;
+ int dim;
+
+ if (source->dim[0].stride == 0)
+ source->dim[0].stride = 1;
+ if (shape->dim[0].stride == 0)
+ shape->dim[0].stride = 1;
+ if (pad && pad->dim[0].stride == 0)
+ pad->dim[0].stride = 1;
+ if (order && order->dim[0].stride == 0)
+ order->dim[0].stride = 1;
+
+ if (ret->data == NULL)
+ {
+ rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+ rs = 1;
+ for (n=0; n < rdim; n++)
+ {
+ ret->dim[n].lbound = 0;
+ rex = shape->data[n * shape->dim[0].stride];
+ ret->dim[n].ubound = rex - 1;
+ ret->dim[n].stride = rs;
+ rs *= rex;
+ }
+ ret->offset = 0;
+ ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_16));
+ ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim;
+ }
+ else
+ {
+ rdim = GFC_DESCRIPTOR_RANK (ret);
+ if (ret->dim[0].stride == 0)
+ ret->dim[0].stride = 1;
+ }
+
+ rsize = 1;
+ for (n = 0; n < rdim; n++)
+ {
+ if (order)
+ dim = order->data[n * order->dim[0].stride] - 1;
+ else
+ dim = n;
+
+ rcount[n] = 0;
+ rstride[n] = ret->dim[dim].stride;
+ rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+
+ if (rextent[n] != shape->data[dim * shape->dim[0].stride])
+ runtime_error ("shape and target do not conform");
+
+ if (rsize == rstride[n])
+ rsize *= rextent[n];
+ else
+ rsize = 0;
+ if (rextent[n] <= 0)
+ return;
+ }
+
+ sdim = GFC_DESCRIPTOR_RANK (source);
+ ssize = 1;
+ for (n = 0; n < sdim; n++)
+ {
+ scount[n] = 0;
+ sstride[n] = source->dim[n].stride;
+ sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ if (sextent[n] <= 0)
+ abort ();
+
+ if (ssize == sstride[n])
+ ssize *= sextent[n];
+ else
+ ssize = 0;
+ }
+
+ if (pad)
+ {
+ pdim = GFC_DESCRIPTOR_RANK (pad);
+ psize = 1;
+ for (n = 0; n < pdim; n++)
+ {
+ pcount[n] = 0;
+ pstride[n] = pad->dim[n].stride;
+ pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
+ if (pextent[n] <= 0)
+ abort ();
+ if (psize == pstride[n])
+ psize *= pextent[n];
+ else
+ psize = 0;
+ }
+ pptr = pad->data;
+ }
+ else
+ {
+ pdim = 0;
+ psize = 1;
+ pptr = NULL;
+ }
+
+ if (rsize != 0 && ssize != 0 && psize != 0)
+ {
+ rsize *= sizeof (GFC_COMPLEX_16);
+ ssize *= sizeof (GFC_COMPLEX_16);
+ psize *= sizeof (GFC_COMPLEX_16);
+ reshape_packed ((char *)ret->data, rsize, (char *)source->data,
+ ssize, pad ? (char *)pad->data : NULL, psize);
+ return;
+ }
+ rptr = ret->data;
+ src = sptr = source->data;
+ rstride0 = rstride[0];
+ sstride0 = sstride[0];
+
+ while (rptr)
+ {
+ /* Select between the source and pad arrays. */
+ *rptr = *src;
+ /* Advance to the next element. */
+ rptr += rstride0;
+ src += sstride0;
+ rcount[0]++;
+ scount[0]++;
+ /* Advance to the next destination element. */
+ n = 0;
+ while (rcount[n] == rextent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ rcount[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ rptr -= rstride[n] * rextent[n];
+ n++;
+ if (n == rdim)
+ {
+ /* Break out of the loop. */
+ rptr = NULL;
+ break;
+ }
+ else
+ {
+ rcount[n]++;
+ rptr += rstride[n];
+ }
+ }
+ /* Advance to the next source element. */
+ n = 0;
+ while (scount[n] == sextent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ scount[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ src -= sstride[n] * sextent[n];
+ n++;
+ if (n == sdim)
+ {
+ if (sptr && pad)
+ {
+ /* Switch to the pad array. */
+ sptr = NULL;
+ sdim = pdim;
+ for (dim = 0; dim < pdim; dim++)
+ {
+ scount[dim] = pcount[dim];
+ sextent[dim] = pextent[dim];
+ sstride[dim] = pstride[dim];
+ sstride0 = sstride[0];
+ }
+ }
+ /* We now start again from the beginning of the pad array. */
+ src = pptr;
+ break;
+ }
+ else
+ {
+ scount[n]++;
+ src += sstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_COMPLEX_4)
+
typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
/* The shape parameter is ignored. We can currently deduce the shape from the
}
}
}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_COMPLEX_8)
+
typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
/* The shape parameter is ignored. We can currently deduce the shape from the
}
}
}
+
+#endif
--- /dev/null
+/* Implementation of the RESHAPE
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
+
+/* The shape parameter is ignored. We can currently deduce the shape from the
+ return array. */
+
+extern void reshape_16 (gfc_array_i16 *, gfc_array_i16 *, shape_type *,
+ gfc_array_i16 *, shape_type *);
+export_proto(reshape_16);
+
+void
+reshape_16 (gfc_array_i16 * ret, gfc_array_i16 * source, shape_type * shape,
+ gfc_array_i16 * pad, shape_type * order)
+{
+ /* r.* indicates the return array. */
+ index_type rcount[GFC_MAX_DIMENSIONS];
+ index_type rextent[GFC_MAX_DIMENSIONS];
+ index_type rstride[GFC_MAX_DIMENSIONS];
+ index_type rstride0;
+ index_type rdim;
+ index_type rsize;
+ index_type rs;
+ index_type rex;
+ GFC_INTEGER_16 *rptr;
+ /* s.* indicates the source array. */
+ index_type scount[GFC_MAX_DIMENSIONS];
+ index_type sextent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type sstride0;
+ index_type sdim;
+ index_type ssize;
+ const GFC_INTEGER_16 *sptr;
+ /* p.* indicates the pad array. */
+ index_type pcount[GFC_MAX_DIMENSIONS];
+ index_type pextent[GFC_MAX_DIMENSIONS];
+ index_type pstride[GFC_MAX_DIMENSIONS];
+ index_type pdim;
+ index_type psize;
+ const GFC_INTEGER_16 *pptr;
+
+ const GFC_INTEGER_16 *src;
+ int n;
+ int dim;
+
+ if (source->dim[0].stride == 0)
+ source->dim[0].stride = 1;
+ if (shape->dim[0].stride == 0)
+ shape->dim[0].stride = 1;
+ if (pad && pad->dim[0].stride == 0)
+ pad->dim[0].stride = 1;
+ if (order && order->dim[0].stride == 0)
+ order->dim[0].stride = 1;
+
+ if (ret->data == NULL)
+ {
+ rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+ rs = 1;
+ for (n=0; n < rdim; n++)
+ {
+ ret->dim[n].lbound = 0;
+ rex = shape->data[n * shape->dim[0].stride];
+ ret->dim[n].ubound = rex - 1;
+ ret->dim[n].stride = rs;
+ rs *= rex;
+ }
+ ret->offset = 0;
+ ret->data = internal_malloc_size ( rs * sizeof (GFC_INTEGER_16));
+ ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim;
+ }
+ else
+ {
+ rdim = GFC_DESCRIPTOR_RANK (ret);
+ if (ret->dim[0].stride == 0)
+ ret->dim[0].stride = 1;
+ }
+
+ rsize = 1;
+ for (n = 0; n < rdim; n++)
+ {
+ if (order)
+ dim = order->data[n * order->dim[0].stride] - 1;
+ else
+ dim = n;
+
+ rcount[n] = 0;
+ rstride[n] = ret->dim[dim].stride;
+ rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+
+ if (rextent[n] != shape->data[dim * shape->dim[0].stride])
+ runtime_error ("shape and target do not conform");
+
+ if (rsize == rstride[n])
+ rsize *= rextent[n];
+ else
+ rsize = 0;
+ if (rextent[n] <= 0)
+ return;
+ }
+
+ sdim = GFC_DESCRIPTOR_RANK (source);
+ ssize = 1;
+ for (n = 0; n < sdim; n++)
+ {
+ scount[n] = 0;
+ sstride[n] = source->dim[n].stride;
+ sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+ if (sextent[n] <= 0)
+ abort ();
+
+ if (ssize == sstride[n])
+ ssize *= sextent[n];
+ else
+ ssize = 0;
+ }
+
+ if (pad)
+ {
+ pdim = GFC_DESCRIPTOR_RANK (pad);
+ psize = 1;
+ for (n = 0; n < pdim; n++)
+ {
+ pcount[n] = 0;
+ pstride[n] = pad->dim[n].stride;
+ pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
+ if (pextent[n] <= 0)
+ abort ();
+ if (psize == pstride[n])
+ psize *= pextent[n];
+ else
+ psize = 0;
+ }
+ pptr = pad->data;
+ }
+ else
+ {
+ pdim = 0;
+ psize = 1;
+ pptr = NULL;
+ }
+
+ if (rsize != 0 && ssize != 0 && psize != 0)
+ {
+ rsize *= sizeof (GFC_INTEGER_16);
+ ssize *= sizeof (GFC_INTEGER_16);
+ psize *= sizeof (GFC_INTEGER_16);
+ reshape_packed ((char *)ret->data, rsize, (char *)source->data,
+ ssize, pad ? (char *)pad->data : NULL, psize);
+ return;
+ }
+ rptr = ret->data;
+ src = sptr = source->data;
+ rstride0 = rstride[0];
+ sstride0 = sstride[0];
+
+ while (rptr)
+ {
+ /* Select between the source and pad arrays. */
+ *rptr = *src;
+ /* Advance to the next element. */
+ rptr += rstride0;
+ src += sstride0;
+ rcount[0]++;
+ scount[0]++;
+ /* Advance to the next destination element. */
+ n = 0;
+ while (rcount[n] == rextent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ rcount[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ rptr -= rstride[n] * rextent[n];
+ n++;
+ if (n == rdim)
+ {
+ /* Break out of the loop. */
+ rptr = NULL;
+ break;
+ }
+ else
+ {
+ rcount[n]++;
+ rptr += rstride[n];
+ }
+ }
+ /* Advance to the next source element. */
+ n = 0;
+ while (scount[n] == sextent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ scount[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ src -= sstride[n] * sextent[n];
+ n++;
+ if (n == sdim)
+ {
+ if (sptr && pad)
+ {
+ /* Switch to the pad array. */
+ sptr = NULL;
+ sdim = pdim;
+ for (dim = 0; dim < pdim; dim++)
+ {
+ scount[dim] = pcount[dim];
+ sextent[dim] = pextent[dim];
+ sstride[dim] = pstride[dim];
+ sstride0 = sstride[0];
+ }
+ }
+ /* We now start again from the beginning of the pad array. */
+ src = pptr;
+ break;
+ }
+ else
+ {
+ scount[n]++;
+ src += sstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4)
+
typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
/* The shape parameter is ignored. We can currently deduce the shape from the
}
}
}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8)
+
typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
/* The shape parameter is ignored. We can currently deduce the shape from the
}
}
}
+
+#endif
--- /dev/null
+/* Implementation of the SET_EXPONENT intrinsic
+ Copyright 2003 Free Software Foundation, Inc.
+ Contributed by Richard Henderson <rth@redhat.com>.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_SCALBNL) && defined (HAVE_FREXPL)
+
+extern GFC_REAL_10 set_exponent_r10 (GFC_REAL_10 s, GFC_INTEGER_4 i);
+export_proto(set_exponent_r10);
+
+GFC_REAL_10
+set_exponent_r10 (GFC_REAL_10 s, GFC_INTEGER_4 i)
+{
+ int dummy_exp;
+ return scalbnl (frexpl (s, &dummy_exp), i);
+}
+
+#endif
--- /dev/null
+/* Implementation of the SET_EXPONENT intrinsic
+ Copyright 2003 Free Software Foundation, Inc.
+ Contributed by Richard Henderson <rth@redhat.com>.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_SCALBNL) && defined (HAVE_FREXPL)
+
+extern GFC_REAL_16 set_exponent_r16 (GFC_REAL_16 s, GFC_INTEGER_4 i);
+export_proto(set_exponent_r16);
+
+GFC_REAL_16
+set_exponent_r16 (GFC_REAL_16 s, GFC_INTEGER_4 i)
+{
+ int dummy_exp;
+ return scalbnl (frexpl (s, &dummy_exp), i);
+}
+
+#endif
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
+
+#include "config.h"
#include <math.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_SCALBNF) && defined (HAVE_FREXPF)
+
extern GFC_REAL_4 set_exponent_r4 (GFC_REAL_4 s, GFC_INTEGER_4 i);
export_proto(set_exponent_r4);
int dummy_exp;
return scalbnf (frexpf (s, &dummy_exp), i);
}
+
+#endif
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
+
+#include "config.h"
#include <math.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_SCALBN) && defined (HAVE_FREXP)
+
extern GFC_REAL_8 set_exponent_r8 (GFC_REAL_8 s, GFC_INTEGER_4 i);
export_proto(set_exponent_r8);
int dummy_exp;
return scalbn (frexp (s, &dummy_exp), i);
}
+
+#endif
--- /dev/null
+/* Implementation of the SHAPE intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+extern void shape_16 (gfc_array_i16 * ret, const gfc_array_i16 * array);
+export_proto(shape_16);
+
+void
+shape_16 (gfc_array_i16 * ret, const gfc_array_i16 * array)
+{
+ int n;
+ index_type stride;
+
+ stride = ret->dim[0].stride;
+ if (stride == 0)
+ stride = 1;
+
+ for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++)
+ {
+ ret->data[n * stride] =
+ array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4)
+
extern void shape_4 (gfc_array_i4 * ret, const gfc_array_i4 * array);
export_proto(shape_4);
array->dim[n].ubound + 1 - array->dim[n].lbound;
}
}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8)
+
extern void shape_8 (gfc_array_i8 * ret, const gfc_array_i8 * array);
export_proto(shape_8);
array->dim[n].ubound + 1 - array->dim[n].lbound;
}
}
+
+#endif
--- /dev/null
+/* Implementation of the SUM intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_COMPLEX_10) && defined (HAVE_GFC_COMPLEX_10)
+
+
+extern void sum_c10 (gfc_array_c10 *, gfc_array_c10 *, index_type *);
+export_proto(sum_c10);
+
+void
+sum_c10 (gfc_array_c10 *retarray, gfc_array_c10 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_COMPLEX_10 *base;
+ GFC_COMPLEX_10 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_COMPLEX_10)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_COMPLEX_10 *src;
+ GFC_COMPLEX_10 result;
+ src = base;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result += *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void msum_c10 (gfc_array_c10 *, gfc_array_c10 *, index_type *,
+ gfc_array_l4 *);
+export_proto(msum_c10);
+
+void
+msum_c10 (gfc_array_c10 * retarray, gfc_array_c10 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_COMPLEX_10 *dest;
+ GFC_COMPLEX_10 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_COMPLEX_10)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_COMPLEX_10 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_COMPLEX_10 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result += *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the SUM intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_COMPLEX_16) && defined (HAVE_GFC_COMPLEX_16)
+
+
+extern void sum_c16 (gfc_array_c16 *, gfc_array_c16 *, index_type *);
+export_proto(sum_c16);
+
+void
+sum_c16 (gfc_array_c16 *retarray, gfc_array_c16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_COMPLEX_16 *base;
+ GFC_COMPLEX_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_COMPLEX_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_COMPLEX_16 *src;
+ GFC_COMPLEX_16 result;
+ src = base;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result += *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void msum_c16 (gfc_array_c16 *, gfc_array_c16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(msum_c16);
+
+void
+msum_c16 (gfc_array_c16 * retarray, gfc_array_c16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_COMPLEX_16 *dest;
+ GFC_COMPLEX_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_COMPLEX_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_COMPLEX_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_COMPLEX_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result += *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_COMPLEX_4) && defined (HAVE_GFC_COMPLEX_4)
+
+
extern void sum_c4 (gfc_array_c4 *, gfc_array_c4 *, index_type *);
export_proto(sum_c4);
}
}
}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_COMPLEX_8) && defined (HAVE_GFC_COMPLEX_8)
+
+
extern void sum_c8 (gfc_array_c8 *, gfc_array_c8 *, index_type *);
export_proto(sum_c8);
}
}
}
+
+#endif
--- /dev/null
+/* Implementation of the SUM intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void sum_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *);
+export_proto(sum_i16);
+
+void
+sum_i16 (gfc_array_i16 *retarray, gfc_array_i16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *base;
+ GFC_INTEGER_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_INTEGER_16 *src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result += *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void msum_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(msum_i16);
+
+void
+msum_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 *dest;
+ GFC_INTEGER_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_INTEGER_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_INTEGER_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_INTEGER_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result += *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
+
extern void sum_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *);
export_proto(sum_i4);
}
}
}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
+
extern void sum_i8 (gfc_array_i8 *, gfc_array_i8 *, index_type *);
export_proto(sum_i8);
}
}
}
+
+#endif
--- /dev/null
+/* Implementation of the SUM intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_REAL_10)
+
+
+extern void sum_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *);
+export_proto(sum_r10);
+
+void
+sum_r10 (gfc_array_r10 *retarray, gfc_array_r10 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_10 *base;
+ GFC_REAL_10 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_REAL_10)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_10 *src;
+ GFC_REAL_10 result;
+ src = base;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result += *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void msum_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *,
+ gfc_array_l4 *);
+export_proto(msum_r10);
+
+void
+msum_r10 (gfc_array_r10 * retarray, gfc_array_r10 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_10 *dest;
+ GFC_REAL_10 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_REAL_10)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_10 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_REAL_10 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result += *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the SUM intrinsic
+ Copyright 2002 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_REAL_16)
+
+
+extern void sum_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *);
+export_proto(sum_r16);
+
+void
+sum_r16 (gfc_array_r16 *retarray, gfc_array_r16 *array, index_type *pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_16 *base;
+ GFC_REAL_16 *dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ delta = array->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_REAL_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ while (base)
+ {
+ GFC_REAL_16 *src;
+ GFC_REAL_16 result;
+ src = base;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result += *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void msum_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *,
+ gfc_array_l4 *);
+export_proto(msum_r16);
+
+void
+msum_r16 (gfc_array_r16 * retarray, gfc_array_r16 * array,
+ index_type *pdim, gfc_array_l4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_REAL_16 *dest;
+ GFC_REAL_16 *base;
+ GFC_LOGICAL_4 *mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ /* TODO: It should be a front end job to correctly set the strides. */
+
+ if (array->dim[0].stride == 0)
+ array->dim[0].stride = 1;
+
+ if (mask->dim[0].stride == 0)
+ mask->dim[0].stride = 1;
+
+ len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+ if (len <= 0)
+ return;
+ delta = array->dim[dim].stride;
+ mdelta = mask->dim[dim].stride;
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = array->dim[n].stride;
+ mstride[n] = mask->dim[n].stride;
+ extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = array->dim[n + 1].stride;
+ mstride[n] = mask->dim[n + 1].stride;
+ extent[n] =
+ array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+ }
+
+ if (retarray->data == NULL)
+ {
+ for (n = 0; n < rank; n++)
+ {
+ retarray->dim[n].lbound = 0;
+ retarray->dim[n].ubound = extent[n]-1;
+ if (n == 0)
+ retarray->dim[n].stride = 1;
+ else
+ retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+ }
+
+ retarray->data
+ = internal_malloc_size (sizeof (GFC_REAL_16)
+ * retarray->dim[rank-1].stride
+ * extent[rank-1]);
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+ }
+ else
+ {
+ if (retarray->dim[0].stride == 0)
+ retarray->dim[0].stride = 1;
+
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = retarray->dim[n].stride;
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->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)
+ {
+ GFC_REAL_16 *src;
+ GFC_LOGICAL_4 *msrc;
+ GFC_REAL_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result += *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ /* When we get to the end of a dimension, reset it and increment
+ the next dimension. */
+ count[n] = 0;
+ /* We could precalculate these products, but this is a less
+ frequently used path so proabably not worth it. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_REAL_4)
+
+
extern void sum_r4 (gfc_array_r4 *, gfc_array_r4 *, index_type *);
export_proto(sum_r4);
}
}
}
+
+#endif
#include "libgfortran.h"
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_REAL_8)
+
+
extern void sum_r8 (gfc_array_r8 *, gfc_array_r8 *, index_type *);
export_proto(sum_r8);
}
}
}
+
+#endif
--- /dev/null
+/* Implementation of the TRANSPOSE intrinsic
+ Copyright 2003, 2005 Free Software Foundation, Inc.
+ Contributed by Tobias Schlüter
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+
+extern void transpose_c10 (gfc_array_c10 * ret, gfc_array_c10 * source);
+export_proto(transpose_c10);
+
+void
+transpose_c10 (gfc_array_c10 * ret, gfc_array_c10 * source)
+{
+ /* r.* indicates the return array. */
+ index_type rxstride, rystride;
+ GFC_COMPLEX_10 *rptr;
+ /* s.* indicates the source array. */
+ index_type sxstride, systride;
+ const GFC_COMPLEX_10 *sptr;
+
+ index_type xcount, ycount;
+ index_type x, y;
+
+ assert (GFC_DESCRIPTOR_RANK (source) == 2);
+
+ if (ret->data == NULL)
+ {
+ assert (GFC_DESCRIPTOR_RANK (ret) == 2);
+ assert (ret->dtype == source->dtype);
+
+ ret->dim[0].lbound = 0;
+ ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
+ ret->dim[0].stride = 1;
+
+ ret->dim[1].lbound = 0;
+ ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
+ ret->dim[1].stride = ret->dim[0].ubound+1;
+
+ ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_10) * size0 ((array_t *) ret));
+ ret->offset = 0;
+ }
+
+ if (ret->dim[0].stride == 0)
+ ret->dim[0].stride = 1;
+ if (source->dim[0].stride == 0)
+ source->dim[0].stride = 1;
+
+ sxstride = source->dim[0].stride;
+ systride = source->dim[1].stride;
+ xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
+ ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
+
+ rxstride = ret->dim[0].stride;
+ rystride = ret->dim[1].stride;
+
+ rptr = ret->data;
+ sptr = source->data;
+
+ for (y=0; y < ycount; y++)
+ {
+ for (x=0; x < xcount; x++)
+ {
+ *rptr = *sptr;
+
+ sptr += sxstride;
+ rptr += rystride;
+ }
+ sptr += systride - (sxstride * xcount);
+ rptr += rxstride - (rystride * xcount);
+ }
+}
+
+#endif
--- /dev/null
+/* Implementation of the TRANSPOSE intrinsic
+ Copyright 2003, 2005 Free Software Foundation, Inc.
+ Contributed by Tobias Schlüter
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+
+extern void transpose_c16 (gfc_array_c16 * ret, gfc_array_c16 * source);
+export_proto(transpose_c16);
+
+void
+transpose_c16 (gfc_array_c16 * ret, gfc_array_c16 * source)
+{
+ /* r.* indicates the return array. */
+ index_type rxstride, rystride;
+ GFC_COMPLEX_16 *rptr;
+ /* s.* indicates the source array. */
+ index_type sxstride, systride;
+ const GFC_COMPLEX_16 *sptr;
+
+ index_type xcount, ycount;
+ index_type x, y;
+
+ assert (GFC_DESCRIPTOR_RANK (source) == 2);
+
+ if (ret->data == NULL)
+ {
+ assert (GFC_DESCRIPTOR_RANK (ret) == 2);
+ assert (ret->dtype == source->dtype);
+
+ ret->dim[0].lbound = 0;
+ ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
+ ret->dim[0].stride = 1;
+
+ ret->dim[1].lbound = 0;
+ ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
+ ret->dim[1].stride = ret->dim[0].ubound+1;
+
+ ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_16) * size0 ((array_t *) ret));
+ ret->offset = 0;
+ }
+
+ if (ret->dim[0].stride == 0)
+ ret->dim[0].stride = 1;
+ if (source->dim[0].stride == 0)
+ source->dim[0].stride = 1;
+
+ sxstride = source->dim[0].stride;
+ systride = source->dim[1].stride;
+ xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
+ ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
+
+ rxstride = ret->dim[0].stride;
+ rystride = ret->dim[1].stride;
+
+ rptr = ret->data;
+ sptr = source->data;
+
+ for (y=0; y < ycount; y++)
+ {
+ for (x=0; x < xcount; x++)
+ {
+ *rptr = *sptr;
+
+ sptr += sxstride;
+ rptr += rystride;
+ }
+ sptr += systride - (sxstride * xcount);
+ rptr += rxstride - (rystride * xcount);
+ }
+}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_COMPLEX_4)
+
extern void transpose_c4 (gfc_array_c4 * ret, gfc_array_c4 * source);
export_proto(transpose_c4);
rptr += rxstride - (rystride * xcount);
}
}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_COMPLEX_8)
+
extern void transpose_c8 (gfc_array_c8 * ret, gfc_array_c8 * source);
export_proto(transpose_c8);
rptr += rxstride - (rystride * xcount);
}
}
+
+#endif
--- /dev/null
+/* Implementation of the TRANSPOSE intrinsic
+ Copyright 2003, 2005 Free Software Foundation, Inc.
+ Contributed by Tobias Schlüter
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+extern void transpose_i16 (gfc_array_i16 * ret, gfc_array_i16 * source);
+export_proto(transpose_i16);
+
+void
+transpose_i16 (gfc_array_i16 * ret, gfc_array_i16 * source)
+{
+ /* r.* indicates the return array. */
+ index_type rxstride, rystride;
+ GFC_INTEGER_16 *rptr;
+ /* s.* indicates the source array. */
+ index_type sxstride, systride;
+ const GFC_INTEGER_16 *sptr;
+
+ index_type xcount, ycount;
+ index_type x, y;
+
+ assert (GFC_DESCRIPTOR_RANK (source) == 2);
+
+ if (ret->data == NULL)
+ {
+ assert (GFC_DESCRIPTOR_RANK (ret) == 2);
+ assert (ret->dtype == source->dtype);
+
+ ret->dim[0].lbound = 0;
+ ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
+ ret->dim[0].stride = 1;
+
+ ret->dim[1].lbound = 0;
+ ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
+ ret->dim[1].stride = ret->dim[0].ubound+1;
+
+ ret->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * size0 ((array_t *) ret));
+ ret->offset = 0;
+ }
+
+ if (ret->dim[0].stride == 0)
+ ret->dim[0].stride = 1;
+ if (source->dim[0].stride == 0)
+ source->dim[0].stride = 1;
+
+ sxstride = source->dim[0].stride;
+ systride = source->dim[1].stride;
+ xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
+ ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
+
+ rxstride = ret->dim[0].stride;
+ rystride = ret->dim[1].stride;
+
+ rptr = ret->data;
+ sptr = source->data;
+
+ for (y=0; y < ycount; y++)
+ {
+ for (x=0; x < xcount; x++)
+ {
+ *rptr = *sptr;
+
+ sptr += sxstride;
+ rptr += rystride;
+ }
+ sptr += systride - (sxstride * xcount);
+ rptr += rxstride - (rystride * xcount);
+ }
+}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_4)
+
extern void transpose_i4 (gfc_array_i4 * ret, gfc_array_i4 * source);
export_proto(transpose_i4);
rptr += rxstride - (rystride * xcount);
}
}
+
+#endif
#include <assert.h>
#include "libgfortran.h"
+#if defined (HAVE_GFC_INTEGER_8)
+
extern void transpose_i8 (gfc_array_i8 * ret, gfc_array_i8 * source);
export_proto(transpose_i8);
rptr += rxstride - (rystride * xcount);
}
}
+
+#endif
bits = i & ~mask;
return (i & mask) | (bits >> (size - shift)) | ((i << shift) & ~mask);
}
+
+#ifdef HAVE_GFC_INTEGER_16
+extern GFC_INTEGER_16 ishftc16 (GFC_INTEGER_16, GFC_INTEGER_4, GFC_INTEGER_4);
+export_proto(ishftc16);
+
+GFC_INTEGER_16
+ishftc16 (GFC_INTEGER_16 i, GFC_INTEGER_4 shift, GFC_INTEGER_4 size)
+{
+ GFC_INTEGER_16 mask;
+ GFC_UINTEGER_16 bits;
+
+ if (shift < 0)
+ shift = shift + size;
+
+ if (shift == 0 || shift == size)
+ return i;
+
+ mask = (~(GFC_INTEGER_16)0) << size;
+ bits = i & ~mask;
+ return (i & mask) | (bits >> (size - shift)) | ((i << shift) & ~mask);
+}
+#endif
(GFC_INTEGER_4)((((GFC_UINTEGER_4)1) << 31) - 1)
#define GFC_INTEGER_8_HUGE \
(GFC_INTEGER_8)((((GFC_UINTEGER_8)1) << 63) - 1)
+#ifdef HAVE_GFC_INTEGER_16
+#define GFC_INTEGER_16_HUGE \
+ (GFC_INTEGER_16)((((GFC_UINTEGER_16)1) << 127) - 1)
+#endif
+
#define GFC_REAL_4_HUGE FLT_MAX
#define GFC_REAL_8_HUGE DBL_MAX
+#ifdef HAVE_GFC_REAL_10
+#define GFC_REAL_10_HUGE LDBL_MAX
+#endif
+#ifdef HAVE_GFC_REAL_16
+#define GFC_REAL_16_HUGE LDBL_MAX
+#endif
#ifndef GFC_MAX_DIMENSIONS
#define GFC_MAX_DIMENSIONS 7
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, char) gfc_array_char;
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_array_i4;
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_8) gfc_array_i8;
+#ifdef HAVE_GFC_INTEGER_16
+typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_16) gfc_array_i16;
+#endif
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_4) gfc_array_r4;
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_8) gfc_array_r8;
+#ifdef HAVE_GFC_REAL_10
+typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_10) gfc_array_r10;
+#endif
+#ifdef HAVE_GFC_REAL_16
+typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_16) gfc_array_r16;
+#endif
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_4) gfc_array_c4;
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_8) gfc_array_c8;
+#ifdef HAVE_GFC_COMPLEX_10
+typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_10) gfc_array_c10;
+#endif
+#ifdef HAVE_GFC_COMPLEX_16
+typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_16) gfc_array_c16;
+#endif
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_4) gfc_array_l4;
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_8) gfc_array_l8;
+#ifdef HAVE_GFC_LOGICAL_16
+typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16;
+#endif
#define GFC_DTYPE_RANK_MASK 0x07
#define GFC_DTYPE_TYPE_SHIFT 3
include(iparm.m4)dnl
include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
ARRAY_FUNCTION(1,
` /* Return true only if all the elements are set. */
result = 1;',
break;
}')
+#endif
include(iparm.m4)dnl
include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
ARRAY_FUNCTION(0,
` result = 0;',
` /* Return true if any of the elements are set. */
break;
}')
+#endif
include(iparm.m4)dnl
include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
ARRAY_FUNCTION(0,
` result = 0;',
` if (*src)
result++;')
+#endif
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'atype_name`)'
+
static void
cshift1 (gfc_array_char * ret, const gfc_array_char * array,
const atype * h, const atype_name * pwhich, index_type size)
{
cshift1 (ret, array, h, pwhich, array_length);
}
+
+#endif
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'rtype_name`)'
+
typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
extern rtype_name dot_product_`'rtype_code (rtype * a, rtype * b);
return res;
}
+
+#endif
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'rtype_name`)'
+
typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
extern rtype_name dot_product_`'rtype_code (rtype * a, rtype * b);
return res;
}
+
+#endif
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'rtype_name`)'
+
extern rtype_name dot_product_`'rtype_code (gfc_array_l4 *, gfc_array_l4 *);
export_proto(dot_product_`'rtype_code);
return 0;
}
+
+#endif
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'atype_name`)'
+
static void
eoshift1 (gfc_array_char *ret, const gfc_array_char *array, const atype *h,
const char *pbound, const atype_name *pwhich, index_type size,
{
eoshift1 (ret, array, h, pbound, pwhich, array_length, ' ');
}
+
+#endif
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'atype_name`)'
+
static void
eoshift3 (gfc_array_char *ret, const gfc_array_char *array, const atype *h,
const gfc_array_char *bound, const atype_name *pwhich,
{
eoshift3 (ret, array, h, bound, pwhich, array_length, ' ');
}
+
+#endif
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
+
+#include "config.h"
#include <math.h>
#include "libgfortran.h"'
include(`mtype.m4')dnl
+`#if defined (HAVE_'real_type`) && defined (HAVE_FREXP'Q`)'
+
extern GFC_INTEGER_4 exponent_r`'kind (real_type s);
export_proto(exponent_r`'kind);
frexp`'q (s, &ret);
return ret;
}
+
+#endif
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
+
+#include "config.h"
#include <math.h>
#include "libgfortran.h"'
include(`mtype.m4')dnl
+`#if defined (HAVE_'real_type`) && defined (HAVE_FREXP'Q`)'
+
extern real_type fraction_r`'kind (real_type s);
export_proto(fraction_r`'kind);
int dummy_exp;
return frexp`'q (s, &dummy_exp);
}
+
+#endif
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'rtype_name`)'
+
/* Allocates a block of memory with internal_malloc if the array needs
repacking. */
return destptr;
}
+#endif
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'rtype_name`)'
+
dnl Only the kind (ie size) is used to name the function for integers,
dnl reals and logicals. For complex, it's c4 and c8.
void
}
}
+#endif
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'rtype_name`)'
+
/* This is a C version of the following fortran pseudo-code. The key
point is the loop order -- we access all arrays column-first, which
improves the performance enough to boost galgel spec score by 50%.
dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
}
}
+
+#endif
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'rtype_name`)'
+
/* Dimensions: retarray(x,y) a(x, count) b(count,y).
Either a or b can be rank 1. In this case x or y is 1. */
dest += rystride - (rxstride * xcount);
}
}
+
+#endif
include(iparm.m4)dnl
include(iforeach.m4)dnl
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
FOREACH_FUNCTION(
` atype_name maxval;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}')
+
+#endif
include(iparm.m4)dnl
include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
ARRAY_FUNCTION(0,
` atype_name maxval;
maxval = atype_min;
result = (rtype_name)n + 1;
}')
+#endif
include(iparm.m4)dnl
include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
ARRAY_FUNCTION(atype_min,
` result = atype_min;',
` if (*src > result)
` if (*msrc && *src > result)
result = *src;')
+#endif
include(iparm.m4)dnl
include(iforeach.m4)dnl
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
FOREACH_FUNCTION(
` atype_name minval;
for (n = 0; n < rank; n++)
dest[n * dstride] = count[n] + 1;
}')
+
+#endif
include(iparm.m4)dnl
include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
ARRAY_FUNCTION(0,
` atype_name minval;
minval = atype_max;
result = (rtype_name)n + 1;
}')
+#endif
include(iparm.m4)dnl
include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
ARRAY_FUNCTION(atype_max,
` result = atype_max;',
` if (*src < result)
` if (*msrc && *src < result)
result = *src;')
+#endif
define(kind,regexp(file, `_.\([0-9]+\).c$', `\1'))dnl
define(complex_type, `GFC_COMPLEX_'kind)dnl
define(real_type, `GFC_REAL_'kind)dnl
-define(q,ifelse(kind,4,f,ifelse(kind,8,`',`_'kind)))dnl
+define(q,ifelse(kind,4,f,ifelse(kind,8,`',ifelse(kind,10,l,ifelse(kind,16,l,`_'kind)))))dnl
+define(Q,translit(q,`a-z',`A-Z'))dnl
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
+
+#include "config.h"
#include <math.h>
#include <float.h>
#include "libgfortran.h"'
include(`mtype.m4')dnl
+`#if defined (HAVE_'real_type`) && defined (HAVE_COPYSIGN'Q`) && defined (HAVE_NEXTAFTER'Q`)'
+
extern real_type nearest_r`'kind (real_type s, real_type dir);
export_proto(nearest_r`'kind);
else
return nextafter`'q (s, dir);
}
+
+#endif
Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
of Computer Programming", 3rd Edition, 1998. */
+`#if defined (HAVE_'rtype_name`) && defined (HAVE_'atype_name`)'
+
rtype_name `pow_'rtype_code`_'atype_code (rtype_name a, atype_name b);
export_proto(pow_`'rtype_code`_'atype_code);
}
return pow;
}
+
+#endif
include(iparm.m4)dnl
include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
ARRAY_FUNCTION(1,
` result = 1;',
` result *= *src;')
` if (*msrc)
result *= *src;')
+#endif
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'rtype_name`)'
+
typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
/* The shape parameter is ignored. We can currently deduce the shape from the
}
}
}
+
+#endif
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
+
+#include "config.h"
#include <math.h>
#include "libgfortran.h"'
include(`mtype.m4')dnl
+`#if defined (HAVE_'real_type`) && defined (HAVE_SCALBN'Q`) && defined (HAVE_FREXP'Q`)'
+
extern real_type set_exponent_r`'kind (real_type s, GFC_INTEGER_4 i);
export_proto(set_exponent_r`'kind);
int dummy_exp;
return scalbn`'q (frexp`'q (s, &dummy_exp), i);
}
+
+#endif
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'rtype_name`)'
+
extern void shape_`'rtype_kind (rtype * ret, const rtype * array);
export_proto(shape_`'rtype_kind);
array->dim[n].ubound + 1 - array->dim[n].lbound;
}
}
+
+#endif
include(head.m4)
-define(atype_code,regexp(file,`_\([ircl][0-9]+\).f90',`\1'))dnl
+define(atype_code,regexp(file,`_\([ircl][0-9]+\).[fF]90',`\1'))dnl
define(atype_letter,substr(atype_code, 0, 1))dnl
define(atype_kind,substr(atype_code, 1))dnl
define(get_typename2, `$1 (kind=$2)')dnl
define(name, regexp(regexp(file, `[^/]*$', `\&'), `^_\([^_]*\)_', `\1'))dnl
define(function_name,`specific__'name`_'atype_code)dnl
+define(type,ifelse(atype_letter,l,LOGICAL,ifelse(atype_letter,i,INTEGER,ifelse(atype_letter,r,REAL,ifelse(atype_letter,c,COMPLEX,UNKNOW)))))dnl
+define(Q,ifelse(atype_kind,4,F,ifelse(atype_kind,8,`',ifelse(atype_kind,10,L,ifelse(atype_kind,16,L,`_'atype_kind)))))dnl
+
+dnl A few specifics require a function other than their name, or
+dnl nothing. The list is currently:
+dnl - integer and logical specifics require no libm function
+dnl - AINT requires the trunc() family functions
+dnl - ANINT requires round()
+dnl - CONJG, DIM, SIGN require no libm function
+define(needed,ifelse(atype_letter,i,`none',ifelse(atype_letter,l,`none',ifelse(name,aint,trunc,ifelse(name,anint,round,ifelse(name,conjg,none,ifelse(name,dim,none,ifelse(name,sign,none,ifelse(name,abs,fabs,name)))))))))dnl
+define(prefix,ifelse(atype_letter,c,C,`'))dnl
+
+dnl Special case for fabs, for which the corresponding complex function
+dnl is not cfabs but cabs.
+define(NEEDED,translit(ifelse(prefix`'needed,`Cfabs',`abs',needed),`a-z',`A-Z'))dnl
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+`#if defined (HAVE_GFC_'type`_'atype_kind`)'
+ifelse(NEEDED,NONE,`',`#ifdef HAVE_'prefix`'NEEDED`'Q)
+
elemental function function_name (parm)
atype_name, intent (in) :: parm
atype_name :: function_name
function_name = name (parm)
end function
+
+ifelse(NEEDED,NONE,`',`#endif')
+#endif
include(head.m4)
-define(atype_code,regexp(file,`_\([ircl][0-9]+\).f90',`\1'))dnl
+define(atype_code,regexp(file,`_\([ircl][0-9]+\).[fF]90',`\1'))dnl
define(atype_letter,substr(atype_code, 0, 1))dnl
define(atype_kind,substr(atype_code, 1))dnl
define(get_typename2, `$1 (kind=$2)')dnl
define(name, regexp(regexp(file, `[^/]*$', `\&'), `^_\([^_]*\)_', `\1'))dnl
define(function_name,`specific__'name`_'atype_code)dnl
+define(Q,ifelse(atype_kind,4,F,ifelse(atype_kind,8,`',ifelse(atype_kind,10,L,ifelse(atype_kind,16,L,`_'atype_kind)))))dnl
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+`#if defined (HAVE_GFC_'ifelse(atype_letter,l,LOGICAL,ifelse(atype_letter,i,INTEGER,ifelse(atype_letter,r,REAL,ifelse(atype_letter,c,COMPLEX,UNKNOW))))`_'atype_kind`)'
+
+ifelse(name,atan2,`#ifdef HAVE_ATAN2'Q,)
+
elemental function function_name (p1, p2)
atype_name, intent (in) :: p1, p2
atype_name :: function_name
function_name = name (p1, p2)
end function
+
+ifelse(name,atan2,`#endif',)
+
+#endif
include(iparm.m4)dnl
include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
ARRAY_FUNCTION(0,
` result = 0;',
` result += *src;')
` result = 0;',
` if (*msrc)
result += *src;')
+
+#endif
#include "libgfortran.h"'
include(iparm.m4)dnl
+`#if defined (HAVE_'rtype_name`)'
+
extern void transpose_`'rtype_code (rtype * ret, rtype * source);
export_proto(transpose_`'rtype_code);
rptr += rxstride - (rystride * xcount);
}
}
+
+#endif
echo "typedef ${prefix}int${s}_t GFC_INTEGER_${k};"
echo "typedef ${prefix}uint${s}_t GFC_UINTEGER_${k};"
echo "typedef GFC_INTEGER_${k} GFC_LOGICAL_${k};"
+ echo "#define HAVE_GFC_LOGICAL_${k}"
echo "#define HAVE_GFC_INTEGER_${k}"
fi
rm -f tmp$$.*
echo "typedef ${ctype} GFC_REAL_${k};"
echo "typedef complex ${ctype} GFC_COMPLEX_${k};"
echo "#define HAVE_GFC_REAL_${k}"
+ echo "#define HAVE_GFC_COMPLEX_${k}"
fi
rm -f tmp$$.*
done