mirror of git://gcc.gnu.org/git/gcc.git
re PR fortran/40643 (maxloc/minloc: Wrong result for NaN at position 1)
PR fortran/40643 PR fortran/31067 * trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc, gfc_conv_intrinsic_minmaxval): Handle Infinities and NaNs properly, optimize. * trans-array.c (gfc_trans_scalarized_loop_end): No longer static. * trans-array.h (gfc_trans_scalarized_loop_end): New prototype. * libgfortran.h (GFC_REAL_4_INFINITY, GFC_REAL_8_INFINITY, GFC_REAL_10_INFINITY, GFC_REAL_16_INFINITY, GFC_REAL_4_QUIET_NAN, GFC_REAL_8_QUIET_NAN, GFC_REAL_10_QUIET_NAN, GFC_REAL_16_QUIET_NAN): Define. * m4/iparm.m4 (atype_inf, atype_nan): Define. * m4/ifunction.m4: Formatting. * m4/iforeach.m4: Likewise. (START_FOREACH_FUNCTION): Initialize dest to all 1s, not all 0s. (START_FOREACH_BLOCK, FINISH_FOREACH_FUNCTION, FINISH_MASKED_FOREACH_FUNCTION): Run foreach block inside a loop until count[0] == extent[0]. * m4/minval.m4: Formatting. Handle NaNs and infinities. Optimize. * m4/maxval.m4: Likewise. * m4/minloc0.m4: Likewise. * m4/maxloc0.m4: Likewise. * m4/minloc1.m4: Likewise. * m4/maxloc1.m4: Likewise. * generated/maxloc0_16_i16.c: Regenerated. * generated/maxloc0_16_i1.c: Likewise. * generated/maxloc0_16_i2.c: Likewise. * generated/maxloc0_16_i4.c: Likewise. * generated/maxloc0_16_i8.c: Likewise. * generated/maxloc0_16_r10.c: Likewise. * generated/maxloc0_16_r16.c: Likewise. * generated/maxloc0_16_r4.c: Likewise. * generated/maxloc0_16_r8.c: Likewise. * generated/maxloc0_4_i16.c: Likewise. * generated/maxloc0_4_i1.c: Likewise. * generated/maxloc0_4_i2.c: Likewise. * generated/maxloc0_4_i4.c: Likewise. * generated/maxloc0_4_i8.c: Likewise. * generated/maxloc0_4_r10.c: Likewise. * generated/maxloc0_4_r16.c: Likewise. * generated/maxloc0_4_r4.c: Likewise. * generated/maxloc0_4_r8.c: Likewise. * generated/maxloc0_8_i16.c: Likewise. * generated/maxloc0_8_i1.c: Likewise. * generated/maxloc0_8_i2.c: Likewise. * generated/maxloc0_8_i4.c: Likewise. * generated/maxloc0_8_i8.c: Likewise. * generated/maxloc0_8_r10.c: Likewise. * generated/maxloc0_8_r16.c: Likewise. * generated/maxloc0_8_r4.c: Likewise. * generated/maxloc0_8_r8.c: Likewise. * generated/maxloc1_16_i16.c: Likewise. * generated/maxloc1_16_i1.c: Likewise. * generated/maxloc1_16_i2.c: Likewise. * generated/maxloc1_16_i4.c: Likewise. * generated/maxloc1_16_i8.c: Likewise. * generated/maxloc1_16_r10.c: Likewise. * generated/maxloc1_16_r16.c: Likewise. * generated/maxloc1_16_r4.c: Likewise. * generated/maxloc1_16_r8.c: Likewise. * generated/maxloc1_4_i16.c: Likewise. * generated/maxloc1_4_i1.c: Likewise. * generated/maxloc1_4_i2.c: Likewise. * generated/maxloc1_4_i4.c: Likewise. * generated/maxloc1_4_i8.c: Likewise. * generated/maxloc1_4_r10.c: Likewise. * generated/maxloc1_4_r16.c: Likewise. * generated/maxloc1_4_r4.c: Likewise. * generated/maxloc1_4_r8.c: Likewise. * generated/maxloc1_8_i16.c: Likewise. * generated/maxloc1_8_i1.c: Likewise. * generated/maxloc1_8_i2.c: Likewise. * generated/maxloc1_8_i4.c: Likewise. * generated/maxloc1_8_i8.c: Likewise. * generated/maxloc1_8_r10.c: Likewise. * generated/maxloc1_8_r16.c: Likewise. * generated/maxloc1_8_r4.c: Likewise. * generated/maxloc1_8_r8.c: Likewise. * generated/maxval_i16.c: Likewise. * generated/maxval_i1.c: Likewise. * generated/maxval_i2.c: Likewise. * generated/maxval_i4.c: Likewise. * generated/maxval_i8.c: Likewise. * generated/maxval_r10.c: Likewise. * generated/maxval_r16.c: Likewise. * generated/maxval_r4.c: Likewise. * generated/maxval_r8.c: Likewise. * generated/minloc0_16_i16.c: Likewise. * generated/minloc0_16_i1.c: Likewise. * generated/minloc0_16_i2.c: Likewise. * generated/minloc0_16_i4.c: Likewise. * generated/minloc0_16_i8.c: Likewise. * generated/minloc0_16_r10.c: Likewise. * generated/minloc0_16_r16.c: Likewise. * generated/minloc0_16_r4.c: Likewise. * generated/minloc0_16_r8.c: Likewise. * generated/minloc0_4_i16.c: Likewise. * generated/minloc0_4_i1.c: Likewise. * generated/minloc0_4_i2.c: Likewise. * generated/minloc0_4_i4.c: Likewise. * generated/minloc0_4_i8.c: Likewise. * generated/minloc0_4_r10.c: Likewise. * generated/minloc0_4_r16.c: Likewise. * generated/minloc0_4_r4.c: Likewise. * generated/minloc0_4_r8.c: Likewise. * generated/minloc0_8_i16.c: Likewise. * generated/minloc0_8_i1.c: Likewise. * generated/minloc0_8_i2.c: Likewise. * generated/minloc0_8_i4.c: Likewise. * generated/minloc0_8_i8.c: Likewise. * generated/minloc0_8_r10.c: Likewise. * generated/minloc0_8_r16.c: Likewise. * generated/minloc0_8_r4.c: Likewise. * generated/minloc0_8_r8.c: Likewise. * generated/minloc1_16_i16.c: Likewise. * generated/minloc1_16_i1.c: Likewise. * generated/minloc1_16_i2.c: Likewise. * generated/minloc1_16_i4.c: Likewise. * generated/minloc1_16_i8.c: Likewise. * generated/minloc1_16_r10.c: Likewise. * generated/minloc1_16_r16.c: Likewise. * generated/minloc1_16_r4.c: Likewise. * generated/minloc1_16_r8.c: Likewise. * generated/minloc1_4_i16.c: Likewise. * generated/minloc1_4_i1.c: Likewise. * generated/minloc1_4_i2.c: Likewise. * generated/minloc1_4_i4.c: Likewise. * generated/minloc1_4_i8.c: Likewise. * generated/minloc1_4_r10.c: Likewise. * generated/minloc1_4_r16.c: Likewise. * generated/minloc1_4_r4.c: Likewise. * generated/minloc1_4_r8.c: Likewise. * generated/minloc1_8_i16.c: Likewise. * generated/minloc1_8_i1.c: Likewise. * generated/minloc1_8_i2.c: Likewise. * generated/minloc1_8_i4.c: Likewise. * generated/minloc1_8_i8.c: Likewise. * generated/minloc1_8_r10.c: Likewise. * generated/minloc1_8_r16.c: Likewise. * generated/minloc1_8_r4.c: Likewise. * generated/minloc1_8_r8.c: Likewise. * generated/minval_i16.c: Likewise. * generated/minval_i1.c: Likewise. * generated/minval_i2.c: Likewise. * generated/minval_i4.c: Likewise. * generated/minval_i8.c: Likewise. * generated/minval_r10.c: Likewise. * generated/minval_r16.c: Likewise. * generated/minval_r4.c: Likewise. * generated/minval_r8.c: Likewise. * generated/product_c10.c: Likewise. * generated/product_c16.c: Likewise. * generated/product_c4.c: Likewise. * generated/product_c8.c: Likewise. * generated/product_i16.c: Likewise. * generated/product_i1.c: Likewise. * generated/product_i2.c: Likewise. * generated/product_i4.c: Likewise. * generated/product_i8.c: Likewise. * generated/product_r10.c: Likewise. * generated/product_r16.c: Likewise. * generated/product_r4.c: Likewise. * generated/product_r8.c: Likewise. * generated/sum_c10.c: Likewise. * generated/sum_c16.c: Likewise. * generated/sum_c4.c: Likewise. * generated/sum_c8.c: Likewise. * generated/sum_i16.c: Likewise. * generated/sum_i1.c: Likewise. * generated/sum_i2.c: Likewise. * generated/sum_i4.c: Likewise. * generated/sum_i8.c: Likewise. * generated/sum_r10.c: Likewise. * generated/sum_r16.c: Likewise. * generated/sum_r4.c: Likewise. * generated/sum_r8.c: Likewise. * gfortran.dg/maxlocval_2.f90: New test. * gfortran.dg/maxlocval_3.f90: New test. * gfortran.dg/maxlocval_4.f90: New test. * gfortran.dg/minlocval_1.f90: New test. * gfortran.dg/minlocval_2.f90: New test. * gfortran.dg/minlocval_3.f90: New test. * gfortran.dg/minlocval_4.f90: New test. From-SVN: r150041
This commit is contained in:
Jakub Jelinek
Jakub Jelinek
parent
3a802a9e6d
commit
80927a562e
|
|
@ -1,3 +1,13 @@
|
|||
2009-07-24 Jakub Jelinek <jakub@redhat.com>
|
||||
|
||||
PR fortran/40643
|
||||
PR fortran/31067
|
||||
* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc,
|
||||
gfc_conv_intrinsic_minmaxval): Handle Infinities and NaNs properly,
|
||||
optimize.
|
||||
* trans-array.c (gfc_trans_scalarized_loop_end): No longer static.
|
||||
* trans-array.h (gfc_trans_scalarized_loop_end): New prototype.
|
||||
|
||||
2009-07-23 Jakub Jelinek <jakub@redhat.com>
|
||||
|
||||
PR fortran/40839
|
||||
|
|
|
|||
|
|
@ -2755,7 +2755,7 @@ gfc_start_scalarized_body (gfc_loopinfo * loop, stmtblock_t * pbody)
|
|||
|
||||
/* Generates the actual loop code for a scalarization loop. */
|
||||
|
||||
static void
|
||||
void
|
||||
gfc_trans_scalarized_loop_end (gfc_loopinfo * loop, int n,
|
||||
stmtblock_t * pbody)
|
||||
{
|
||||
|
|
@ -2822,7 +2822,8 @@ gfc_trans_scalarized_loop_end (gfc_loopinfo * loop, int n,
|
|||
loopbody = gfc_finish_block (pbody);
|
||||
|
||||
/* Initialize the loopvar. */
|
||||
gfc_add_modify (&loop->code[n], loop->loopvar[n], loop->from[n]);
|
||||
if (loop->loopvar[n] != loop->from[n])
|
||||
gfc_add_modify (&loop->code[n], loop->loopvar[n], loop->from[n]);
|
||||
|
||||
exit_label = gfc_build_label_decl (NULL_TREE);
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/* Header for array handling functions
|
||||
Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
|
||||
Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
|
||||
Free Software Foundation, Inc.
|
||||
Contributed by Paul Brook
|
||||
|
||||
|
|
@ -84,6 +84,8 @@ void gfc_copy_loopinfo_to_se (gfc_se *, gfc_loopinfo *);
|
|||
|
||||
/* Marks the start of a scalarized expression, and declares loop variables. */
|
||||
void gfc_start_scalarized_body (gfc_loopinfo *, stmtblock_t *);
|
||||
/* Generates one actual loop for a scalarized expression. */
|
||||
void gfc_trans_scalarized_loop_end (gfc_loopinfo *, int, stmtblock_t *);
|
||||
/* Generates the actual loops for a scalarized expression. */
|
||||
void gfc_trans_scalarizing_loops (gfc_loopinfo *, stmtblock_t *);
|
||||
/* Mark the end of the main loop body and the start of the copying loop. */
|
||||
|
|
|
|||
|
|
@ -2146,6 +2146,72 @@ gfc_conv_intrinsic_dot_product (gfc_se * se, gfc_expr * expr)
|
|||
}
|
||||
|
||||
|
||||
/* Emit code for minloc or maxloc intrinsic. There are many different cases
|
||||
we need to handle. For performance reasons we sometimes create two
|
||||
loops instead of one, where the second one is much simpler.
|
||||
Examples for minloc intrinsic:
|
||||
1) Result is an array, a call is generated
|
||||
2) Array mask is used and NaNs need to be supported:
|
||||
limit = Infinity;
|
||||
pos = 0;
|
||||
S = from;
|
||||
while (S <= to) {
|
||||
if (mask[S]) {
|
||||
if (pos == 0) pos = S + (1 - from);
|
||||
if (a[S] <= limit) { limit = a[S]; pos = S + (1 - from); goto lab1; }
|
||||
}
|
||||
S++;
|
||||
}
|
||||
goto lab2;
|
||||
lab1:;
|
||||
while (S <= to) {
|
||||
if (mask[S]) if (a[S] < limit) { limit = a[S]; pos = S + (1 - from); }
|
||||
S++;
|
||||
}
|
||||
lab2:;
|
||||
3) NaNs need to be supported, but it is known at compile time or cheaply
|
||||
at runtime whether array is nonempty or not:
|
||||
limit = Infinity;
|
||||
pos = 0;
|
||||
S = from;
|
||||
while (S <= to) {
|
||||
if (a[S] <= limit) { limit = a[S]; pos = S + (1 - from); goto lab1; }
|
||||
S++;
|
||||
}
|
||||
if (from <= to) pos = 1;
|
||||
goto lab2;
|
||||
lab1:;
|
||||
while (S <= to) {
|
||||
if (a[S] < limit) { limit = a[S]; pos = S + (1 - from); }
|
||||
S++;
|
||||
}
|
||||
lab2:;
|
||||
4) NaNs aren't supported, array mask is used:
|
||||
limit = infinities_supported ? Infinity : huge (limit);
|
||||
pos = 0;
|
||||
S = from;
|
||||
while (S <= to) {
|
||||
if (mask[S]) { limit = a[S]; pos = S + (1 - from); goto lab1; }
|
||||
S++;
|
||||
}
|
||||
goto lab2;
|
||||
lab1:;
|
||||
while (S <= to) {
|
||||
if (mask[S]) if (a[S] < limit) { limit = a[S]; pos = S + (1 - from); }
|
||||
S++;
|
||||
}
|
||||
lab2:;
|
||||
5) Same without array mask:
|
||||
limit = infinities_supported ? Infinity : huge (limit);
|
||||
pos = (from <= to) ? 1 : 0;
|
||||
S = from;
|
||||
while (S <= to) {
|
||||
if (a[S] < limit) { limit = a[S]; pos = S + (1 - from); }
|
||||
S++;
|
||||
}
|
||||
For 3) and 5), if mask is scalar, this all goes into a conditional,
|
||||
setting pos = 0; in the else branch. */
|
||||
|
||||
static void
|
||||
gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
||||
{
|
||||
|
|
@ -2156,9 +2222,12 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
tree limit;
|
||||
tree type;
|
||||
tree tmp;
|
||||
tree cond;
|
||||
tree elsetmp;
|
||||
tree ifbody;
|
||||
tree offset;
|
||||
tree nonempty;
|
||||
tree lab1, lab2;
|
||||
gfc_loopinfo loop;
|
||||
gfc_actual_arglist *actual;
|
||||
gfc_ss *arrayss;
|
||||
|
|
@ -2190,21 +2259,39 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
actual = actual->next->next;
|
||||
gcc_assert (actual);
|
||||
maskexpr = actual->expr;
|
||||
nonempty = NULL;
|
||||
if (maskexpr && maskexpr->rank != 0)
|
||||
{
|
||||
maskss = gfc_walk_expr (maskexpr);
|
||||
gcc_assert (maskss != gfc_ss_terminator);
|
||||
}
|
||||
else
|
||||
maskss = NULL;
|
||||
{
|
||||
mpz_t asize;
|
||||
if (gfc_array_size (arrayexpr, &asize) == SUCCESS)
|
||||
{
|
||||
nonempty = gfc_conv_mpz_to_tree (asize, gfc_index_integer_kind);
|
||||
mpz_clear (asize);
|
||||
nonempty = fold_build2 (GT_EXPR, boolean_type_node, nonempty,
|
||||
gfc_index_zero_node);
|
||||
}
|
||||
maskss = NULL;
|
||||
}
|
||||
|
||||
limit = gfc_create_var (gfc_typenode_for_spec (&arrayexpr->ts), "limit");
|
||||
n = gfc_validate_kind (arrayexpr->ts.type, arrayexpr->ts.kind, false);
|
||||
switch (arrayexpr->ts.type)
|
||||
{
|
||||
case BT_REAL:
|
||||
tmp = gfc_conv_mpfr_to_tree (gfc_real_kinds[n].huge,
|
||||
arrayexpr->ts.kind, 0);
|
||||
if (HONOR_INFINITIES (DECL_MODE (limit)))
|
||||
{
|
||||
REAL_VALUE_TYPE real;
|
||||
real_inf (&real);
|
||||
tmp = build_real (TREE_TYPE (limit), real);
|
||||
}
|
||||
else
|
||||
tmp = gfc_conv_mpfr_to_tree (gfc_real_kinds[n].huge,
|
||||
arrayexpr->ts.kind, 0);
|
||||
break;
|
||||
|
||||
case BT_INTEGER:
|
||||
|
|
@ -2239,11 +2326,30 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
gfc_conv_loop_setup (&loop, &expr->where);
|
||||
|
||||
gcc_assert (loop.dimen == 1);
|
||||
if (nonempty == NULL && maskss == NULL && loop.from[0] && loop.to[0])
|
||||
nonempty = fold_build2 (LE_EXPR, boolean_type_node, loop.from[0],
|
||||
loop.to[0]);
|
||||
|
||||
lab1 = NULL;
|
||||
lab2 = NULL;
|
||||
/* Initialize the position to zero, following Fortran 2003. We are free
|
||||
to do this because Fortran 95 allows the result of an entirely false
|
||||
mask to be processor dependent. */
|
||||
gfc_add_modify (&loop.pre, pos, gfc_index_zero_node);
|
||||
mask to be processor dependent. If we know at compile time the array
|
||||
is non-empty and no MASK is used, we can initialize to 1 to simplify
|
||||
the inner loop. */
|
||||
if (nonempty != NULL && !HONOR_NANS (DECL_MODE (limit)))
|
||||
gfc_add_modify (&loop.pre, pos,
|
||||
fold_build3 (COND_EXPR, gfc_array_index_type,
|
||||
nonempty, gfc_index_one_node,
|
||||
gfc_index_zero_node));
|
||||
else
|
||||
{
|
||||
gfc_add_modify (&loop.pre, pos, gfc_index_zero_node);
|
||||
lab1 = gfc_build_label_decl (NULL_TREE);
|
||||
TREE_USED (lab1) = 1;
|
||||
lab2 = gfc_build_label_decl (NULL_TREE);
|
||||
TREE_USED (lab2) = 1;
|
||||
}
|
||||
|
||||
gfc_mark_ss_chain_used (arrayss, 1);
|
||||
if (maskss)
|
||||
|
|
@ -2285,27 +2391,47 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
gfc_index_one_node, loop.from[0]);
|
||||
else
|
||||
tmp = gfc_index_one_node;
|
||||
|
||||
|
||||
gfc_add_modify (&block, offset, tmp);
|
||||
|
||||
if (nonempty == NULL && HONOR_NANS (DECL_MODE (limit)))
|
||||
{
|
||||
stmtblock_t ifblock2;
|
||||
tree ifbody2;
|
||||
|
||||
gfc_start_block (&ifblock2);
|
||||
tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (pos),
|
||||
loop.loopvar[0], offset);
|
||||
gfc_add_modify (&ifblock2, pos, tmp);
|
||||
ifbody2 = gfc_finish_block (&ifblock2);
|
||||
cond = fold_build2 (EQ_EXPR, boolean_type_node, pos,
|
||||
gfc_index_zero_node);
|
||||
tmp = build3_v (COND_EXPR, cond, ifbody2,
|
||||
build_empty_stmt (input_location));
|
||||
gfc_add_expr_to_block (&block, tmp);
|
||||
}
|
||||
|
||||
tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (pos),
|
||||
loop.loopvar[0], offset);
|
||||
gfc_add_modify (&ifblock, pos, tmp);
|
||||
|
||||
if (lab1)
|
||||
gfc_add_expr_to_block (&ifblock, build1_v (GOTO_EXPR, lab1));
|
||||
|
||||
ifbody = gfc_finish_block (&ifblock);
|
||||
|
||||
/* If it is a more extreme value or pos is still zero and the value
|
||||
equal to the limit. */
|
||||
tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
|
||||
fold_build2 (EQ_EXPR, boolean_type_node,
|
||||
pos, gfc_index_zero_node),
|
||||
fold_build2 (EQ_EXPR, boolean_type_node,
|
||||
arrayse.expr, limit));
|
||||
tmp = fold_build2 (TRUTH_OR_EXPR, boolean_type_node,
|
||||
fold_build2 (op, boolean_type_node,
|
||||
arrayse.expr, limit), tmp);
|
||||
tmp = build3_v (COND_EXPR, tmp, ifbody, build_empty_stmt (input_location));
|
||||
gfc_add_expr_to_block (&block, tmp);
|
||||
if (!lab1 || HONOR_NANS (DECL_MODE (limit)))
|
||||
{
|
||||
if (lab1)
|
||||
cond = fold_build2 (op == GT_EXPR ? GE_EXPR : LE_EXPR,
|
||||
boolean_type_node, arrayse.expr, limit);
|
||||
else
|
||||
cond = fold_build2 (op, boolean_type_node, arrayse.expr, limit);
|
||||
|
||||
ifbody = build3_v (COND_EXPR, cond, ifbody,
|
||||
build_empty_stmt (input_location));
|
||||
}
|
||||
gfc_add_expr_to_block (&block, ifbody);
|
||||
|
||||
if (maskss)
|
||||
{
|
||||
|
|
@ -2319,8 +2445,95 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
tmp = gfc_finish_block (&block);
|
||||
gfc_add_expr_to_block (&body, tmp);
|
||||
|
||||
if (lab1)
|
||||
{
|
||||
gfc_trans_scalarized_loop_end (&loop, 0, &body);
|
||||
|
||||
if (HONOR_NANS (DECL_MODE (limit)))
|
||||
{
|
||||
if (nonempty != NULL)
|
||||
{
|
||||
ifbody = build2_v (MODIFY_EXPR, pos, gfc_index_one_node);
|
||||
tmp = build3_v (COND_EXPR, nonempty, ifbody,
|
||||
build_empty_stmt (input_location));
|
||||
gfc_add_expr_to_block (&loop.code[0], tmp);
|
||||
}
|
||||
}
|
||||
|
||||
gfc_add_expr_to_block (&loop.code[0], build1_v (GOTO_EXPR, lab2));
|
||||
gfc_add_expr_to_block (&loop.code[0], build1_v (LABEL_EXPR, lab1));
|
||||
gfc_start_block (&body);
|
||||
|
||||
/* If we have a mask, only check this element if the mask is set. */
|
||||
if (maskss)
|
||||
{
|
||||
gfc_init_se (&maskse, NULL);
|
||||
gfc_copy_loopinfo_to_se (&maskse, &loop);
|
||||
maskse.ss = maskss;
|
||||
gfc_conv_expr_val (&maskse, maskexpr);
|
||||
gfc_add_block_to_block (&body, &maskse.pre);
|
||||
|
||||
gfc_start_block (&block);
|
||||
}
|
||||
else
|
||||
gfc_init_block (&block);
|
||||
|
||||
/* Compare with the current limit. */
|
||||
gfc_init_se (&arrayse, NULL);
|
||||
gfc_copy_loopinfo_to_se (&arrayse, &loop);
|
||||
arrayse.ss = arrayss;
|
||||
gfc_conv_expr_val (&arrayse, arrayexpr);
|
||||
gfc_add_block_to_block (&block, &arrayse.pre);
|
||||
|
||||
/* We do the following if this is a more extreme value. */
|
||||
gfc_start_block (&ifblock);
|
||||
|
||||
/* Assign the value to the limit... */
|
||||
gfc_add_modify (&ifblock, limit, arrayse.expr);
|
||||
|
||||
/* Remember where we are. An offset must be added to the loop
|
||||
counter to obtain the required position. */
|
||||
if (loop.from[0])
|
||||
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
|
||||
gfc_index_one_node, loop.from[0]);
|
||||
else
|
||||
tmp = gfc_index_one_node;
|
||||
|
||||
gfc_add_modify (&block, offset, tmp);
|
||||
|
||||
tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (pos),
|
||||
loop.loopvar[0], offset);
|
||||
gfc_add_modify (&ifblock, pos, tmp);
|
||||
|
||||
ifbody = gfc_finish_block (&ifblock);
|
||||
|
||||
cond = fold_build2 (op, boolean_type_node, arrayse.expr, limit);
|
||||
|
||||
tmp = build3_v (COND_EXPR, cond, ifbody,
|
||||
build_empty_stmt (input_location));
|
||||
gfc_add_expr_to_block (&block, tmp);
|
||||
|
||||
if (maskss)
|
||||
{
|
||||
/* We enclose the above in if (mask) {...}. */
|
||||
tmp = gfc_finish_block (&block);
|
||||
|
||||
tmp = build3_v (COND_EXPR, maskse.expr, tmp,
|
||||
build_empty_stmt (input_location));
|
||||
}
|
||||
else
|
||||
tmp = gfc_finish_block (&block);
|
||||
gfc_add_expr_to_block (&body, tmp);
|
||||
/* Avoid initializing loopvar[0] again, it should be left where
|
||||
it finished by the first loop. */
|
||||
loop.from[0] = loop.loopvar[0];
|
||||
}
|
||||
|
||||
gfc_trans_scalarizing_loops (&loop, &body);
|
||||
|
||||
if (lab2)
|
||||
gfc_add_expr_to_block (&loop.pre, build1_v (LABEL_EXPR, lab2));
|
||||
|
||||
/* For a scalar mask, enclose the loop in an if statement. */
|
||||
if (maskexpr && maskss == NULL)
|
||||
{
|
||||
|
|
@ -2352,6 +2565,99 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
se->expr = convert (type, pos);
|
||||
}
|
||||
|
||||
/* Emit code for minval or maxval intrinsic. There are many different cases
|
||||
we need to handle. For performance reasons we sometimes create two
|
||||
loops instead of one, where the second one is much simpler.
|
||||
Examples for minval intrinsic:
|
||||
1) Result is an array, a call is generated
|
||||
2) Array mask is used and NaNs need to be supported, rank 1:
|
||||
limit = Infinity;
|
||||
nonempty = false;
|
||||
S = from;
|
||||
while (S <= to) {
|
||||
if (mask[S]) { nonempty = true; if (a[S] <= limit) goto lab; }
|
||||
S++;
|
||||
}
|
||||
limit = nonempty ? NaN : huge (limit);
|
||||
lab:
|
||||
while (S <= to) { if(mask[S]) limit = min (a[S], limit); S++; }
|
||||
3) NaNs need to be supported, but it is known at compile time or cheaply
|
||||
at runtime whether array is nonempty or not, rank 1:
|
||||
limit = Infinity;
|
||||
S = from;
|
||||
while (S <= to) { if (a[S] <= limit) goto lab; S++; }
|
||||
limit = (from <= to) ? NaN : huge (limit);
|
||||
lab:
|
||||
while (S <= to) { limit = min (a[S], limit); S++; }
|
||||
4) Array mask is used and NaNs need to be supported, rank > 1:
|
||||
limit = Infinity;
|
||||
nonempty = false;
|
||||
fast = false;
|
||||
S1 = from1;
|
||||
while (S1 <= to1) {
|
||||
S2 = from2;
|
||||
while (S2 <= to2) {
|
||||
if (mask[S1][S2]) {
|
||||
if (fast) limit = min (a[S1][S2], limit);
|
||||
else {
|
||||
nonempty = true;
|
||||
if (a[S1][S2] <= limit) {
|
||||
limit = a[S1][S2];
|
||||
fast = true;
|
||||
}
|
||||
}
|
||||
}
|
||||
S2++;
|
||||
}
|
||||
S1++;
|
||||
}
|
||||
if (!fast)
|
||||
limit = nonempty ? NaN : huge (limit);
|
||||
5) NaNs need to be supported, but it is known at compile time or cheaply
|
||||
at runtime whether array is nonempty or not, rank > 1:
|
||||
limit = Infinity;
|
||||
fast = false;
|
||||
S1 = from1;
|
||||
while (S1 <= to1) {
|
||||
S2 = from2;
|
||||
while (S2 <= to2) {
|
||||
if (fast) limit = min (a[S1][S2], limit);
|
||||
else {
|
||||
if (a[S1][S2] <= limit) {
|
||||
limit = a[S1][S2];
|
||||
fast = true;
|
||||
}
|
||||
}
|
||||
S2++;
|
||||
}
|
||||
S1++;
|
||||
}
|
||||
if (!fast)
|
||||
limit = (nonempty_array) ? NaN : huge (limit);
|
||||
6) NaNs aren't supported, but infinities are. Array mask is used:
|
||||
limit = Infinity;
|
||||
nonempty = false;
|
||||
S = from;
|
||||
while (S <= to) {
|
||||
if (mask[S]) { nonempty = true; limit = min (a[S], limit); }
|
||||
S++;
|
||||
}
|
||||
limit = nonempty ? limit : huge (limit);
|
||||
7) Same without array mask:
|
||||
limit = Infinity;
|
||||
S = from;
|
||||
while (S <= to) { limit = min (a[S], limit); S++; }
|
||||
limit = (from <= to) ? limit : huge (limit);
|
||||
8) Neither NaNs nor infinities are supported (-ffast-math or BT_INTEGER):
|
||||
limit = huge (limit);
|
||||
S = from;
|
||||
while (S <= to) { limit = min (a[S], limit); S++); }
|
||||
(or
|
||||
while (S <= to) { if (mask[S]) limit = min (a[S], limit); S++; }
|
||||
with array mask instead).
|
||||
For 3), 5), 7) and 8), if mask is scalar, this all goes into a conditional,
|
||||
setting limit = huge (limit); in the else branch. */
|
||||
|
||||
static void
|
||||
gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
||||
{
|
||||
|
|
@ -2359,8 +2665,13 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
tree type;
|
||||
tree tmp;
|
||||
tree ifbody;
|
||||
tree nonempty;
|
||||
tree nonempty_var;
|
||||
tree lab;
|
||||
tree fast;
|
||||
tree huge_cst = NULL, nan_cst = NULL;
|
||||
stmtblock_t body;
|
||||
stmtblock_t block;
|
||||
stmtblock_t block, block2;
|
||||
gfc_loopinfo loop;
|
||||
gfc_actual_arglist *actual;
|
||||
gfc_ss *arrayss;
|
||||
|
|
@ -2384,7 +2695,22 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
switch (expr->ts.type)
|
||||
{
|
||||
case BT_REAL:
|
||||
tmp = gfc_conv_mpfr_to_tree (gfc_real_kinds[n].huge, expr->ts.kind, 0);
|
||||
huge_cst = gfc_conv_mpfr_to_tree (gfc_real_kinds[n].huge,
|
||||
expr->ts.kind, 0);
|
||||
if (HONOR_INFINITIES (DECL_MODE (limit)))
|
||||
{
|
||||
REAL_VALUE_TYPE real;
|
||||
real_inf (&real);
|
||||
tmp = build_real (type, real);
|
||||
}
|
||||
else
|
||||
tmp = huge_cst;
|
||||
if (HONOR_NANS (DECL_MODE (limit)))
|
||||
{
|
||||
REAL_VALUE_TYPE real;
|
||||
real_nan (&real, "", 1, DECL_MODE (limit));
|
||||
nan_cst = build_real (type, real);
|
||||
}
|
||||
break;
|
||||
|
||||
case BT_INTEGER:
|
||||
|
|
@ -2400,7 +2726,11 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
-HUGE for BT_REAL and (-HUGE - 1) for BT_INTEGER; the most positive
|
||||
possible value is HUGE in both cases. */
|
||||
if (op == GT_EXPR)
|
||||
tmp = fold_build1 (NEGATE_EXPR, TREE_TYPE (tmp), tmp);
|
||||
{
|
||||
tmp = fold_build1 (NEGATE_EXPR, TREE_TYPE (tmp), tmp);
|
||||
if (huge_cst)
|
||||
huge_cst = fold_build1 (NEGATE_EXPR, TREE_TYPE (huge_cst), huge_cst);
|
||||
}
|
||||
|
||||
if (op == GT_EXPR && expr->ts.type == BT_INTEGER)
|
||||
tmp = fold_build2 (MINUS_EXPR, TREE_TYPE (tmp),
|
||||
|
|
@ -2417,13 +2747,24 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
actual = actual->next->next;
|
||||
gcc_assert (actual);
|
||||
maskexpr = actual->expr;
|
||||
nonempty = NULL;
|
||||
if (maskexpr && maskexpr->rank != 0)
|
||||
{
|
||||
maskss = gfc_walk_expr (maskexpr);
|
||||
gcc_assert (maskss != gfc_ss_terminator);
|
||||
}
|
||||
else
|
||||
maskss = NULL;
|
||||
{
|
||||
mpz_t asize;
|
||||
if (gfc_array_size (arrayexpr, &asize) == SUCCESS)
|
||||
{
|
||||
nonempty = gfc_conv_mpz_to_tree (asize, gfc_index_integer_kind);
|
||||
mpz_clear (asize);
|
||||
nonempty = fold_build2 (GT_EXPR, boolean_type_node, nonempty,
|
||||
gfc_index_zero_node);
|
||||
}
|
||||
maskss = NULL;
|
||||
}
|
||||
|
||||
/* Initialize the scalarizer. */
|
||||
gfc_init_loopinfo (&loop);
|
||||
|
|
@ -2435,6 +2776,35 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
gfc_conv_ss_startstride (&loop);
|
||||
gfc_conv_loop_setup (&loop, &expr->where);
|
||||
|
||||
if (nonempty == NULL && maskss == NULL
|
||||
&& loop.dimen == 1 && loop.from[0] && loop.to[0])
|
||||
nonempty = fold_build2 (LE_EXPR, boolean_type_node, loop.from[0],
|
||||
loop.to[0]);
|
||||
nonempty_var = NULL;
|
||||
if (nonempty == NULL
|
||||
&& (HONOR_INFINITIES (DECL_MODE (limit))
|
||||
|| HONOR_NANS (DECL_MODE (limit))))
|
||||
{
|
||||
nonempty_var = gfc_create_var (boolean_type_node, "nonempty");
|
||||
gfc_add_modify (&se->pre, nonempty_var, boolean_false_node);
|
||||
nonempty = nonempty_var;
|
||||
}
|
||||
lab = NULL;
|
||||
fast = NULL;
|
||||
if (HONOR_NANS (DECL_MODE (limit)))
|
||||
{
|
||||
if (loop.dimen == 1)
|
||||
{
|
||||
lab = gfc_build_label_decl (NULL_TREE);
|
||||
TREE_USED (lab) = 1;
|
||||
}
|
||||
else
|
||||
{
|
||||
fast = gfc_create_var (boolean_type_node, "fast");
|
||||
gfc_add_modify (&se->pre, fast, boolean_false_node);
|
||||
}
|
||||
}
|
||||
|
||||
gfc_mark_ss_chain_used (arrayss, 1);
|
||||
if (maskss)
|
||||
gfc_mark_ss_chain_used (maskss, 1);
|
||||
|
|
@ -2462,13 +2832,76 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
gfc_conv_expr_val (&arrayse, arrayexpr);
|
||||
gfc_add_block_to_block (&block, &arrayse.pre);
|
||||
|
||||
/* Assign the value to the limit... */
|
||||
ifbody = build2_v (MODIFY_EXPR, limit, arrayse.expr);
|
||||
gfc_init_block (&block2);
|
||||
|
||||
if (nonempty_var)
|
||||
gfc_add_modify (&block2, nonempty_var, boolean_true_node);
|
||||
|
||||
if (HONOR_NANS (DECL_MODE (limit)))
|
||||
{
|
||||
tmp = fold_build2 (op == GT_EXPR ? GE_EXPR : LE_EXPR,
|
||||
boolean_type_node, arrayse.expr, limit);
|
||||
if (lab)
|
||||
ifbody = build1_v (GOTO_EXPR, lab);
|
||||
else
|
||||
{
|
||||
stmtblock_t ifblock;
|
||||
|
||||
gfc_init_block (&ifblock);
|
||||
gfc_add_modify (&ifblock, limit, arrayse.expr);
|
||||
gfc_add_modify (&ifblock, fast, boolean_true_node);
|
||||
ifbody = gfc_finish_block (&ifblock);
|
||||
}
|
||||
tmp = build3_v (COND_EXPR, tmp, ifbody,
|
||||
build_empty_stmt (input_location));
|
||||
gfc_add_expr_to_block (&block2, tmp);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* MIN_EXPR/MAX_EXPR has unspecified behavior with NaNs or
|
||||
signed zeros. */
|
||||
if (HONOR_SIGNED_ZEROS (DECL_MODE (limit)))
|
||||
{
|
||||
tmp = fold_build2 (op, boolean_type_node, arrayse.expr, limit);
|
||||
ifbody = build2_v (MODIFY_EXPR, limit, arrayse.expr);
|
||||
tmp = build3_v (COND_EXPR, tmp, ifbody,
|
||||
build_empty_stmt (input_location));
|
||||
gfc_add_expr_to_block (&block2, tmp);
|
||||
}
|
||||
else
|
||||
{
|
||||
tmp = fold_build2 (op == GT_EXPR ? MAX_EXPR : MIN_EXPR,
|
||||
type, arrayse.expr, limit);
|
||||
gfc_add_modify (&block2, limit, tmp);
|
||||
}
|
||||
}
|
||||
|
||||
if (fast)
|
||||
{
|
||||
tree elsebody = gfc_finish_block (&block2);
|
||||
|
||||
/* MIN_EXPR/MAX_EXPR has unspecified behavior with NaNs or
|
||||
signed zeros. */
|
||||
if (HONOR_NANS (DECL_MODE (limit))
|
||||
|| HONOR_SIGNED_ZEROS (DECL_MODE (limit)))
|
||||
{
|
||||
tmp = fold_build2 (op, boolean_type_node, arrayse.expr, limit);
|
||||
ifbody = build2_v (MODIFY_EXPR, limit, arrayse.expr);
|
||||
ifbody = build3_v (COND_EXPR, tmp, ifbody,
|
||||
build_empty_stmt (input_location));
|
||||
}
|
||||
else
|
||||
{
|
||||
tmp = fold_build2 (op == GT_EXPR ? MAX_EXPR : MIN_EXPR,
|
||||
type, arrayse.expr, limit);
|
||||
ifbody = build2_v (MODIFY_EXPR, limit, tmp);
|
||||
}
|
||||
tmp = build3_v (COND_EXPR, fast, ifbody, elsebody);
|
||||
gfc_add_expr_to_block (&block, tmp);
|
||||
}
|
||||
else
|
||||
gfc_add_block_to_block (&block, &block2);
|
||||
|
||||
/* If it is a more extreme value. */
|
||||
tmp = fold_build2 (op, boolean_type_node, arrayse.expr, limit);
|
||||
tmp = build3_v (COND_EXPR, tmp, ifbody, build_empty_stmt (input_location));
|
||||
gfc_add_expr_to_block (&block, tmp);
|
||||
gfc_add_block_to_block (&block, &arrayse.post);
|
||||
|
||||
tmp = gfc_finish_block (&block);
|
||||
|
|
@ -2478,11 +2911,88 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
build_empty_stmt (input_location));
|
||||
gfc_add_expr_to_block (&body, tmp);
|
||||
|
||||
if (lab)
|
||||
{
|
||||
gfc_trans_scalarized_loop_end (&loop, 0, &body);
|
||||
|
||||
tmp = fold_build3 (COND_EXPR, type, nonempty, nan_cst, huge_cst);
|
||||
gfc_add_modify (&loop.code[0], limit, tmp);
|
||||
gfc_add_expr_to_block (&loop.code[0], build1_v (LABEL_EXPR, lab));
|
||||
|
||||
gfc_start_block (&body);
|
||||
|
||||
/* If we have a mask, only add this element if the mask is set. */
|
||||
if (maskss)
|
||||
{
|
||||
gfc_init_se (&maskse, NULL);
|
||||
gfc_copy_loopinfo_to_se (&maskse, &loop);
|
||||
maskse.ss = maskss;
|
||||
gfc_conv_expr_val (&maskse, maskexpr);
|
||||
gfc_add_block_to_block (&body, &maskse.pre);
|
||||
|
||||
gfc_start_block (&block);
|
||||
}
|
||||
else
|
||||
gfc_init_block (&block);
|
||||
|
||||
/* Compare with the current limit. */
|
||||
gfc_init_se (&arrayse, NULL);
|
||||
gfc_copy_loopinfo_to_se (&arrayse, &loop);
|
||||
arrayse.ss = arrayss;
|
||||
gfc_conv_expr_val (&arrayse, arrayexpr);
|
||||
gfc_add_block_to_block (&block, &arrayse.pre);
|
||||
|
||||
/* MIN_EXPR/MAX_EXPR has unspecified behavior with NaNs or
|
||||
signed zeros. */
|
||||
if (HONOR_NANS (DECL_MODE (limit))
|
||||
|| HONOR_SIGNED_ZEROS (DECL_MODE (limit)))
|
||||
{
|
||||
tmp = fold_build2 (op, boolean_type_node, arrayse.expr, limit);
|
||||
ifbody = build2_v (MODIFY_EXPR, limit, arrayse.expr);
|
||||
tmp = build3_v (COND_EXPR, tmp, ifbody,
|
||||
build_empty_stmt (input_location));
|
||||
gfc_add_expr_to_block (&block, tmp);
|
||||
}
|
||||
else
|
||||
{
|
||||
tmp = fold_build2 (op == GT_EXPR ? MAX_EXPR : MIN_EXPR,
|
||||
type, arrayse.expr, limit);
|
||||
gfc_add_modify (&block, limit, tmp);
|
||||
}
|
||||
|
||||
gfc_add_block_to_block (&block, &arrayse.post);
|
||||
|
||||
tmp = gfc_finish_block (&block);
|
||||
if (maskss)
|
||||
/* We enclose the above in if (mask) {...}. */
|
||||
tmp = build3_v (COND_EXPR, maskse.expr, tmp,
|
||||
build_empty_stmt (input_location));
|
||||
gfc_add_expr_to_block (&body, tmp);
|
||||
/* Avoid initializing loopvar[0] again, it should be left where
|
||||
it finished by the first loop. */
|
||||
loop.from[0] = loop.loopvar[0];
|
||||
}
|
||||
gfc_trans_scalarizing_loops (&loop, &body);
|
||||
|
||||
if (fast)
|
||||
{
|
||||
tmp = fold_build3 (COND_EXPR, type, nonempty, nan_cst, huge_cst);
|
||||
ifbody = build2_v (MODIFY_EXPR, limit, tmp);
|
||||
tmp = build3_v (COND_EXPR, fast, build_empty_stmt (input_location),
|
||||
ifbody);
|
||||
gfc_add_expr_to_block (&loop.pre, tmp);
|
||||
}
|
||||
else if (HONOR_INFINITIES (DECL_MODE (limit)) && !lab)
|
||||
{
|
||||
tmp = fold_build3 (COND_EXPR, type, nonempty, limit, huge_cst);
|
||||
gfc_add_modify (&loop.pre, limit, tmp);
|
||||
}
|
||||
|
||||
/* For a scalar mask, enclose the loop in an if statement. */
|
||||
if (maskexpr && maskss == NULL)
|
||||
{
|
||||
tree else_stmt;
|
||||
|
||||
gfc_init_se (&maskse, NULL);
|
||||
gfc_conv_expr_val (&maskse, maskexpr);
|
||||
gfc_init_block (&block);
|
||||
|
|
@ -2490,8 +3000,11 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
|
|||
gfc_add_block_to_block (&block, &loop.post);
|
||||
tmp = gfc_finish_block (&block);
|
||||
|
||||
tmp = build3_v (COND_EXPR, maskse.expr, tmp,
|
||||
build_empty_stmt (input_location));
|
||||
if (HONOR_INFINITIES (DECL_MODE (limit)))
|
||||
else_stmt = build2_v (MODIFY_EXPR, limit, huge_cst);
|
||||
else
|
||||
else_stmt = build_empty_stmt (input_location);
|
||||
tmp = build3_v (COND_EXPR, maskse.expr, tmp, else_stmt);
|
||||
gfc_add_expr_to_block (&block, tmp);
|
||||
gfc_add_block_to_block (&se->pre, &block);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,3 +1,15 @@
|
|||
2009-07-24 Jakub Jelinek <jakub@redhat.com>
|
||||
|
||||
PR fortran/40643
|
||||
PR fortran/31067
|
||||
* gfortran.dg/maxlocval_2.f90: New test.
|
||||
* gfortran.dg/maxlocval_3.f90: New test.
|
||||
* gfortran.dg/maxlocval_4.f90: New test.
|
||||
* gfortran.dg/minlocval_1.f90: New test.
|
||||
* gfortran.dg/minlocval_2.f90: New test.
|
||||
* gfortran.dg/minlocval_3.f90: New test.
|
||||
* gfortran.dg/minlocval_4.f90: New test.
|
||||
|
||||
2009-07-23 Joseph Myers <joseph@codesourcery.com>
|
||||
|
||||
* gcc.dg/dll-4.c: Allow foo1 and foo2 in either order in
|
||||
|
|
|
|||
|
|
@ -0,0 +1,153 @@
|
|||
! { dg-do run }
|
||||
real :: a(3), nan, minf, pinf
|
||||
real, allocatable :: c(:)
|
||||
logical :: l
|
||||
logical :: l2(3)
|
||||
|
||||
nan = 0.0
|
||||
minf = 0.0
|
||||
pinf = 0.0
|
||||
nan = 0.0/nan
|
||||
minf = -1.0/minf
|
||||
pinf = 1.0/pinf
|
||||
|
||||
allocate (c(3))
|
||||
a(:) = nan
|
||||
if (maxloc (a, dim = 1).ne.1) call abort
|
||||
if (.not.isnan(maxval (a, dim = 1))) call abort
|
||||
a(:) = minf
|
||||
if (maxloc (a, dim = 1).ne.1) call abort
|
||||
if (maxval (a, dim = 1).ne.minf) call abort
|
||||
a(1:2) = nan
|
||||
if (maxloc (a, dim = 1).ne.3) call abort
|
||||
if (maxval (a, dim = 1).ne.minf) call abort
|
||||
a(2) = 1.0
|
||||
if (maxloc (a, dim = 1).ne.2) call abort
|
||||
if (maxval (a, dim = 1).ne.1) call abort
|
||||
a(2) = pinf
|
||||
if (maxloc (a, dim = 1).ne.2) call abort
|
||||
if (maxval (a, dim = 1).ne.pinf) call abort
|
||||
c(:) = nan
|
||||
if (maxloc (c, dim = 1).ne.1) call abort
|
||||
if (.not.isnan(maxval (c, dim = 1))) call abort
|
||||
c(:) = minf
|
||||
if (maxloc (c, dim = 1).ne.1) call abort
|
||||
if (maxval (c, dim = 1).ne.minf) call abort
|
||||
c(1:2) = nan
|
||||
if (maxloc (c, dim = 1).ne.3) call abort
|
||||
if (maxval (c, dim = 1).ne.minf) call abort
|
||||
c(2) = 1.0
|
||||
if (maxloc (c, dim = 1).ne.2) call abort
|
||||
if (maxval (c, dim = 1).ne.1) call abort
|
||||
c(2) = pinf
|
||||
if (maxloc (c, dim = 1).ne.2) call abort
|
||||
if (maxval (c, dim = 1).ne.pinf) call abort
|
||||
l = .false.
|
||||
l2(:) = .false.
|
||||
a(:) = nan
|
||||
if (maxloc (a, dim = 1, mask = l).ne.0) call abort
|
||||
if (maxval (a, dim = 1, mask = l).ne.-huge(minf)) call abort
|
||||
if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
|
||||
if (maxval (a, dim = 1, mask = l2).ne.-huge(minf)) call abort
|
||||
a(:) = minf
|
||||
if (maxloc (a, dim = 1, mask = l).ne.0) call abort
|
||||
if (maxval (a, dim = 1, mask = l).ne.-huge(minf)) call abort
|
||||
if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
|
||||
if (maxval (a, dim = 1, mask = l2).ne.-huge(minf)) call abort
|
||||
a(1:2) = nan
|
||||
if (maxloc (a, dim = 1, mask = l).ne.0) call abort
|
||||
if (maxval (a, dim = 1, mask = l).ne.-huge(minf)) call abort
|
||||
if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
|
||||
if (maxval (a, dim = 1, mask = l2).ne.-huge(minf)) call abort
|
||||
a(2) = 1.0
|
||||
if (maxloc (a, dim = 1, mask = l).ne.0) call abort
|
||||
if (maxval (a, dim = 1, mask = l).ne.-huge(minf)) call abort
|
||||
if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
|
||||
if (maxval (a, dim = 1, mask = l2).ne.-huge(minf)) call abort
|
||||
a(2) = pinf
|
||||
if (maxloc (a, dim = 1, mask = l).ne.0) call abort
|
||||
if (maxval (a, dim = 1, mask = l).ne.-huge(minf)) call abort
|
||||
if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
|
||||
if (maxval (a, dim = 1, mask = l2).ne.-huge(minf)) call abort
|
||||
c(:) = nan
|
||||
if (maxloc (c, dim = 1, mask = l).ne.0) call abort
|
||||
if (maxval (c, dim = 1, mask = l).ne.-huge(minf)) call abort
|
||||
if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
|
||||
if (maxval (c, dim = 1, mask = l2).ne.-huge(minf)) call abort
|
||||
c(:) = minf
|
||||
if (maxloc (c, dim = 1, mask = l).ne.0) call abort
|
||||
if (maxval (c, dim = 1, mask = l).ne.-huge(minf)) call abort
|
||||
if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
|
||||
if (maxval (c, dim = 1, mask = l2).ne.-huge(minf)) call abort
|
||||
c(1:2) = nan
|
||||
if (maxloc (c, dim = 1, mask = l).ne.0) call abort
|
||||
if (maxval (c, dim = 1, mask = l).ne.-huge(minf)) call abort
|
||||
if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
|
||||
if (maxval (c, dim = 1, mask = l2).ne.-huge(minf)) call abort
|
||||
c(2) = 1.0
|
||||
if (maxloc (c, dim = 1, mask = l).ne.0) call abort
|
||||
if (maxval (c, dim = 1, mask = l).ne.-huge(minf)) call abort
|
||||
if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
|
||||
if (maxval (c, dim = 1, mask = l2).ne.-huge(minf)) call abort
|
||||
c(2) = pinf
|
||||
if (maxloc (c, dim = 1, mask = l).ne.0) call abort
|
||||
if (maxval (c, dim = 1, mask = l).ne.-huge(minf)) call abort
|
||||
if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
|
||||
if (maxval (c, dim = 1, mask = l2).ne.-huge(minf)) call abort
|
||||
l = .true.
|
||||
l2(:) = .true.
|
||||
a(:) = nan
|
||||
if (maxloc (a, dim = 1, mask = l).ne.1) call abort
|
||||
if (.not.isnan(maxval (a, dim = 1, mask = l))) call abort
|
||||
if (maxloc (a, dim = 1, mask = l2).ne.1) call abort
|
||||
if (.not.isnan(maxval (a, dim = 1, mask = l2))) call abort
|
||||
a(:) = minf
|
||||
if (maxloc (a, dim = 1, mask = l).ne.1) call abort
|
||||
if (maxval (a, dim = 1, mask = l).ne.minf) call abort
|
||||
if (maxloc (a, dim = 1, mask = l2).ne.1) call abort
|
||||
if (maxval (a, dim = 1, mask = l2).ne.minf) call abort
|
||||
a(1:2) = nan
|
||||
if (maxloc (a, dim = 1, mask = l).ne.3) call abort
|
||||
if (maxval (a, dim = 1, mask = l).ne.minf) call abort
|
||||
if (maxloc (a, dim = 1, mask = l2).ne.3) call abort
|
||||
if (maxval (a, dim = 1, mask = l2).ne.minf) call abort
|
||||
a(2) = 1.0
|
||||
if (maxloc (a, dim = 1, mask = l).ne.2) call abort
|
||||
if (maxval (a, dim = 1, mask = l).ne.1) call abort
|
||||
if (maxloc (a, dim = 1, mask = l2).ne.2) call abort
|
||||
if (maxval (a, dim = 1, mask = l2).ne.1) call abort
|
||||
a(2) = pinf
|
||||
if (maxloc (a, dim = 1, mask = l).ne.2) call abort
|
||||
if (maxval (a, dim = 1, mask = l).ne.pinf) call abort
|
||||
if (maxloc (a, dim = 1, mask = l2).ne.2) call abort
|
||||
if (maxval (a, dim = 1, mask = l2).ne.pinf) call abort
|
||||
c(:) = nan
|
||||
if (maxloc (c, dim = 1, mask = l).ne.1) call abort
|
||||
if (.not.isnan(maxval (c, dim = 1, mask = l))) call abort
|
||||
if (maxloc (c, dim = 1, mask = l2).ne.1) call abort
|
||||
if (.not.isnan(maxval (c, dim = 1, mask = l2))) call abort
|
||||
c(:) = minf
|
||||
if (maxloc (c, dim = 1, mask = l).ne.1) call abort
|
||||
if (maxval (c, dim = 1, mask = l).ne.minf) call abort
|
||||
if (maxloc (c, dim = 1, mask = l2).ne.1) call abort
|
||||
if (maxval (c, dim = 1, mask = l2).ne.minf) call abort
|
||||
c(1:2) = nan
|
||||
if (maxloc (c, dim = 1, mask = l).ne.3) call abort
|
||||
if (maxval (c, dim = 1, mask = l).ne.minf) call abort
|
||||
if (maxloc (c, dim = 1, mask = l2).ne.3) call abort
|
||||
if (maxval (c, dim = 1, mask = l2).ne.minf) call abort
|
||||
c(2) = 1.0
|
||||
if (maxloc (c, dim = 1, mask = l).ne.2) call abort
|
||||
if (maxval (c, dim = 1, mask = l).ne.1) call abort
|
||||
if (maxloc (c, dim = 1, mask = l2).ne.2) call abort
|
||||
if (maxval (c, dim = 1, mask = l2).ne.1) call abort
|
||||
c(2) = pinf
|
||||
if (maxloc (c, dim = 1, mask = l).ne.2) call abort
|
||||
if (maxval (c, dim = 1, mask = l).ne.pinf) call abort
|
||||
if (maxloc (c, dim = 1, mask = l2).ne.2) call abort
|
||||
if (maxval (c, dim = 1, mask = l2).ne.pinf) call abort
|
||||
deallocate (c)
|
||||
allocate (c(-2:-3))
|
||||
if (maxloc (c, dim = 1).ne.0) call abort
|
||||
if (maxval (c, dim = 1).ne.-huge(minf)) call abort
|
||||
end
|
||||
|
|
@ -0,0 +1,122 @@
|
|||
! { dg-do run }
|
||||
integer :: a(3), h
|
||||
integer, allocatable :: c(:)
|
||||
logical :: l
|
||||
logical :: l2(3)
|
||||
|
||||
h = -huge(h)
|
||||
h = h - 1
|
||||
allocate (c(3))
|
||||
a(:) = 5
|
||||
if (maxloc (a, dim = 1).ne.1) call abort
|
||||
if (maxval (a, dim = 1).ne.5) call abort
|
||||
a(2) = huge(h)
|
||||
if (maxloc (a, dim = 1).ne.2) call abort
|
||||
if (maxval (a, dim = 1).ne.huge(h)) call abort
|
||||
a(:) = h
|
||||
if (maxloc (a, dim = 1).ne.1) call abort
|
||||
if (maxval (a, dim = 1).ne.h) call abort
|
||||
a(3) = -huge(h)
|
||||
if (maxloc (a, dim = 1).ne.3) call abort
|
||||
if (maxval (a, dim = 1).ne.-huge(h)) call abort
|
||||
c(:) = 5
|
||||
if (maxloc (c, dim = 1).ne.1) call abort
|
||||
if (maxval (c, dim = 1).ne.5) call abort
|
||||
c(2) = huge(h)
|
||||
if (maxloc (c, dim = 1).ne.2) call abort
|
||||
if (maxval (c, dim = 1).ne.huge(h)) call abort
|
||||
c(:) = h
|
||||
if (maxloc (c, dim = 1).ne.1) call abort
|
||||
if (maxval (c, dim = 1).ne.h) call abort
|
||||
c(3) = -huge(h)
|
||||
if (maxloc (c, dim = 1).ne.3) call abort
|
||||
if (maxval (c, dim = 1).ne.-huge(h)) call abort
|
||||
l = .false.
|
||||
l2(:) = .false.
|
||||
a(:) = 5
|
||||
if (maxloc (a, dim = 1, mask = l).ne.0) call abort
|
||||
if (maxval (a, dim = 1, mask = l).ne.h) call abort
|
||||
if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
|
||||
if (maxval (a, dim = 1, mask = l2).ne.h) call abort
|
||||
a(2) = huge(h)
|
||||
if (maxloc (a, dim = 1, mask = l).ne.0) call abort
|
||||
if (maxval (a, dim = 1, mask = l).ne.h) call abort
|
||||
if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
|
||||
if (maxval (a, dim = 1, mask = l2).ne.h) call abort
|
||||
a(:) = h
|
||||
if (maxloc (a, dim = 1, mask = l).ne.0) call abort
|
||||
if (maxval (a, dim = 1, mask = l).ne.h) call abort
|
||||
if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
|
||||
if (maxval (a, dim = 1, mask = l2).ne.h) call abort
|
||||
a(3) = -huge(h)
|
||||
if (maxloc (a, dim = 1, mask = l).ne.0) call abort
|
||||
if (maxval (a, dim = 1, mask = l).ne.h) call abort
|
||||
if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
|
||||
if (maxval (a, dim = 1, mask = l2).ne.h) call abort
|
||||
c(:) = 5
|
||||
if (maxloc (c, dim = 1, mask = l).ne.0) call abort
|
||||
if (maxval (c, dim = 1, mask = l).ne.h) call abort
|
||||
if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
|
||||
if (maxval (c, dim = 1, mask = l2).ne.h) call abort
|
||||
c(2) = huge(h)
|
||||
if (maxloc (c, dim = 1, mask = l).ne.0) call abort
|
||||
if (maxval (c, dim = 1, mask = l).ne.h) call abort
|
||||
if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
|
||||
if (maxval (c, dim = 1, mask = l2).ne.h) call abort
|
||||
c(:) = h
|
||||
if (maxloc (c, dim = 1, mask = l).ne.0) call abort
|
||||
if (maxval (c, dim = 1, mask = l).ne.h) call abort
|
||||
if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
|
||||
if (maxval (c, dim = 1, mask = l2).ne.h) call abort
|
||||
c(3) = -huge(h)
|
||||
if (maxloc (c, dim = 1, mask = l).ne.0) call abort
|
||||
if (maxval (c, dim = 1, mask = l).ne.h) call abort
|
||||
if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
|
||||
if (maxval (c, dim = 1, mask = l2).ne.h) call abort
|
||||
l = .true.
|
||||
l2(:) = .true.
|
||||
a(:) = 5
|
||||
if (maxloc (a, dim = 1, mask = l).ne.1) call abort
|
||||
if (maxval (a, dim = 1, mask = l).ne.5) call abort
|
||||
if (maxloc (a, dim = 1, mask = l2).ne.1) call abort
|
||||
if (maxval (a, dim = 1, mask = l2).ne.5) call abort
|
||||
a(2) = huge(h)
|
||||
if (maxloc (a, dim = 1, mask = l).ne.2) call abort
|
||||
if (maxval (a, dim = 1, mask = l).ne.huge(h)) call abort
|
||||
if (maxloc (a, dim = 1, mask = l2).ne.2) call abort
|
||||
if (maxval (a, dim = 1, mask = l2).ne.huge(h)) call abort
|
||||
a(:) = h
|
||||
if (maxloc (a, dim = 1, mask = l).ne.1) call abort
|
||||
if (maxval (a, dim = 1, mask = l).ne.h) call abort
|
||||
if (maxloc (a, dim = 1, mask = l2).ne.1) call abort
|
||||
if (maxval (a, dim = 1, mask = l2).ne.h) call abort
|
||||
a(3) = -huge(h)
|
||||
if (maxloc (a, dim = 1, mask = l).ne.3) call abort
|
||||
if (maxval (a, dim = 1, mask = l).ne.-huge(h)) call abort
|
||||
if (maxloc (a, dim = 1, mask = l2).ne.3) call abort
|
||||
if (maxval (a, dim = 1, mask = l2).ne.-huge(h)) call abort
|
||||
c(:) = 5
|
||||
if (maxloc (c, dim = 1, mask = l).ne.1) call abort
|
||||
if (maxval (c, dim = 1, mask = l).ne.5) call abort
|
||||
if (maxloc (c, dim = 1, mask = l2).ne.1) call abort
|
||||
if (maxval (c, dim = 1, mask = l2).ne.5) call abort
|
||||
c(2) = huge(h)
|
||||
if (maxloc (c, dim = 1, mask = l).ne.2) call abort
|
||||
if (maxval (c, dim = 1, mask = l).ne.huge(h)) call abort
|
||||
if (maxloc (c, dim = 1, mask = l2).ne.2) call abort
|
||||
if (maxval (c, dim = 1, mask = l2).ne.huge(h)) call abort
|
||||
c(:) = h
|
||||
if (maxloc (c, dim = 1, mask = l).ne.1) call abort
|
||||
if (maxval (c, dim = 1, mask = l).ne.h) call abort
|
||||
if (maxloc (c, dim = 1, mask = l2).ne.1) call abort
|
||||
if (maxval (c, dim = 1, mask = l2).ne.h) call abort
|
||||
c(3) = -huge(h)
|
||||
if (maxloc (c, dim = 1, mask = l).ne.3) call abort
|
||||
if (maxval (c, dim = 1, mask = l).ne.-huge(h)) call abort
|
||||
if (maxloc (c, dim = 1, mask = l2).ne.3) call abort
|
||||
if (maxval (c, dim = 1, mask = l2).ne.-huge(h)) call abort
|
||||
deallocate (c)
|
||||
allocate (c(-2:-3))
|
||||
if (maxloc (c, dim = 1).ne.0) call abort
|
||||
if (maxval (c, dim = 1).ne.h) call abort
|
||||
end
|
||||
|
|
@ -0,0 +1,118 @@
|
|||
! { dg-do run }
|
||||
real :: a(3,3), b(3), nan, minf, pinf, h
|
||||
logical :: l, l2
|
||||
logical :: l3(3,3), l4(3,3), l5(3,3)
|
||||
|
||||
nan = 0.0
|
||||
minf = 0.0
|
||||
pinf = 0.0
|
||||
nan = 0.0/nan
|
||||
minf = -1.0/minf
|
||||
pinf = 1.0/pinf
|
||||
h = -huge(h)
|
||||
l = .false.
|
||||
l2 = .true.
|
||||
l3 = .false.
|
||||
l4 = .true.
|
||||
l5 = .true.
|
||||
l5(1,1) = .false.
|
||||
l5(1,2) = .false.
|
||||
l5(2,3) = .false.
|
||||
a = reshape ((/ nan, nan, nan, minf, minf, minf, minf, pinf, minf /), (/ 3, 3 /))
|
||||
if (maxval (a).ne.pinf) call abort
|
||||
if (any (maxloc (a).ne.(/ 2, 3 /))) call abort
|
||||
b = maxval (a, dim = 1)
|
||||
if (.not.isnan(b(1))) call abort
|
||||
b(1) = 0.0
|
||||
if (any (b.ne.(/ 0.0, minf, pinf /))) call abort
|
||||
if (any (maxloc (a, dim = 1).ne.(/ 1, 1, 2 /))) call abort
|
||||
b = maxval (a, dim = 2)
|
||||
if (any (b.ne.(/ minf, pinf, minf /))) call abort
|
||||
if (any (maxloc (a, dim = 2).ne.(/ 2, 3, 2 /))) call abort
|
||||
if (maxval (a, mask = l).ne.h) call abort
|
||||
if (any (maxloc (a, mask = l).ne.(/ 0, 0 /))) call abort
|
||||
b = maxval (a, dim = 1, mask = l)
|
||||
if (any (b.ne.(/ h, h, h /))) call abort
|
||||
if (any (maxloc (a, dim = 1, mask = l).ne.(/ 0, 0, 0 /))) call abort
|
||||
b = maxval (a, dim = 2, mask = l)
|
||||
if (any (b.ne.(/ h, h, h /))) call abort
|
||||
if (any (maxloc (a, dim = 2, mask = l).ne.(/ 0, 0, 0 /))) call abort
|
||||
if (maxval (a, mask = l3).ne.h) call abort
|
||||
if (any (maxloc (a, mask = l3).ne.(/ 0, 0 /))) call abort
|
||||
b = maxval (a, dim = 1, mask = l3)
|
||||
if (any (b.ne.(/ h, h, h /))) call abort
|
||||
if (any (maxloc (a, dim = 1, mask = l3).ne.(/ 0, 0, 0 /))) call abort
|
||||
b = maxval (a, dim = 2, mask = l3)
|
||||
if (any (b.ne.(/ h, h, h /))) call abort
|
||||
if (any (maxloc (a, dim = 2, mask = l3).ne.(/ 0, 0, 0 /))) call abort
|
||||
if (maxval (a, mask = l2).ne.pinf) call abort
|
||||
if (maxval (a, mask = l4).ne.pinf) call abort
|
||||
if (any (maxloc (a, mask = l2).ne.(/ 2, 3 /))) call abort
|
||||
if (any (maxloc (a, mask = l4).ne.(/ 2, 3 /))) call abort
|
||||
b = maxval (a, dim = 1, mask = l2)
|
||||
if (.not.isnan(b(1))) call abort
|
||||
b(1) = 0.0
|
||||
if (any (b.ne.(/ 0.0, minf, pinf /))) call abort
|
||||
if (any (maxloc (a, dim = 1, mask = l2).ne.(/ 1, 1, 2 /))) call abort
|
||||
b = maxval (a, dim = 2, mask = l2)
|
||||
if (any (b.ne.(/ minf, pinf, minf /))) call abort
|
||||
if (any (maxloc (a, dim = 2, mask = l2).ne.(/ 2, 3, 2 /))) call abort
|
||||
b = maxval (a, dim = 1, mask = l4)
|
||||
if (.not.isnan(b(1))) call abort
|
||||
b(1) = 0.0
|
||||
if (any (b.ne.(/ 0.0, minf, pinf /))) call abort
|
||||
if (any (maxloc (a, dim = 1, mask = l2).ne.(/ 1, 1, 2 /))) call abort
|
||||
b = maxval (a, dim = 2, mask = l4)
|
||||
if (any (b.ne.(/ minf, pinf, minf /))) call abort
|
||||
if (any (maxloc (a, dim = 2, mask = l2).ne.(/ 2, 3, 2 /))) call abort
|
||||
if (maxval (a, mask = l5).ne.minf) call abort
|
||||
if (any (maxloc (a, mask = l5).ne.(/ 2, 2 /))) call abort
|
||||
b = maxval (a, dim = 1, mask = l5)
|
||||
if (.not.isnan(b(1))) call abort
|
||||
b(1) = 0.0
|
||||
if (any (b.ne.(/ 0.0, minf, minf /))) call abort
|
||||
if (any (maxloc (a, dim = 1, mask = l5).ne.(/ 2, 2, 1 /))) call abort
|
||||
b = maxval (a, dim = 2, mask = l5)
|
||||
if (any (b.ne.(/ minf, minf, minf /))) call abort
|
||||
if (any (maxloc (a, dim = 2, mask = l5).ne.(/ 3, 2, 2 /))) call abort
|
||||
a = nan
|
||||
if (.not.isnan(maxval (a))) call abort
|
||||
if (maxval (a, mask = l).ne.h) call abort
|
||||
if (.not.isnan(maxval (a, mask = l2))) call abort
|
||||
if (maxval (a, mask = l3).ne.h) call abort
|
||||
if (.not.isnan(maxval (a, mask = l4))) call abort
|
||||
if (.not.isnan(maxval (a, mask = l5))) call abort
|
||||
if (any (maxloc (a).ne.(/ 1, 1 /))) call abort
|
||||
if (any (maxloc (a, mask = l).ne.(/ 0, 0 /))) call abort
|
||||
if (any (maxloc (a, mask = l2).ne.(/ 1, 1 /))) call abort
|
||||
if (any (maxloc (a, mask = l3).ne.(/ 0, 0 /))) call abort
|
||||
if (any (maxloc (a, mask = l4).ne.(/ 1, 1 /))) call abort
|
||||
if (any (maxloc (a, mask = l5).ne.(/ 2, 1 /))) call abort
|
||||
a = minf
|
||||
if (maxval (a).ne.minf) call abort
|
||||
if (maxval (a, mask = l).ne.h) call abort
|
||||
if (maxval (a, mask = l2).ne.minf) call abort
|
||||
if (maxval (a, mask = l3).ne.h) call abort
|
||||
if (maxval (a, mask = l4).ne.minf) call abort
|
||||
if (maxval (a, mask = l5).ne.minf) call abort
|
||||
if (any (maxloc (a).ne.(/ 1, 1 /))) call abort
|
||||
if (any (maxloc (a, mask = l).ne.(/ 0, 0 /))) call abort
|
||||
if (any (maxloc (a, mask = l2).ne.(/ 1, 1 /))) call abort
|
||||
if (any (maxloc (a, mask = l3).ne.(/ 0, 0 /))) call abort
|
||||
if (any (maxloc (a, mask = l4).ne.(/ 1, 1 /))) call abort
|
||||
if (any (maxloc (a, mask = l5).ne.(/ 2, 1 /))) call abort
|
||||
a = nan
|
||||
a(1,3) = minf
|
||||
if (maxval (a).ne.minf) call abort
|
||||
if (maxval (a, mask = l).ne.h) call abort
|
||||
if (maxval (a, mask = l2).ne.minf) call abort
|
||||
if (maxval (a, mask = l3).ne.h) call abort
|
||||
if (maxval (a, mask = l4).ne.minf) call abort
|
||||
if (maxval (a, mask = l5).ne.minf) call abort
|
||||
if (any (maxloc (a).ne.(/ 1, 3 /))) call abort
|
||||
if (any (maxloc (a, mask = l).ne.(/ 0, 0 /))) call abort
|
||||
if (any (maxloc (a, mask = l2).ne.(/ 1, 3 /))) call abort
|
||||
if (any (maxloc (a, mask = l3).ne.(/ 0, 0 /))) call abort
|
||||
if (any (maxloc (a, mask = l4).ne.(/ 1, 3 /))) call abort
|
||||
if (any (maxloc (a, mask = l5).ne.(/ 1, 3 /))) call abort
|
||||
end
|
||||
|
|
@ -0,0 +1,153 @@
|
|||
! { dg-do run }
|
||||
real :: a(3), nan, minf, pinf
|
||||
real, allocatable :: c(:)
|
||||
logical :: l
|
||||
logical :: l2(3)
|
||||
|
||||
nan = 0.0
|
||||
minf = 0.0
|
||||
pinf = 0.0
|
||||
nan = 0.0/nan
|
||||
minf = -1.0/minf
|
||||
pinf = 1.0/pinf
|
||||
|
||||
allocate (c(3))
|
||||
a(:) = nan
|
||||
if (minloc (a, dim = 1).ne.1) call abort
|
||||
if (.not.isnan(minval (a, dim = 1))) call abort
|
||||
a(:) = pinf
|
||||
if (minloc (a, dim = 1).ne.1) call abort
|
||||
if (minval (a, dim = 1).ne.pinf) call abort
|
||||
a(1:2) = nan
|
||||
if (minloc (a, dim = 1).ne.3) call abort
|
||||
if (minval (a, dim = 1).ne.pinf) call abort
|
||||
a(2) = 1.0
|
||||
if (minloc (a, dim = 1).ne.2) call abort
|
||||
if (minval (a, dim = 1).ne.1) call abort
|
||||
a(2) = minf
|
||||
if (minloc (a, dim = 1).ne.2) call abort
|
||||
if (minval (a, dim = 1).ne.minf) call abort
|
||||
c(:) = nan
|
||||
if (minloc (c, dim = 1).ne.1) call abort
|
||||
if (.not.isnan(minval (c, dim = 1))) call abort
|
||||
c(:) = pinf
|
||||
if (minloc (c, dim = 1).ne.1) call abort
|
||||
if (minval (c, dim = 1).ne.pinf) call abort
|
||||
c(1:2) = nan
|
||||
if (minloc (c, dim = 1).ne.3) call abort
|
||||
if (minval (c, dim = 1).ne.pinf) call abort
|
||||
c(2) = 1.0
|
||||
if (minloc (c, dim = 1).ne.2) call abort
|
||||
if (minval (c, dim = 1).ne.1) call abort
|
||||
c(2) = minf
|
||||
if (minloc (c, dim = 1).ne.2) call abort
|
||||
if (minval (c, dim = 1).ne.minf) call abort
|
||||
l = .false.
|
||||
l2(:) = .false.
|
||||
a(:) = nan
|
||||
if (minloc (a, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (a, dim = 1, mask = l).ne.huge(pinf)) call abort
|
||||
if (minloc (a, dim = 1, mask = l2).ne.0) call abort
|
||||
if (minval (a, dim = 1, mask = l2).ne.huge(pinf)) call abort
|
||||
a(:) = pinf
|
||||
if (minloc (a, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (a, dim = 1, mask = l).ne.huge(pinf)) call abort
|
||||
if (minloc (a, dim = 1, mask = l2).ne.0) call abort
|
||||
if (minval (a, dim = 1, mask = l2).ne.huge(pinf)) call abort
|
||||
a(1:2) = nan
|
||||
if (minloc (a, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (a, dim = 1, mask = l).ne.huge(pinf)) call abort
|
||||
if (minloc (a, dim = 1, mask = l2).ne.0) call abort
|
||||
if (minval (a, dim = 1, mask = l2).ne.huge(pinf)) call abort
|
||||
a(2) = 1.0
|
||||
if (minloc (a, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (a, dim = 1, mask = l).ne.huge(pinf)) call abort
|
||||
if (minloc (a, dim = 1, mask = l2).ne.0) call abort
|
||||
if (minval (a, dim = 1, mask = l2).ne.huge(pinf)) call abort
|
||||
a(2) = minf
|
||||
if (minloc (a, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (a, dim = 1, mask = l).ne.huge(pinf)) call abort
|
||||
if (minloc (a, dim = 1, mask = l2).ne.0) call abort
|
||||
if (minval (a, dim = 1, mask = l2).ne.huge(pinf)) call abort
|
||||
c(:) = nan
|
||||
if (minloc (c, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (c, dim = 1, mask = l).ne.huge(pinf)) call abort
|
||||
if (minloc (c, dim = 1, mask = l2).ne.0) call abort
|
||||
if (minval (c, dim = 1, mask = l2).ne.huge(pinf)) call abort
|
||||
c(:) = pinf
|
||||
if (minloc (c, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (c, dim = 1, mask = l).ne.huge(pinf)) call abort
|
||||
if (minloc (c, dim = 1, mask = l2).ne.0) call abort
|
||||
if (minval (c, dim = 1, mask = l2).ne.huge(pinf)) call abort
|
||||
c(1:2) = nan
|
||||
if (minloc (c, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (c, dim = 1, mask = l).ne.huge(pinf)) call abort
|
||||
if (minloc (c, dim = 1, mask = l2).ne.0) call abort
|
||||
if (minval (c, dim = 1, mask = l2).ne.huge(pinf)) call abort
|
||||
c(2) = 1.0
|
||||
if (minloc (c, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (c, dim = 1, mask = l).ne.huge(pinf)) call abort
|
||||
if (minloc (c, dim = 1, mask = l2).ne.0) call abort
|
||||
if (minval (c, dim = 1, mask = l2).ne.huge(pinf)) call abort
|
||||
c(2) = minf
|
||||
if (minloc (c, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (c, dim = 1, mask = l).ne.huge(pinf)) call abort
|
||||
if (minloc (c, dim = 1, mask = l2).ne.0) call abort
|
||||
if (minval (c, dim = 1, mask = l2).ne.huge(pinf)) call abort
|
||||
l = .true.
|
||||
l2(:) = .true.
|
||||
a(:) = nan
|
||||
if (minloc (a, dim = 1, mask = l).ne.1) call abort
|
||||
if (.not.isnan(minval (a, dim = 1, mask = l))) call abort
|
||||
if (minloc (a, dim = 1, mask = l2).ne.1) call abort
|
||||
if (.not.isnan(minval (a, dim = 1, mask = l2))) call abort
|
||||
a(:) = pinf
|
||||
if (minloc (a, dim = 1, mask = l).ne.1) call abort
|
||||
if (minval (a, dim = 1, mask = l).ne.pinf) call abort
|
||||
if (minloc (a, dim = 1, mask = l2).ne.1) call abort
|
||||
if (minval (a, dim = 1, mask = l2).ne.pinf) call abort
|
||||
a(1:2) = nan
|
||||
if (minloc (a, dim = 1, mask = l).ne.3) call abort
|
||||
if (minval (a, dim = 1, mask = l).ne.pinf) call abort
|
||||
if (minloc (a, dim = 1, mask = l2).ne.3) call abort
|
||||
if (minval (a, dim = 1, mask = l2).ne.pinf) call abort
|
||||
a(2) = 1.0
|
||||
if (minloc (a, dim = 1, mask = l).ne.2) call abort
|
||||
if (minval (a, dim = 1, mask = l).ne.1) call abort
|
||||
if (minloc (a, dim = 1, mask = l2).ne.2) call abort
|
||||
if (minval (a, dim = 1, mask = l2).ne.1) call abort
|
||||
a(2) = minf
|
||||
if (minloc (a, dim = 1, mask = l).ne.2) call abort
|
||||
if (minval (a, dim = 1, mask = l).ne.minf) call abort
|
||||
if (minloc (a, dim = 1, mask = l2).ne.2) call abort
|
||||
if (minval (a, dim = 1, mask = l2).ne.minf) call abort
|
||||
c(:) = nan
|
||||
if (minloc (c, dim = 1, mask = l).ne.1) call abort
|
||||
if (.not.isnan(minval (c, dim = 1, mask = l))) call abort
|
||||
if (minloc (c, dim = 1, mask = l2).ne.1) call abort
|
||||
if (.not.isnan(minval (c, dim = 1, mask = l2))) call abort
|
||||
c(:) = pinf
|
||||
if (minloc (c, dim = 1, mask = l).ne.1) call abort
|
||||
if (minval (c, dim = 1, mask = l).ne.pinf) call abort
|
||||
if (minloc (c, dim = 1, mask = l2).ne.1) call abort
|
||||
if (minval (c, dim = 1, mask = l2).ne.pinf) call abort
|
||||
c(1:2) = nan
|
||||
if (minloc (c, dim = 1, mask = l).ne.3) call abort
|
||||
if (minval (c, dim = 1, mask = l).ne.pinf) call abort
|
||||
if (minloc (c, dim = 1, mask = l2).ne.3) call abort
|
||||
if (minval (c, dim = 1, mask = l2).ne.pinf) call abort
|
||||
c(2) = 1.0
|
||||
if (minloc (c, dim = 1, mask = l).ne.2) call abort
|
||||
if (minval (c, dim = 1, mask = l).ne.1) call abort
|
||||
if (minloc (c, dim = 1, mask = l2).ne.2) call abort
|
||||
if (minval (c, dim = 1, mask = l2).ne.1) call abort
|
||||
c(2) = minf
|
||||
if (minloc (c, dim = 1, mask = l).ne.2) call abort
|
||||
if (minval (c, dim = 1, mask = l).ne.minf) call abort
|
||||
if (minloc (c, dim = 1, mask = l2).ne.2) call abort
|
||||
if (minval (c, dim = 1, mask = l2).ne.minf) call abort
|
||||
deallocate (c)
|
||||
allocate (c(-2:-3))
|
||||
if (minloc (c, dim = 1).ne.0) call abort
|
||||
if (minval (c, dim = 1).ne.huge(pinf)) call abort
|
||||
end
|
||||
|
|
@ -0,0 +1,122 @@
|
|||
! { dg-do run }
|
||||
integer :: a(3), h
|
||||
integer, allocatable :: c(:)
|
||||
logical :: l
|
||||
logical :: l2(3)
|
||||
|
||||
h = -huge(h)
|
||||
h = h - 1
|
||||
allocate (c(3))
|
||||
a(:) = 5
|
||||
if (minloc (a, dim = 1).ne.1) call abort
|
||||
if (minval (a, dim = 1).ne.5) call abort
|
||||
a(2) = h
|
||||
if (minloc (a, dim = 1).ne.2) call abort
|
||||
if (minval (a, dim = 1).ne.h) call abort
|
||||
a(:) = huge(h)
|
||||
if (minloc (a, dim = 1).ne.1) call abort
|
||||
if (minval (a, dim = 1).ne.huge(h)) call abort
|
||||
a(3) = huge(h) - 1
|
||||
if (minloc (a, dim = 1).ne.3) call abort
|
||||
if (minval (a, dim = 1).ne.huge(h)-1) call abort
|
||||
c(:) = 5
|
||||
if (minloc (c, dim = 1).ne.1) call abort
|
||||
if (minval (c, dim = 1).ne.5) call abort
|
||||
c(2) = h
|
||||
if (minloc (c, dim = 1).ne.2) call abort
|
||||
if (minval (c, dim = 1).ne.h) call abort
|
||||
c(:) = huge(h)
|
||||
if (minloc (c, dim = 1).ne.1) call abort
|
||||
if (minval (c, dim = 1).ne.huge(h)) call abort
|
||||
c(3) = huge(h) - 1
|
||||
if (minloc (c, dim = 1).ne.3) call abort
|
||||
if (minval (c, dim = 1).ne.huge(h)-1) call abort
|
||||
l = .false.
|
||||
l2(:) = .false.
|
||||
a(:) = 5
|
||||
if (minloc (a, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (a, dim = 1, mask = l).ne.huge(h)) call abort
|
||||
if (minloc (a, dim = 1, mask = l2).ne.0) call abort
|
||||
if (minval (a, dim = 1, mask = l2).ne.huge(h)) call abort
|
||||
a(2) = h
|
||||
if (minloc (a, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (a, dim = 1, mask = l).ne.huge(h)) call abort
|
||||
if (minloc (a, dim = 1, mask = l2).ne.0) call abort
|
||||
if (minval (a, dim = 1, mask = l2).ne.huge(h)) call abort
|
||||
a(:) = huge(h)
|
||||
if (minloc (a, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (a, dim = 1, mask = l).ne.huge(h)) call abort
|
||||
if (minloc (a, dim = 1, mask = l2).ne.0) call abort
|
||||
if (minval (a, dim = 1, mask = l2).ne.huge(h)) call abort
|
||||
a(3) = huge(h) - 1
|
||||
if (minloc (a, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (a, dim = 1, mask = l).ne.huge(h)) call abort
|
||||
if (minloc (a, dim = 1, mask = l2).ne.0) call abort
|
||||
if (minval (a, dim = 1, mask = l2).ne.huge(h)) call abort
|
||||
c(:) = 5
|
||||
if (minloc (c, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (c, dim = 1, mask = l).ne.huge(h)) call abort
|
||||
if (minloc (c, dim = 1, mask = l2).ne.0) call abort
|
||||
if (minval (c, dim = 1, mask = l2).ne.huge(h)) call abort
|
||||
c(2) = h
|
||||
if (minloc (c, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (c, dim = 1, mask = l).ne.huge(h)) call abort
|
||||
if (minloc (c, dim = 1, mask = l2).ne.0) call abort
|
||||
if (minval (c, dim = 1, mask = l2).ne.huge(h)) call abort
|
||||
c(:) = huge(h)
|
||||
if (minloc (c, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (c, dim = 1, mask = l).ne.huge(h)) call abort
|
||||
if (minloc (c, dim = 1, mask = l2).ne.0) call abort
|
||||
if (minval (c, dim = 1, mask = l2).ne.huge(h)) call abort
|
||||
c(3) = huge(h) - 1
|
||||
if (minloc (c, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (c, dim = 1, mask = l).ne.huge(h)) call abort
|
||||
if (minloc (c, dim = 1, mask = l2).ne.0) call abort
|
||||
if (minval (c, dim = 1, mask = l2).ne.huge(h)) call abort
|
||||
l = .true.
|
||||
l2(:) = .true.
|
||||
a(:) = 5
|
||||
if (minloc (a, dim = 1, mask = l).ne.1) call abort
|
||||
if (minval (a, dim = 1, mask = l).ne.5) call abort
|
||||
if (minloc (a, dim = 1, mask = l2).ne.1) call abort
|
||||
if (minval (a, dim = 1, mask = l2).ne.5) call abort
|
||||
a(2) = h
|
||||
if (minloc (a, dim = 1, mask = l).ne.2) call abort
|
||||
if (minval (a, dim = 1, mask = l).ne.h) call abort
|
||||
if (minloc (a, dim = 1, mask = l2).ne.2) call abort
|
||||
if (minval (a, dim = 1, mask = l2).ne.h) call abort
|
||||
a(:) = huge(h)
|
||||
if (minloc (a, dim = 1, mask = l).ne.1) call abort
|
||||
if (minval (a, dim = 1, mask = l).ne.huge(h)) call abort
|
||||
if (minloc (a, dim = 1, mask = l2).ne.1) call abort
|
||||
if (minval (a, dim = 1, mask = l2).ne.huge(h)) call abort
|
||||
a(3) = huge(h) - 1
|
||||
if (minloc (a, dim = 1, mask = l).ne.3) call abort
|
||||
if (minval (a, dim = 1, mask = l).ne.huge(h)-1) call abort
|
||||
if (minloc (a, dim = 1, mask = l2).ne.3) call abort
|
||||
if (minval (a, dim = 1, mask = l2).ne.huge(h)-1) call abort
|
||||
c(:) = 5
|
||||
if (minloc (c, dim = 1, mask = l).ne.1) call abort
|
||||
if (minval (c, dim = 1, mask = l).ne.5) call abort
|
||||
if (minloc (c, dim = 1, mask = l2).ne.1) call abort
|
||||
if (minval (c, dim = 1, mask = l2).ne.5) call abort
|
||||
c(2) = h
|
||||
if (minloc (c, dim = 1, mask = l).ne.2) call abort
|
||||
if (minval (c, dim = 1, mask = l).ne.h) call abort
|
||||
if (minloc (c, dim = 1, mask = l2).ne.2) call abort
|
||||
if (minval (c, dim = 1, mask = l2).ne.h) call abort
|
||||
c(:) = huge(h)
|
||||
if (minloc (c, dim = 1, mask = l).ne.1) call abort
|
||||
if (minval (c, dim = 1, mask = l).ne.huge(h)) call abort
|
||||
if (minloc (c, dim = 1, mask = l2).ne.1) call abort
|
||||
if (minval (c, dim = 1, mask = l2).ne.huge(h)) call abort
|
||||
c(3) = huge(h) - 1
|
||||
if (minloc (c, dim = 1, mask = l).ne.3) call abort
|
||||
if (minval (c, dim = 1, mask = l).ne.huge(h)-1) call abort
|
||||
if (minloc (c, dim = 1, mask = l2).ne.3) call abort
|
||||
if (minval (c, dim = 1, mask = l2).ne.huge(h)-1) call abort
|
||||
deallocate (c)
|
||||
allocate (c(-2:-3))
|
||||
if (minloc (c, dim = 1).ne.0) call abort
|
||||
if (minval (c, dim = 1).ne.huge(h)) call abort
|
||||
end
|
||||
|
|
@ -0,0 +1,284 @@
|
|||
real :: a(30), b(10, 10), m
|
||||
real, allocatable :: c(:), d(:, :)
|
||||
integer :: e(30), f(10, 10), n
|
||||
integer, allocatable :: g(:), h(:,:)
|
||||
logical :: l(30), l2(10, 10)
|
||||
allocate (c (30))
|
||||
allocate (d (10, 10))
|
||||
allocate (g (30))
|
||||
allocate (h (10, 10))
|
||||
a = 7.0
|
||||
b = 7.0
|
||||
c = 7.0
|
||||
d = 7.0
|
||||
e = 7
|
||||
f = 7
|
||||
g = 7
|
||||
h = 7
|
||||
m = huge(m)
|
||||
n = huge(n)
|
||||
a(7) = 6.0
|
||||
b(5, 5) = 6.0
|
||||
b(5, 6) = 5.0
|
||||
b(6, 7) = 4.0
|
||||
c(7) = 6.0
|
||||
d(5, 5) = 6.0
|
||||
d(5, 6) = 5.0
|
||||
d(6, 7) = 4.0
|
||||
e(7) = 6
|
||||
f(5, 5) = 6
|
||||
f(5, 6) = 5
|
||||
f(6, 7) = 4
|
||||
g(7) = 6
|
||||
h(5, 5) = 6
|
||||
h(5, 6) = 5
|
||||
h(6, 7) = 4
|
||||
if (minloc (a, dim = 1).ne.7) call abort
|
||||
if (minval (a, dim = 1).ne.6.0) call abort
|
||||
if (minloc (a(::2), dim = 1).ne.4) call abort
|
||||
if (minval (a(::2), dim = 1).ne.6.0) call abort
|
||||
if (any (minloc (a).ne.(/ 7 /))) call abort
|
||||
if (minval (a).ne.6.0) call abort
|
||||
if (any (minloc (a(::2)).ne.(/ 4 /))) call abort
|
||||
if (minval (a(::2)).ne.6.0) call abort
|
||||
if (any (minloc (b, dim = 1).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
|
||||
if (any (minval (b, dim = 1).ne.(/ 7.0, 7.0, 7.0, 7.0, 6.0, 5.0, 4.0, 7.0, 7.0, 7.0 /))) call abort
|
||||
if (any (minloc (b(::2,::2), dim = 1).ne.(/ 1, 1, 3, 1, 1 /))) call abort
|
||||
if (any (minval (b(::2,::2), dim = 1).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
|
||||
if (any (minloc (b, dim = 2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
|
||||
if (any (minval (b, dim = 2).ne.(/ 7.0, 7.0, 7.0, 7.0, 5.0, 4.0, 7.0, 7.0, 7.0, 7.0 /))) call abort
|
||||
if (any (minloc (b(::2,::2), dim = 2).ne.(/ 1, 1, 3, 1, 1 /))) call abort
|
||||
if (any (minval (b(::2,::2), dim = 2).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
|
||||
if (any (minloc (b).ne.(/ 6, 7 /))) call abort
|
||||
if (minval (b).ne.4.0) call abort
|
||||
if (any (minloc (b(::2,::2)).ne.(/ 3, 3 /))) call abort
|
||||
if (minval (b(::2,::2)).ne.6.0) call abort
|
||||
if (minloc (c, dim = 1).ne.7) call abort
|
||||
if (minval (c, dim = 1).ne.6.0) call abort
|
||||
if (minloc (c(::2), dim = 1).ne.4) call abort
|
||||
if (minval (c(::2), dim = 1).ne.6.0) call abort
|
||||
if (any (minloc (c).ne.(/ 7 /))) call abort
|
||||
if (minval (c).ne.6.0) call abort
|
||||
if (any (minloc (c(::2)).ne.(/ 4 /))) call abort
|
||||
if (minval (c(::2)).ne.6.0) call abort
|
||||
if (any (minloc (d, dim = 1).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
|
||||
if (any (minval (d, dim = 1).ne.(/ 7.0, 7.0, 7.0, 7.0, 6.0, 5.0, 4.0, 7.0, 7.0, 7.0 /))) call abort
|
||||
if (any (minloc (d(::2,::2), dim = 1).ne.(/ 1, 1, 3, 1, 1 /))) call abort
|
||||
if (any (minval (d(::2,::2), dim = 1).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
|
||||
if (any (minloc (d, dim = 2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
|
||||
if (any (minval (d, dim = 2).ne.(/ 7.0, 7.0, 7.0, 7.0, 5.0, 4.0, 7.0, 7.0, 7.0, 7.0 /))) call abort
|
||||
if (any (minloc (d(::2,::2), dim = 2).ne.(/ 1, 1, 3, 1, 1 /))) call abort
|
||||
if (any (minval (d(::2,::2), dim = 2).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
|
||||
if (any (minloc (d).ne.(/ 6, 7 /))) call abort
|
||||
if (minval (d).ne.4.0) call abort
|
||||
if (any (minloc (d(::2,::2)).ne.(/ 3, 3 /))) call abort
|
||||
if (minval (d(::2,::2)).ne.6.0) call abort
|
||||
if (minloc (e, dim = 1).ne.7) call abort
|
||||
if (minval (e, dim = 1).ne.6) call abort
|
||||
if (minloc (e(::2), dim = 1).ne.4) call abort
|
||||
if (minval (e(::2), dim = 1).ne.6) call abort
|
||||
if (any (minloc (e).ne.(/ 7 /))) call abort
|
||||
if (minval (e).ne.6) call abort
|
||||
if (any (minloc (e(::2)).ne.(/ 4 /))) call abort
|
||||
if (minval (e(::2)).ne.6) call abort
|
||||
if (any (minloc (f, dim = 1).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
|
||||
if (any (minval (f, dim = 1).ne.(/ 7, 7, 7, 7, 6, 5, 4, 7, 7, 7 /))) call abort
|
||||
if (any (minloc (f(::2,::2), dim = 1).ne.(/ 1, 1, 3, 1, 1 /))) call abort
|
||||
if (any (minval (f(::2,::2), dim = 1).ne.(/ 7, 7, 6, 7, 7 /))) call abort
|
||||
if (any (minloc (f, dim = 2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
|
||||
if (any (minval (f, dim = 2).ne.(/ 7, 7, 7, 7, 5, 4, 7, 7, 7, 7 /))) call abort
|
||||
if (any (minloc (f(::2,::2), dim = 2).ne.(/ 1, 1, 3, 1, 1 /))) call abort
|
||||
if (any (minval (f(::2,::2), dim = 2).ne.(/ 7, 7, 6, 7, 7 /))) call abort
|
||||
if (any (minloc (f).ne.(/ 6, 7 /))) call abort
|
||||
if (minval (f).ne.4) call abort
|
||||
if (any (minloc (f(::2,::2)).ne.(/ 3, 3 /))) call abort
|
||||
if (minval (f(::2,::2)).ne.6) call abort
|
||||
if (minloc (g, dim = 1).ne.7) call abort
|
||||
if (minval (g, dim = 1).ne.6) call abort
|
||||
if (minloc (g(::2), dim = 1).ne.4) call abort
|
||||
if (minval (g(::2), dim = 1).ne.6) call abort
|
||||
if (any (minloc (g).ne.(/ 7 /))) call abort
|
||||
if (minval (g).ne.6) call abort
|
||||
if (any (minloc (g(::2)).ne.(/ 4 /))) call abort
|
||||
if (minval (g(::2)).ne.6) call abort
|
||||
if (any (minloc (h, dim = 1).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
|
||||
if (any (minval (h, dim = 1).ne.(/ 7, 7, 7, 7, 6, 5, 4, 7, 7, 7 /))) call abort
|
||||
if (any (minloc (h(::2,::2), dim = 1).ne.(/ 1, 1, 3, 1, 1 /))) call abort
|
||||
if (any (minval (h(::2,::2), dim = 1).ne.(/ 7, 7, 6, 7, 7 /))) call abort
|
||||
if (any (minloc (h, dim = 2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
|
||||
if (any (minval (h, dim = 2).ne.(/ 7, 7, 7, 7, 5, 4, 7, 7, 7, 7 /))) call abort
|
||||
if (any (minloc (h(::2,::2), dim = 2).ne.(/ 1, 1, 3, 1, 1 /))) call abort
|
||||
if (any (minval (h(::2,::2), dim = 2).ne.(/ 7, 7, 6, 7, 7 /))) call abort
|
||||
if (any (minloc (h).ne.(/ 6, 7 /))) call abort
|
||||
if (minval (h).ne.4) call abort
|
||||
if (any (minloc (h(::2,::2)).ne.(/ 3, 3 /))) call abort
|
||||
if (minval (h(::2,::2)).ne.6) call abort
|
||||
l = .true.
|
||||
l2 = .true.
|
||||
if (minloc (a, dim = 1, mask = l).ne.7) call abort
|
||||
if (minval (a, dim = 1, mask = l).ne.6.0) call abort
|
||||
if (minloc (a(::2), dim = 1, mask = l(::2)).ne.4) call abort
|
||||
if (minval (a(::2), dim = 1, mask = l(::2)).ne.6.0) call abort
|
||||
if (any (minloc (a, mask = l).ne.(/ 7 /))) call abort
|
||||
if (minval (a, mask = l).ne.6.0) call abort
|
||||
if (any (minloc (a(::2), mask = l(::2)).ne.(/ 4 /))) call abort
|
||||
if (minval (a(::2), mask = l(::2)).ne.6.0) call abort
|
||||
if (any (minloc (b, dim = 1, mask = l2).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
|
||||
if (any (minval (b, dim = 1, mask = l2).ne.(/ 7.0, 7.0, 7.0, 7.0, 6.0, 5.0, 4.0, 7.0, 7.0, 7.0 /))) call abort
|
||||
if (any (minloc (b(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
|
||||
if (any (minval (b(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
|
||||
if (any (minloc (b, dim = 2, mask = l2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
|
||||
if (any (minval (b, dim = 2, mask = l2).ne.(/ 7.0, 7.0, 7.0, 7.0, 5.0, 4.0, 7.0, 7.0, 7.0, 7.0 /))) call abort
|
||||
if (any (minloc (b(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
|
||||
if (any (minval (b(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
|
||||
if (any (minloc (b, mask = l2).ne.(/ 6, 7 /))) call abort
|
||||
if (minval (b, mask = l2).ne.4.0) call abort
|
||||
if (any (minloc (b(::2,::2), mask = l2(::2,::2)).ne.(/ 3, 3 /))) call abort
|
||||
if (minval (b(::2,::2), mask = l2(::2,::2)).ne.6.0) call abort
|
||||
if (minloc (c, dim = 1, mask = l).ne.7) call abort
|
||||
if (minval (c, dim = 1, mask = l).ne.6.0) call abort
|
||||
if (minloc (c(::2), dim = 1, mask = l(::2)).ne.4) call abort
|
||||
if (minval (c(::2), dim = 1, mask = l(::2)).ne.6.0) call abort
|
||||
if (any (minloc (c, mask = l).ne.(/ 7 /))) call abort
|
||||
if (minval (c, mask = l).ne.6.0) call abort
|
||||
if (any (minloc (c(::2), mask = l(::2)).ne.(/ 4 /))) call abort
|
||||
if (minval (c(::2), mask = l(::2)).ne.6.0) call abort
|
||||
if (any (minloc (d, dim = 1, mask = l2).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
|
||||
if (any (minval (d, dim = 1, mask = l2).ne.(/ 7.0, 7.0, 7.0, 7.0, 6.0, 5.0, 4.0, 7.0, 7.0, 7.0 /))) call abort
|
||||
if (any (minloc (d(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
|
||||
if (any (minval (d(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
|
||||
if (any (minloc (d, dim = 2, mask = l2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
|
||||
if (any (minval (d, dim = 2, mask = l2).ne.(/ 7.0, 7.0, 7.0, 7.0, 5.0, 4.0, 7.0, 7.0, 7.0, 7.0 /))) call abort
|
||||
if (any (minloc (d(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
|
||||
if (any (minval (d(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
|
||||
if (any (minloc (d, mask = l2).ne.(/ 6, 7 /))) call abort
|
||||
if (minval (d, mask = l2).ne.4.0) call abort
|
||||
if (any (minloc (d(::2,::2), mask = l2(::2,::2)).ne.(/ 3, 3 /))) call abort
|
||||
if (minval (d(::2,::2), mask = l2(::2,::2)).ne.6.0) call abort
|
||||
if (minloc (e, dim = 1, mask = l).ne.7) call abort
|
||||
if (minval (e, dim = 1, mask = l).ne.6) call abort
|
||||
if (minloc (e(::2), dim = 1, mask = l(::2)).ne.4) call abort
|
||||
if (minval (e(::2), dim = 1, mask = l(::2)).ne.6) call abort
|
||||
if (any (minloc (e, mask = l).ne.(/ 7 /))) call abort
|
||||
if (minval (e, mask = l).ne.6) call abort
|
||||
if (any (minloc (e(::2), mask = l(::2)).ne.(/ 4 /))) call abort
|
||||
if (minval (e(::2), mask = l(::2)).ne.6) call abort
|
||||
if (any (minloc (f, dim = 1, mask = l2).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
|
||||
if (any (minval (f, dim = 1, mask = l2).ne.(/ 7, 7, 7, 7, 6, 5, 4, 7, 7, 7 /))) call abort
|
||||
if (any (minloc (f(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
|
||||
if (any (minval (f(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 7, 7, 6, 7, 7 /))) call abort
|
||||
if (any (minloc (f, dim = 2, mask = l2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
|
||||
if (any (minval (f, dim = 2, mask = l2).ne.(/ 7, 7, 7, 7, 5, 4, 7, 7, 7, 7 /))) call abort
|
||||
if (any (minloc (f(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
|
||||
if (any (minval (f(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 7, 7, 6, 7, 7 /))) call abort
|
||||
if (any (minloc (f, mask = l2).ne.(/ 6, 7 /))) call abort
|
||||
if (minval (f, mask = l2).ne.4) call abort
|
||||
if (any (minloc (f(::2,::2), mask = l2(::2,::2)).ne.(/ 3, 3 /))) call abort
|
||||
if (minval (f(::2,::2), mask = l2(::2,::2)).ne.6) call abort
|
||||
if (minloc (g, dim = 1, mask = l).ne.7) call abort
|
||||
if (minval (g, dim = 1, mask = l).ne.6) call abort
|
||||
if (minloc (g(::2), dim = 1, mask = l(::2)).ne.4) call abort
|
||||
if (minval (g(::2), dim = 1, mask = l(::2)).ne.6) call abort
|
||||
if (any (minloc (g, mask = l).ne.(/ 7 /))) call abort
|
||||
if (minval (g, mask = l).ne.6) call abort
|
||||
if (any (minloc (g(::2), mask = l(::2)).ne.(/ 4 /))) call abort
|
||||
if (minval (g(::2), mask = l(::2)).ne.6) call abort
|
||||
if (any (minloc (h, dim = 1, mask = l2).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
|
||||
if (any (minval (h, dim = 1, mask = l2).ne.(/ 7, 7, 7, 7, 6, 5, 4, 7, 7, 7 /))) call abort
|
||||
if (any (minloc (h(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
|
||||
if (any (minval (h(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 7, 7, 6, 7, 7 /))) call abort
|
||||
if (any (minloc (h, dim = 2, mask = l2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
|
||||
if (any (minval (h, dim = 2, mask = l2).ne.(/ 7, 7, 7, 7, 5, 4, 7, 7, 7, 7 /))) call abort
|
||||
if (any (minloc (h(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
|
||||
if (any (minval (h(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 7, 7, 6, 7, 7 /))) call abort
|
||||
if (any (minloc (h, mask = l2).ne.(/ 6, 7 /))) call abort
|
||||
if (minval (h, mask = l2).ne.4) call abort
|
||||
if (any (minloc (h(::2,::2), mask = l2(::2,::2)).ne.(/ 3, 3 /))) call abort
|
||||
if (minval (h(::2,::2), mask = l2(::2,::2)).ne.6) call abort
|
||||
l = .false.
|
||||
l2 = .false.
|
||||
if (minloc (a, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (a, dim = 1, mask = l).ne.m) call abort
|
||||
if (minloc (a(::2), dim = 1, mask = l(::2)).ne.0) call abort
|
||||
if (minval (a(::2), dim = 1, mask = l(::2)).ne.m) call abort
|
||||
if (any (minloc (a, mask = l).ne.(/ 0 /))) call abort
|
||||
if (minval (a, mask = l).ne.m) call abort
|
||||
if (any (minloc (a(::2), mask = l(::2)).ne.(/ 0 /))) call abort
|
||||
if (minval (a(::2), mask = l(::2)).ne.m) call abort
|
||||
if (any (minloc (b, dim = 1, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
|
||||
if (any (minval (b, dim = 1, mask = l2).ne.(/ m, m, m, m, m, m, m, m, m, m /))) call abort
|
||||
if (any (minloc (b(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
|
||||
if (any (minval (b(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ m, m, m, m, m /))) call abort
|
||||
if (any (minloc (b, dim = 2, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
|
||||
if (any (minval (b, dim = 2, mask = l2).ne.(/ m, m, m, m, m, m, m, m, m, m /))) call abort
|
||||
if (any (minloc (b(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
|
||||
if (any (minval (b(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ m, m, m, m, m /))) call abort
|
||||
if (any (minloc (b, mask = l2).ne.(/ 0, 0 /))) call abort
|
||||
if (minval (b, mask = l2).ne.m) call abort
|
||||
if (any (minloc (b(::2,::2), mask = l2(::2,::2)).ne.(/ 0, 0 /))) call abort
|
||||
if (minval (b(::2,::2), mask = l2(::2,::2)).ne.m) call abort
|
||||
if (minloc (c, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (c, dim = 1, mask = l).ne.m) call abort
|
||||
if (minloc (c(::2), dim = 1, mask = l(::2)).ne.0) call abort
|
||||
if (minval (c(::2), dim = 1, mask = l(::2)).ne.m) call abort
|
||||
if (any (minloc (c, mask = l).ne.(/ 0 /))) call abort
|
||||
if (minval (c, mask = l).ne.m) call abort
|
||||
if (any (minloc (c(::2), mask = l(::2)).ne.(/ 0 /))) call abort
|
||||
if (minval (c(::2), mask = l(::2)).ne.m) call abort
|
||||
if (any (minloc (d, dim = 1, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
|
||||
if (any (minval (d, dim = 1, mask = l2).ne.(/ m, m, m, m, m, m, m, m, m, m /))) call abort
|
||||
if (any (minloc (d(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
|
||||
if (any (minval (d(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ m, m, m, m, m /))) call abort
|
||||
if (any (minloc (d, dim = 2, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
|
||||
if (any (minval (d, dim = 2, mask = l2).ne.(/ m, m, m, m, m, m, m, m, m, m /))) call abort
|
||||
if (any (minloc (d(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
|
||||
if (any (minval (d(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ m, m, m, m, m /))) call abort
|
||||
if (any (minloc (d, mask = l2).ne.(/ 0, 0 /))) call abort
|
||||
if (minval (d, mask = l2).ne.m) call abort
|
||||
if (any (minloc (d(::2,::2), mask = l2(::2,::2)).ne.(/ 0, 0 /))) call abort
|
||||
if (minval (d(::2,::2), mask = l2(::2,::2)).ne.m) call abort
|
||||
if (minloc (e, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (e, dim = 1, mask = l).ne.n) call abort
|
||||
if (minloc (e(::2), dim = 1, mask = l(::2)).ne.0) call abort
|
||||
if (minval (e(::2), dim = 1, mask = l(::2)).ne.n) call abort
|
||||
if (any (minloc (e, mask = l).ne.(/ 0 /))) call abort
|
||||
if (minval (e, mask = l).ne.n) call abort
|
||||
if (any (minloc (e(::2), mask = l(::2)).ne.(/ 0 /))) call abort
|
||||
if (minval (e(::2), mask = l(::2)).ne.n) call abort
|
||||
if (any (minloc (f, dim = 1, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
|
||||
if (any (minval (f, dim = 1, mask = l2).ne.(/ n, n, n, n, n, n, n, n, n, n /))) call abort
|
||||
if (any (minloc (f(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
|
||||
if (any (minval (f(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ n, n, n, n, n /))) call abort
|
||||
if (any (minloc (f, dim = 2, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
|
||||
if (any (minval (f, dim = 2, mask = l2).ne.(/ n, n, n, n, n, n, n, n, n, n /))) call abort
|
||||
if (any (minloc (f(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
|
||||
if (any (minval (f(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ n, n, n, n, n /))) call abort
|
||||
if (any (minloc (f, mask = l2).ne.(/ 0, 0 /))) call abort
|
||||
if (minval (f, mask = l2).ne.n) call abort
|
||||
if (any (minloc (f(::2,::2), mask = l2(::2,::2)).ne.(/ 0, 0 /))) call abort
|
||||
if (minval (f(::2,::2), mask = l2(::2,::2)).ne.n) call abort
|
||||
if (minloc (g, dim = 1, mask = l).ne.0) call abort
|
||||
if (minval (g, dim = 1, mask = l).ne.n) call abort
|
||||
if (minloc (g(::2), dim = 1, mask = l(::2)).ne.0) call abort
|
||||
if (minval (g(::2), dim = 1, mask = l(::2)).ne.n) call abort
|
||||
if (any (minloc (g, mask = l).ne.(/ 0 /))) call abort
|
||||
if (minval (g, mask = l).ne.n) call abort
|
||||
if (any (minloc (g(::2), mask = l(::2)).ne.(/ 0 /))) call abort
|
||||
if (minval (g(::2), mask = l(::2)).ne.n) call abort
|
||||
if (any (minloc (h, dim = 1, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
|
||||
if (any (minval (h, dim = 1, mask = l2).ne.(/ n, n, n, n, n, n, n, n, n, n /))) call abort
|
||||
if (any (minloc (h(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
|
||||
if (any (minval (h(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ n, n, n, n, n /))) call abort
|
||||
if (any (minloc (h, dim = 2, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
|
||||
if (any (minval (h, dim = 2, mask = l2).ne.(/ n, n, n, n, n, n, n, n, n, n /))) call abort
|
||||
if (any (minloc (h(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
|
||||
if (any (minval (h(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ n, n, n, n, n /))) call abort
|
||||
if (any (minloc (h, mask = l2).ne.(/ 0, 0 /))) call abort
|
||||
if (minval (h, mask = l2).ne.n) call abort
|
||||
if (any (minloc (h(::2,::2), mask = l2(::2,::2)).ne.(/ 0, 0 /))) call abort
|
||||
if (minval (h(::2,::2), mask = l2(::2,::2)).ne.n) call abort
|
||||
a = 7.0
|
||||
b = 7.0
|
||||
c = 7.0
|
||||
d = 7.0
|
||||
end
|
||||
|
|
@ -0,0 +1,118 @@
|
|||
! { dg-do run }
|
||||
real :: a(3,3), b(3), nan, minf, pinf, h
|
||||
logical :: l, l2
|
||||
logical :: l3(3,3), l4(3,3), l5(3,3)
|
||||
|
||||
nan = 0.0
|
||||
minf = 0.0
|
||||
pinf = 0.0
|
||||
nan = 0.0/nan
|
||||
minf = -1.0/minf
|
||||
pinf = 1.0/pinf
|
||||
h = huge(h)
|
||||
l = .false.
|
||||
l2 = .true.
|
||||
l3 = .false.
|
||||
l4 = .true.
|
||||
l5 = .true.
|
||||
l5(1,1) = .false.
|
||||
l5(1,2) = .false.
|
||||
l5(2,3) = .false.
|
||||
a = reshape ((/ nan, nan, nan, pinf, pinf, pinf, pinf, minf, pinf /), (/ 3, 3 /))
|
||||
if (minval (a).ne.minf) call abort
|
||||
if (any (minloc (a).ne.(/ 2, 3 /))) call abort
|
||||
b = minval (a, dim = 1)
|
||||
if (.not.isnan(b(1))) call abort
|
||||
b(1) = 0.0
|
||||
if (any (b.ne.(/ 0.0, pinf, minf /))) call abort
|
||||
if (any (minloc (a, dim = 1).ne.(/ 1, 1, 2 /))) call abort
|
||||
b = minval (a, dim = 2)
|
||||
if (any (b.ne.(/ pinf, minf, pinf /))) call abort
|
||||
if (any (minloc (a, dim = 2).ne.(/ 2, 3, 2 /))) call abort
|
||||
if (minval (a, mask = l).ne.h) call abort
|
||||
if (any (minloc (a, mask = l).ne.(/ 0, 0 /))) call abort
|
||||
b = minval (a, dim = 1, mask = l)
|
||||
if (any (b.ne.(/ h, h, h /))) call abort
|
||||
if (any (minloc (a, dim = 1, mask = l).ne.(/ 0, 0, 0 /))) call abort
|
||||
b = minval (a, dim = 2, mask = l)
|
||||
if (any (b.ne.(/ h, h, h /))) call abort
|
||||
if (any (minloc (a, dim = 2, mask = l).ne.(/ 0, 0, 0 /))) call abort
|
||||
if (minval (a, mask = l3).ne.h) call abort
|
||||
if (any (minloc (a, mask = l3).ne.(/ 0, 0 /))) call abort
|
||||
b = minval (a, dim = 1, mask = l3)
|
||||
if (any (b.ne.(/ h, h, h /))) call abort
|
||||
if (any (minloc (a, dim = 1, mask = l3).ne.(/ 0, 0, 0 /))) call abort
|
||||
b = minval (a, dim = 2, mask = l3)
|
||||
if (any (b.ne.(/ h, h, h /))) call abort
|
||||
if (any (minloc (a, dim = 2, mask = l3).ne.(/ 0, 0, 0 /))) call abort
|
||||
if (minval (a, mask = l2).ne.minf) call abort
|
||||
if (minval (a, mask = l4).ne.minf) call abort
|
||||
if (any (minloc (a, mask = l2).ne.(/ 2, 3 /))) call abort
|
||||
if (any (minloc (a, mask = l4).ne.(/ 2, 3 /))) call abort
|
||||
b = minval (a, dim = 1, mask = l2)
|
||||
if (.not.isnan(b(1))) call abort
|
||||
b(1) = 0.0
|
||||
if (any (b.ne.(/ 0.0, pinf, minf /))) call abort
|
||||
if (any (minloc (a, dim = 1, mask = l2).ne.(/ 1, 1, 2 /))) call abort
|
||||
b = minval (a, dim = 2, mask = l2)
|
||||
if (any (b.ne.(/ pinf, minf, pinf /))) call abort
|
||||
if (any (minloc (a, dim = 2, mask = l2).ne.(/ 2, 3, 2 /))) call abort
|
||||
b = minval (a, dim = 1, mask = l4)
|
||||
if (.not.isnan(b(1))) call abort
|
||||
b(1) = 0.0
|
||||
if (any (b.ne.(/ 0.0, pinf, minf /))) call abort
|
||||
if (any (minloc (a, dim = 1, mask = l2).ne.(/ 1, 1, 2 /))) call abort
|
||||
b = minval (a, dim = 2, mask = l4)
|
||||
if (any (b.ne.(/ pinf, minf, pinf /))) call abort
|
||||
if (any (minloc (a, dim = 2, mask = l2).ne.(/ 2, 3, 2 /))) call abort
|
||||
if (minval (a, mask = l5).ne.pinf) call abort
|
||||
if (any (minloc (a, mask = l5).ne.(/ 2, 2 /))) call abort
|
||||
b = minval (a, dim = 1, mask = l5)
|
||||
if (.not.isnan(b(1))) call abort
|
||||
b(1) = 0.0
|
||||
if (any (b.ne.(/ 0.0, pinf, pinf /))) call abort
|
||||
if (any (minloc (a, dim = 1, mask = l5).ne.(/ 2, 2, 1 /))) call abort
|
||||
b = minval (a, dim = 2, mask = l5)
|
||||
if (any (b.ne.(/ pinf, pinf, pinf /))) call abort
|
||||
if (any (minloc (a, dim = 2, mask = l5).ne.(/ 3, 2, 2 /))) call abort
|
||||
a = nan
|
||||
if (.not.isnan(minval (a))) call abort
|
||||
if (minval (a, mask = l).ne.h) call abort
|
||||
if (.not.isnan(minval (a, mask = l2))) call abort
|
||||
if (minval (a, mask = l3).ne.h) call abort
|
||||
if (.not.isnan(minval (a, mask = l4))) call abort
|
||||
if (.not.isnan(minval (a, mask = l5))) call abort
|
||||
if (any (minloc (a).ne.(/ 1, 1 /))) call abort
|
||||
if (any (minloc (a, mask = l).ne.(/ 0, 0 /))) call abort
|
||||
if (any (minloc (a, mask = l2).ne.(/ 1, 1 /))) call abort
|
||||
if (any (minloc (a, mask = l3).ne.(/ 0, 0 /))) call abort
|
||||
if (any (minloc (a, mask = l4).ne.(/ 1, 1 /))) call abort
|
||||
if (any (minloc (a, mask = l5).ne.(/ 2, 1 /))) call abort
|
||||
a = pinf
|
||||
if (minval (a).ne.pinf) call abort
|
||||
if (minval (a, mask = l).ne.h) call abort
|
||||
if (minval (a, mask = l2).ne.pinf) call abort
|
||||
if (minval (a, mask = l3).ne.h) call abort
|
||||
if (minval (a, mask = l4).ne.pinf) call abort
|
||||
if (minval (a, mask = l5).ne.pinf) call abort
|
||||
if (any (minloc (a).ne.(/ 1, 1 /))) call abort
|
||||
if (any (minloc (a, mask = l).ne.(/ 0, 0 /))) call abort
|
||||
if (any (minloc (a, mask = l2).ne.(/ 1, 1 /))) call abort
|
||||
if (any (minloc (a, mask = l3).ne.(/ 0, 0 /))) call abort
|
||||
if (any (minloc (a, mask = l4).ne.(/ 1, 1 /))) call abort
|
||||
if (any (minloc (a, mask = l5).ne.(/ 2, 1 /))) call abort
|
||||
a = nan
|
||||
a(1,3) = pinf
|
||||
if (minval (a).ne.pinf) call abort
|
||||
if (minval (a, mask = l).ne.h) call abort
|
||||
if (minval (a, mask = l2).ne.pinf) call abort
|
||||
if (minval (a, mask = l3).ne.h) call abort
|
||||
if (minval (a, mask = l4).ne.pinf) call abort
|
||||
if (minval (a, mask = l5).ne.pinf) call abort
|
||||
if (any (minloc (a).ne.(/ 1, 3 /))) call abort
|
||||
if (any (minloc (a, mask = l).ne.(/ 0, 0 /))) call abort
|
||||
if (any (minloc (a, mask = l2).ne.(/ 1, 3 /))) call abort
|
||||
if (any (minloc (a, mask = l3).ne.(/ 0, 0 /))) call abort
|
||||
if (any (minloc (a, mask = l4).ne.(/ 1, 3 /))) call abort
|
||||
if (any (minloc (a, mask = l5).ne.(/ 1, 3 /))) call abort
|
||||
end
|
||||
|
|
@ -1,3 +1,177 @@
|
|||
2009-07-24 Jakub Jelinek <jakub@redhat.com>
|
||||
|
||||
PR fortran/40643
|
||||
PR fortran/31067
|
||||
* libgfortran.h (GFC_REAL_4_INFINITY, GFC_REAL_8_INFINITY,
|
||||
GFC_REAL_10_INFINITY, GFC_REAL_16_INFINITY, GFC_REAL_4_QUIET_NAN,
|
||||
GFC_REAL_8_QUIET_NAN, GFC_REAL_10_QUIET_NAN, GFC_REAL_16_QUIET_NAN):
|
||||
Define.
|
||||
* m4/iparm.m4 (atype_inf, atype_nan): Define.
|
||||
* m4/ifunction.m4: Formatting.
|
||||
* m4/iforeach.m4: Likewise.
|
||||
(START_FOREACH_FUNCTION): Initialize dest to all 1s, not all 0s.
|
||||
(START_FOREACH_BLOCK, FINISH_FOREACH_FUNCTION,
|
||||
FINISH_MASKED_FOREACH_FUNCTION): Run foreach block inside a loop
|
||||
until count[0] == extent[0].
|
||||
* m4/minval.m4: Formatting. Handle NaNs and infinities. Optimize.
|
||||
* m4/maxval.m4: Likewise.
|
||||
* m4/minloc0.m4: Likewise.
|
||||
* m4/maxloc0.m4: Likewise.
|
||||
* m4/minloc1.m4: Likewise.
|
||||
* m4/maxloc1.m4: Likewise.
|
||||
* generated/maxloc0_16_i16.c: Regenerated.
|
||||
* generated/maxloc0_16_i1.c: Likewise.
|
||||
* generated/maxloc0_16_i2.c: Likewise.
|
||||
* generated/maxloc0_16_i4.c: Likewise.
|
||||
* generated/maxloc0_16_i8.c: Likewise.
|
||||
* generated/maxloc0_16_r10.c: Likewise.
|
||||
* generated/maxloc0_16_r16.c: Likewise.
|
||||
* generated/maxloc0_16_r4.c: Likewise.
|
||||
* generated/maxloc0_16_r8.c: Likewise.
|
||||
* generated/maxloc0_4_i16.c: Likewise.
|
||||
* generated/maxloc0_4_i1.c: Likewise.
|
||||
* generated/maxloc0_4_i2.c: Likewise.
|
||||
* generated/maxloc0_4_i4.c: Likewise.
|
||||
* generated/maxloc0_4_i8.c: Likewise.
|
||||
* generated/maxloc0_4_r10.c: Likewise.
|
||||
* generated/maxloc0_4_r16.c: Likewise.
|
||||
* generated/maxloc0_4_r4.c: Likewise.
|
||||
* generated/maxloc0_4_r8.c: Likewise.
|
||||
* generated/maxloc0_8_i16.c: Likewise.
|
||||
* generated/maxloc0_8_i1.c: Likewise.
|
||||
* generated/maxloc0_8_i2.c: Likewise.
|
||||
* generated/maxloc0_8_i4.c: Likewise.
|
||||
* generated/maxloc0_8_i8.c: Likewise.
|
||||
* generated/maxloc0_8_r10.c: Likewise.
|
||||
* generated/maxloc0_8_r16.c: Likewise.
|
||||
* generated/maxloc0_8_r4.c: Likewise.
|
||||
* generated/maxloc0_8_r8.c: Likewise.
|
||||
* generated/maxloc1_16_i16.c: Likewise.
|
||||
* generated/maxloc1_16_i1.c: Likewise.
|
||||
* generated/maxloc1_16_i2.c: Likewise.
|
||||
* generated/maxloc1_16_i4.c: Likewise.
|
||||
* generated/maxloc1_16_i8.c: Likewise.
|
||||
* generated/maxloc1_16_r10.c: Likewise.
|
||||
* generated/maxloc1_16_r16.c: Likewise.
|
||||
* generated/maxloc1_16_r4.c: Likewise.
|
||||
* generated/maxloc1_16_r8.c: Likewise.
|
||||
* generated/maxloc1_4_i16.c: Likewise.
|
||||
* generated/maxloc1_4_i1.c: Likewise.
|
||||
* generated/maxloc1_4_i2.c: Likewise.
|
||||
* generated/maxloc1_4_i4.c: Likewise.
|
||||
* generated/maxloc1_4_i8.c: Likewise.
|
||||
* generated/maxloc1_4_r10.c: Likewise.
|
||||
* generated/maxloc1_4_r16.c: Likewise.
|
||||
* generated/maxloc1_4_r4.c: Likewise.
|
||||
* generated/maxloc1_4_r8.c: Likewise.
|
||||
* generated/maxloc1_8_i16.c: Likewise.
|
||||
* generated/maxloc1_8_i1.c: Likewise.
|
||||
* generated/maxloc1_8_i2.c: Likewise.
|
||||
* generated/maxloc1_8_i4.c: Likewise.
|
||||
* generated/maxloc1_8_i8.c: Likewise.
|
||||
* generated/maxloc1_8_r10.c: Likewise.
|
||||
* generated/maxloc1_8_r16.c: Likewise.
|
||||
* generated/maxloc1_8_r4.c: Likewise.
|
||||
* generated/maxloc1_8_r8.c: Likewise.
|
||||
* generated/maxval_i16.c: Likewise.
|
||||
* generated/maxval_i1.c: Likewise.
|
||||
* generated/maxval_i2.c: Likewise.
|
||||
* generated/maxval_i4.c: Likewise.
|
||||
* generated/maxval_i8.c: Likewise.
|
||||
* generated/maxval_r10.c: Likewise.
|
||||
* generated/maxval_r16.c: Likewise.
|
||||
* generated/maxval_r4.c: Likewise.
|
||||
* generated/maxval_r8.c: Likewise.
|
||||
* generated/minloc0_16_i16.c: Likewise.
|
||||
* generated/minloc0_16_i1.c: Likewise.
|
||||
* generated/minloc0_16_i2.c: Likewise.
|
||||
* generated/minloc0_16_i4.c: Likewise.
|
||||
* generated/minloc0_16_i8.c: Likewise.
|
||||
* generated/minloc0_16_r10.c: Likewise.
|
||||
* generated/minloc0_16_r16.c: Likewise.
|
||||
* generated/minloc0_16_r4.c: Likewise.
|
||||
* generated/minloc0_16_r8.c: Likewise.
|
||||
* generated/minloc0_4_i16.c: Likewise.
|
||||
* generated/minloc0_4_i1.c: Likewise.
|
||||
* generated/minloc0_4_i2.c: Likewise.
|
||||
* generated/minloc0_4_i4.c: Likewise.
|
||||
* generated/minloc0_4_i8.c: Likewise.
|
||||
* generated/minloc0_4_r10.c: Likewise.
|
||||
* generated/minloc0_4_r16.c: Likewise.
|
||||
* generated/minloc0_4_r4.c: Likewise.
|
||||
* generated/minloc0_4_r8.c: Likewise.
|
||||
* generated/minloc0_8_i16.c: Likewise.
|
||||
* generated/minloc0_8_i1.c: Likewise.
|
||||
* generated/minloc0_8_i2.c: Likewise.
|
||||
* generated/minloc0_8_i4.c: Likewise.
|
||||
* generated/minloc0_8_i8.c: Likewise.
|
||||
* generated/minloc0_8_r10.c: Likewise.
|
||||
* generated/minloc0_8_r16.c: Likewise.
|
||||
* generated/minloc0_8_r4.c: Likewise.
|
||||
* generated/minloc0_8_r8.c: Likewise.
|
||||
* generated/minloc1_16_i16.c: Likewise.
|
||||
* generated/minloc1_16_i1.c: Likewise.
|
||||
* generated/minloc1_16_i2.c: Likewise.
|
||||
* generated/minloc1_16_i4.c: Likewise.
|
||||
* generated/minloc1_16_i8.c: Likewise.
|
||||
* generated/minloc1_16_r10.c: Likewise.
|
||||
* generated/minloc1_16_r16.c: Likewise.
|
||||
* generated/minloc1_16_r4.c: Likewise.
|
||||
* generated/minloc1_16_r8.c: Likewise.
|
||||
* generated/minloc1_4_i16.c: Likewise.
|
||||
* generated/minloc1_4_i1.c: Likewise.
|
||||
* generated/minloc1_4_i2.c: Likewise.
|
||||
* generated/minloc1_4_i4.c: Likewise.
|
||||
* generated/minloc1_4_i8.c: Likewise.
|
||||
* generated/minloc1_4_r10.c: Likewise.
|
||||
* generated/minloc1_4_r16.c: Likewise.
|
||||
* generated/minloc1_4_r4.c: Likewise.
|
||||
* generated/minloc1_4_r8.c: Likewise.
|
||||
* generated/minloc1_8_i16.c: Likewise.
|
||||
* generated/minloc1_8_i1.c: Likewise.
|
||||
* generated/minloc1_8_i2.c: Likewise.
|
||||
* generated/minloc1_8_i4.c: Likewise.
|
||||
* generated/minloc1_8_i8.c: Likewise.
|
||||
* generated/minloc1_8_r10.c: Likewise.
|
||||
* generated/minloc1_8_r16.c: Likewise.
|
||||
* generated/minloc1_8_r4.c: Likewise.
|
||||
* generated/minloc1_8_r8.c: Likewise.
|
||||
* generated/minval_i16.c: Likewise.
|
||||
* generated/minval_i1.c: Likewise.
|
||||
* generated/minval_i2.c: Likewise.
|
||||
* generated/minval_i4.c: Likewise.
|
||||
* generated/minval_i8.c: Likewise.
|
||||
* generated/minval_r10.c: Likewise.
|
||||
* generated/minval_r16.c: Likewise.
|
||||
* generated/minval_r4.c: Likewise.
|
||||
* generated/minval_r8.c: Likewise.
|
||||
* generated/product_c10.c: Likewise.
|
||||
* generated/product_c16.c: Likewise.
|
||||
* generated/product_c4.c: Likewise.
|
||||
* generated/product_c8.c: Likewise.
|
||||
* generated/product_i16.c: Likewise.
|
||||
* generated/product_i1.c: Likewise.
|
||||
* generated/product_i2.c: Likewise.
|
||||
* generated/product_i4.c: Likewise.
|
||||
* generated/product_i8.c: Likewise.
|
||||
* generated/product_r10.c: Likewise.
|
||||
* generated/product_r16.c: Likewise.
|
||||
* generated/product_r4.c: Likewise.
|
||||
* generated/product_r8.c: Likewise.
|
||||
* generated/sum_c10.c: Likewise.
|
||||
* generated/sum_c16.c: Likewise.
|
||||
* generated/sum_c4.c: Likewise.
|
||||
* generated/sum_c8.c: Likewise.
|
||||
* generated/sum_i16.c: Likewise.
|
||||
* generated/sum_i1.c: Likewise.
|
||||
* generated/sum_i2.c: Likewise.
|
||||
* generated/sum_i4.c: Likewise.
|
||||
* generated/sum_i8.c: Likewise.
|
||||
* generated/sum_r10.c: Likewise.
|
||||
* generated/sum_r16.c: Likewise.
|
||||
* generated/sum_r4.c: Likewise.
|
||||
* generated/sum_r8.c: Likewise.
|
||||
|
||||
2009-07-22 Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||
|
||||
PR libfortran/32784
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_1 maxval;
|
||||
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
GFC_INTEGER_1 maxval;
|
||||
#if defined(GFC_INTEGER_1_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_1_INFINITY)
|
||||
maxval = -GFC_INTEGER_1_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_1_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_1 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
|
||||
#if defined(GFC_INTEGER_1_INFINITY)
|
||||
maxval = -GFC_INTEGER_1_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_1_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_16 maxval;
|
||||
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
GFC_INTEGER_16 maxval;
|
||||
#if defined(GFC_INTEGER_16_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_16_INFINITY)
|
||||
maxval = -GFC_INTEGER_16_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_16_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_16 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
|
||||
#if defined(GFC_INTEGER_16_INFINITY)
|
||||
maxval = -GFC_INTEGER_16_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_16_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_2 maxval;
|
||||
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
GFC_INTEGER_2 maxval;
|
||||
#if defined(GFC_INTEGER_2_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_2_INFINITY)
|
||||
maxval = -GFC_INTEGER_2_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_2_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_2 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
|
||||
#if defined(GFC_INTEGER_2_INFINITY)
|
||||
maxval = -GFC_INTEGER_2_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_2_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_4 maxval;
|
||||
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
GFC_INTEGER_4 maxval;
|
||||
#if defined(GFC_INTEGER_4_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_4_INFINITY)
|
||||
maxval = -GFC_INTEGER_4_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_4_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_4 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
|
||||
#if defined(GFC_INTEGER_4_INFINITY)
|
||||
maxval = -GFC_INTEGER_4_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_4_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_8 maxval;
|
||||
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
GFC_INTEGER_8 maxval;
|
||||
#if defined(GFC_INTEGER_8_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_8_INFINITY)
|
||||
maxval = -GFC_INTEGER_8_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_8_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_8 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
|
||||
#if defined(GFC_INTEGER_8_INFINITY)
|
||||
maxval = -GFC_INTEGER_8_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_8_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_REAL_10 maxval;
|
||||
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
GFC_REAL_10 maxval;
|
||||
#if defined(GFC_REAL_10_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_REAL_10_INFINITY)
|
||||
maxval = -GFC_REAL_10_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_REAL_10_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_REAL_10 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
|
||||
#if defined(GFC_REAL_10_INFINITY)
|
||||
maxval = -GFC_REAL_10_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_REAL_10_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_REAL_16 maxval;
|
||||
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
GFC_REAL_16 maxval;
|
||||
#if defined(GFC_REAL_16_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_REAL_16_INFINITY)
|
||||
maxval = -GFC_REAL_16_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_REAL_16_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_REAL_16 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
|
||||
#if defined(GFC_REAL_16_INFINITY)
|
||||
maxval = -GFC_REAL_16_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_REAL_16_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_REAL_4 maxval;
|
||||
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
GFC_REAL_4 maxval;
|
||||
#if defined(GFC_REAL_4_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_REAL_4_INFINITY)
|
||||
maxval = -GFC_REAL_4_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_REAL_4_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_REAL_4 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
|
||||
#if defined(GFC_REAL_4_INFINITY)
|
||||
maxval = -GFC_REAL_4_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_REAL_4_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_REAL_8 maxval;
|
||||
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
GFC_REAL_8 maxval;
|
||||
#if defined(GFC_REAL_8_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_REAL_8_INFINITY)
|
||||
maxval = -GFC_REAL_8_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_REAL_8_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_REAL_8 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
|
||||
#if defined(GFC_REAL_8_INFINITY)
|
||||
maxval = -GFC_REAL_8_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_REAL_8_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_1 maxval;
|
||||
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
GFC_INTEGER_1 maxval;
|
||||
#if defined(GFC_INTEGER_1_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_1_INFINITY)
|
||||
maxval = -GFC_INTEGER_1_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_1_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_1 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
|
||||
#if defined(GFC_INTEGER_1_INFINITY)
|
||||
maxval = -GFC_INTEGER_1_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_1_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_16 maxval;
|
||||
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
GFC_INTEGER_16 maxval;
|
||||
#if defined(GFC_INTEGER_16_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_16_INFINITY)
|
||||
maxval = -GFC_INTEGER_16_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_16_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_16 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
|
||||
#if defined(GFC_INTEGER_16_INFINITY)
|
||||
maxval = -GFC_INTEGER_16_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_16_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_2 maxval;
|
||||
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
GFC_INTEGER_2 maxval;
|
||||
#if defined(GFC_INTEGER_2_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_2_INFINITY)
|
||||
maxval = -GFC_INTEGER_2_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_2_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_2 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
|
||||
#if defined(GFC_INTEGER_2_INFINITY)
|
||||
maxval = -GFC_INTEGER_2_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_2_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_4 maxval;
|
||||
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
GFC_INTEGER_4 maxval;
|
||||
#if defined(GFC_INTEGER_4_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_4_INFINITY)
|
||||
maxval = -GFC_INTEGER_4_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_4_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_4 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
|
||||
#if defined(GFC_INTEGER_4_INFINITY)
|
||||
maxval = -GFC_INTEGER_4_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_4_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_8 maxval;
|
||||
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
GFC_INTEGER_8 maxval;
|
||||
#if defined(GFC_INTEGER_8_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_8_INFINITY)
|
||||
maxval = -GFC_INTEGER_8_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_8_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_8 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
|
||||
#if defined(GFC_INTEGER_8_INFINITY)
|
||||
maxval = -GFC_INTEGER_8_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_8_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_REAL_10 maxval;
|
||||
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
GFC_REAL_10 maxval;
|
||||
#if defined(GFC_REAL_10_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_REAL_10_INFINITY)
|
||||
maxval = -GFC_REAL_10_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_REAL_10_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_REAL_10 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
|
||||
#if defined(GFC_REAL_10_INFINITY)
|
||||
maxval = -GFC_REAL_10_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_REAL_10_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_REAL_16 maxval;
|
||||
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
GFC_REAL_16 maxval;
|
||||
#if defined(GFC_REAL_16_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_REAL_16_INFINITY)
|
||||
maxval = -GFC_REAL_16_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_REAL_16_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_REAL_16 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
|
||||
#if defined(GFC_REAL_16_INFINITY)
|
||||
maxval = -GFC_REAL_16_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_REAL_16_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_REAL_4 maxval;
|
||||
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
GFC_REAL_4 maxval;
|
||||
#if defined(GFC_REAL_4_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_REAL_4_INFINITY)
|
||||
maxval = -GFC_REAL_4_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_REAL_4_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_REAL_4 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
|
||||
#if defined(GFC_REAL_4_INFINITY)
|
||||
maxval = -GFC_REAL_4_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_REAL_4_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_REAL_8 maxval;
|
||||
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
GFC_REAL_8 maxval;
|
||||
#if defined(GFC_REAL_8_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_REAL_8_INFINITY)
|
||||
maxval = -GFC_REAL_8_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_REAL_8_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_REAL_8 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
|
||||
#if defined(GFC_REAL_8_INFINITY)
|
||||
maxval = -GFC_REAL_8_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_REAL_8_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_1 maxval;
|
||||
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
GFC_INTEGER_1 maxval;
|
||||
#if defined(GFC_INTEGER_1_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_1_INFINITY)
|
||||
maxval = -GFC_INTEGER_1_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_1_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_1 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
|
||||
#if defined(GFC_INTEGER_1_INFINITY)
|
||||
maxval = -GFC_INTEGER_1_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_1_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_16 maxval;
|
||||
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
GFC_INTEGER_16 maxval;
|
||||
#if defined(GFC_INTEGER_16_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_16_INFINITY)
|
||||
maxval = -GFC_INTEGER_16_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_16_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_16 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
|
||||
#if defined(GFC_INTEGER_16_INFINITY)
|
||||
maxval = -GFC_INTEGER_16_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_16_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_8_i2 (gfc_array_i8 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_8_i2 (gfc_array_i8 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_2 maxval;
|
||||
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
GFC_INTEGER_2 maxval;
|
||||
#if defined(GFC_INTEGER_2_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_2_INFINITY)
|
||||
maxval = -GFC_INTEGER_2_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_2_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_8_i2 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_2 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
|
||||
#if defined(GFC_INTEGER_2_INFINITY)
|
||||
maxval = -GFC_INTEGER_2_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_2_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_8_i4 (gfc_array_i8 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_8_i4 (gfc_array_i8 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_4 maxval;
|
||||
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
GFC_INTEGER_4 maxval;
|
||||
#if defined(GFC_INTEGER_4_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_4_INFINITY)
|
||||
maxval = -GFC_INTEGER_4_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_4_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_8_i4 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_4 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
|
||||
#if defined(GFC_INTEGER_4_INFINITY)
|
||||
maxval = -GFC_INTEGER_4_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_4_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_8_i8 (gfc_array_i8 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_8_i8 (gfc_array_i8 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_8 maxval;
|
||||
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
GFC_INTEGER_8 maxval;
|
||||
#if defined(GFC_INTEGER_8_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_8_INFINITY)
|
||||
maxval = -GFC_INTEGER_8_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_8_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_8_i8 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_8 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
|
||||
#if defined(GFC_INTEGER_8_INFINITY)
|
||||
maxval = -GFC_INTEGER_8_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_8_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_8_r10 (gfc_array_i8 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_8_r10 (gfc_array_i8 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_REAL_10 maxval;
|
||||
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
GFC_REAL_10 maxval;
|
||||
#if defined(GFC_REAL_10_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_REAL_10_INFINITY)
|
||||
maxval = -GFC_REAL_10_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_REAL_10_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_REAL_10 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
|
||||
#if defined(GFC_REAL_10_INFINITY)
|
||||
maxval = -GFC_REAL_10_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_REAL_10_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_8_r16 (gfc_array_i8 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_8_r16 (gfc_array_i8 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_REAL_16 maxval;
|
||||
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
GFC_REAL_16 maxval;
|
||||
#if defined(GFC_REAL_16_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_REAL_16_INFINITY)
|
||||
maxval = -GFC_REAL_16_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_REAL_16_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_8_r16 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_REAL_16 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
|
||||
#if defined(GFC_REAL_16_INFINITY)
|
||||
maxval = -GFC_REAL_16_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_REAL_16_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_8_r4 (gfc_array_i8 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_8_r4 (gfc_array_i8 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_REAL_4 maxval;
|
||||
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
GFC_REAL_4 maxval;
|
||||
#if defined(GFC_REAL_4_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_REAL_4_INFINITY)
|
||||
maxval = -GFC_REAL_4_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_REAL_4_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_8_r4 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_REAL_4 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
|
||||
#if defined(GFC_REAL_4_INFINITY)
|
||||
maxval = -GFC_REAL_4_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_REAL_4_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ maxloc0_8_r8 (gfc_array_i8 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MAXLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ maxloc0_8_r8 (gfc_array_i8 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_REAL_8 maxval;
|
||||
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
GFC_REAL_8 maxval;
|
||||
#if defined(GFC_REAL_8_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_REAL_8_INFINITY)
|
||||
maxval = -GFC_REAL_8_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base > maxval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_REAL_8_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base >= maxval)
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base > maxval)
|
||||
{
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mmaxloc0_8_r8 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_REAL_8 maxval;
|
||||
int fast = 0;
|
||||
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
|
||||
#if defined(GFC_REAL_8_INFINITY)
|
||||
maxval = -GFC_REAL_8_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base > maxval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_REAL_8_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base >= maxval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
maxval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_INTEGER_1 maxval;
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_1 maxval;
|
||||
#if defined (GFC_INTEGER_1_INFINITY)
|
||||
maxval = -GFC_INTEGER_1_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_1_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_INTEGER_1 maxval;
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_1 maxval;
|
||||
#if defined (GFC_INTEGER_1_INFINITY)
|
||||
maxval = -GFC_INTEGER_1_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
#endif
|
||||
#if defined (GFC_INTEGER_1_QUIET_NAN)
|
||||
GFC_INTEGER_16 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_INTEGER_1_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_16)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_1_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_INTEGER_16 maxval;
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_16 maxval;
|
||||
#if defined (GFC_INTEGER_16_INFINITY)
|
||||
maxval = -GFC_INTEGER_16_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_16_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_INTEGER_16 maxval;
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_16 maxval;
|
||||
#if defined (GFC_INTEGER_16_INFINITY)
|
||||
maxval = -GFC_INTEGER_16_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
#endif
|
||||
#if defined (GFC_INTEGER_16_QUIET_NAN)
|
||||
GFC_INTEGER_16 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_INTEGER_16_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_16)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_16_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_INTEGER_2 maxval;
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_2 maxval;
|
||||
#if defined (GFC_INTEGER_2_INFINITY)
|
||||
maxval = -GFC_INTEGER_2_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_2_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_INTEGER_2 maxval;
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_2 maxval;
|
||||
#if defined (GFC_INTEGER_2_INFINITY)
|
||||
maxval = -GFC_INTEGER_2_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
#endif
|
||||
#if defined (GFC_INTEGER_2_QUIET_NAN)
|
||||
GFC_INTEGER_16 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_INTEGER_2_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_16)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_2_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_INTEGER_4 maxval;
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_4 maxval;
|
||||
#if defined (GFC_INTEGER_4_INFINITY)
|
||||
maxval = -GFC_INTEGER_4_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_4_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_INTEGER_4 maxval;
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_4 maxval;
|
||||
#if defined (GFC_INTEGER_4_INFINITY)
|
||||
maxval = -GFC_INTEGER_4_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
#endif
|
||||
#if defined (GFC_INTEGER_4_QUIET_NAN)
|
||||
GFC_INTEGER_16 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_INTEGER_4_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_16)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_4_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_INTEGER_8 maxval;
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_8 maxval;
|
||||
#if defined (GFC_INTEGER_8_INFINITY)
|
||||
maxval = -GFC_INTEGER_8_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_8_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_INTEGER_8 maxval;
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_8 maxval;
|
||||
#if defined (GFC_INTEGER_8_INFINITY)
|
||||
maxval = -GFC_INTEGER_8_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
#endif
|
||||
#if defined (GFC_INTEGER_8_QUIET_NAN)
|
||||
GFC_INTEGER_16 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_INTEGER_8_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_16)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_8_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_REAL_10 maxval;
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_10 maxval;
|
||||
#if defined (GFC_REAL_10_INFINITY)
|
||||
maxval = -GFC_REAL_10_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_10_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_REAL_10 maxval;
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_10 maxval;
|
||||
#if defined (GFC_REAL_10_INFINITY)
|
||||
maxval = -GFC_REAL_10_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
#endif
|
||||
#if defined (GFC_REAL_10_QUIET_NAN)
|
||||
GFC_INTEGER_16 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_REAL_10_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_16)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_10_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_REAL_16 maxval;
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_16 maxval;
|
||||
#if defined (GFC_REAL_16_INFINITY)
|
||||
maxval = -GFC_REAL_16_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_16_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_REAL_16 maxval;
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_16 maxval;
|
||||
#if defined (GFC_REAL_16_INFINITY)
|
||||
maxval = -GFC_REAL_16_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
#endif
|
||||
#if defined (GFC_REAL_16_QUIET_NAN)
|
||||
GFC_INTEGER_16 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_REAL_16_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_16)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_16_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_REAL_4 maxval;
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_4 maxval;
|
||||
#if defined (GFC_REAL_4_INFINITY)
|
||||
maxval = -GFC_REAL_4_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_4_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_REAL_4 maxval;
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_4 maxval;
|
||||
#if defined (GFC_REAL_4_INFINITY)
|
||||
maxval = -GFC_REAL_4_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
#endif
|
||||
#if defined (GFC_REAL_4_QUIET_NAN)
|
||||
GFC_INTEGER_16 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_REAL_4_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_16)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_4_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_REAL_8 maxval;
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_8 maxval;
|
||||
#if defined (GFC_REAL_8_INFINITY)
|
||||
maxval = -GFC_REAL_8_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_8_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_REAL_8 maxval;
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_8 maxval;
|
||||
#if defined (GFC_REAL_8_INFINITY)
|
||||
maxval = -GFC_REAL_8_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
#endif
|
||||
#if defined (GFC_REAL_8_QUIET_NAN)
|
||||
GFC_INTEGER_16 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_REAL_8_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_16)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_8_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_16)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_INTEGER_1 maxval;
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_1 maxval;
|
||||
#if defined (GFC_INTEGER_1_INFINITY)
|
||||
maxval = -GFC_INTEGER_1_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_1_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_INTEGER_1 maxval;
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_1 maxval;
|
||||
#if defined (GFC_INTEGER_1_INFINITY)
|
||||
maxval = -GFC_INTEGER_1_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
#endif
|
||||
#if defined (GFC_INTEGER_1_QUIET_NAN)
|
||||
GFC_INTEGER_4 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_INTEGER_1_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_4)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_1_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_INTEGER_16 maxval;
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_16 maxval;
|
||||
#if defined (GFC_INTEGER_16_INFINITY)
|
||||
maxval = -GFC_INTEGER_16_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_16_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_INTEGER_16 maxval;
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_16 maxval;
|
||||
#if defined (GFC_INTEGER_16_INFINITY)
|
||||
maxval = -GFC_INTEGER_16_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
#endif
|
||||
#if defined (GFC_INTEGER_16_QUIET_NAN)
|
||||
GFC_INTEGER_4 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_INTEGER_16_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_4)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_16_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_INTEGER_2 maxval;
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_2 maxval;
|
||||
#if defined (GFC_INTEGER_2_INFINITY)
|
||||
maxval = -GFC_INTEGER_2_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_2_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_INTEGER_2 maxval;
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_2 maxval;
|
||||
#if defined (GFC_INTEGER_2_INFINITY)
|
||||
maxval = -GFC_INTEGER_2_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
#endif
|
||||
#if defined (GFC_INTEGER_2_QUIET_NAN)
|
||||
GFC_INTEGER_4 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_INTEGER_2_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_4)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_2_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_INTEGER_4 maxval;
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_4 maxval;
|
||||
#if defined (GFC_INTEGER_4_INFINITY)
|
||||
maxval = -GFC_INTEGER_4_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_4_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_INTEGER_4 maxval;
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_4 maxval;
|
||||
#if defined (GFC_INTEGER_4_INFINITY)
|
||||
maxval = -GFC_INTEGER_4_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
#endif
|
||||
#if defined (GFC_INTEGER_4_QUIET_NAN)
|
||||
GFC_INTEGER_4 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_INTEGER_4_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_4)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_4_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_INTEGER_8 maxval;
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_8 maxval;
|
||||
#if defined (GFC_INTEGER_8_INFINITY)
|
||||
maxval = -GFC_INTEGER_8_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_8_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_INTEGER_8 maxval;
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_8 maxval;
|
||||
#if defined (GFC_INTEGER_8_INFINITY)
|
||||
maxval = -GFC_INTEGER_8_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
#endif
|
||||
#if defined (GFC_INTEGER_8_QUIET_NAN)
|
||||
GFC_INTEGER_4 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_INTEGER_8_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_4)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_8_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_REAL_10 maxval;
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_10 maxval;
|
||||
#if defined (GFC_REAL_10_INFINITY)
|
||||
maxval = -GFC_REAL_10_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_10_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_REAL_10 maxval;
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_10 maxval;
|
||||
#if defined (GFC_REAL_10_INFINITY)
|
||||
maxval = -GFC_REAL_10_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
#endif
|
||||
#if defined (GFC_REAL_10_QUIET_NAN)
|
||||
GFC_INTEGER_4 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_REAL_10_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_4)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_10_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_REAL_16 maxval;
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_16 maxval;
|
||||
#if defined (GFC_REAL_16_INFINITY)
|
||||
maxval = -GFC_REAL_16_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_16_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_REAL_16 maxval;
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_16 maxval;
|
||||
#if defined (GFC_REAL_16_INFINITY)
|
||||
maxval = -GFC_REAL_16_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
#endif
|
||||
#if defined (GFC_REAL_16_QUIET_NAN)
|
||||
GFC_INTEGER_4 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_REAL_16_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_4)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_16_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_REAL_4 maxval;
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_4 maxval;
|
||||
#if defined (GFC_REAL_4_INFINITY)
|
||||
maxval = -GFC_REAL_4_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_4_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_REAL_4 maxval;
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_4 maxval;
|
||||
#if defined (GFC_REAL_4_INFINITY)
|
||||
maxval = -GFC_REAL_4_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
#endif
|
||||
#if defined (GFC_REAL_4_QUIET_NAN)
|
||||
GFC_INTEGER_4 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_REAL_4_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_4)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_4_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_REAL_8 maxval;
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_8 maxval;
|
||||
#if defined (GFC_REAL_8_INFINITY)
|
||||
maxval = -GFC_REAL_8_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_8_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_REAL_8 maxval;
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_8 maxval;
|
||||
#if defined (GFC_REAL_8_INFINITY)
|
||||
maxval = -GFC_REAL_8_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
#endif
|
||||
#if defined (GFC_REAL_8_QUIET_NAN)
|
||||
GFC_INTEGER_4 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_REAL_8_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_4)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_8_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_4)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_INTEGER_1 maxval;
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_1 maxval;
|
||||
#if defined (GFC_INTEGER_1_INFINITY)
|
||||
maxval = -GFC_INTEGER_1_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_1_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_INTEGER_1 maxval;
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_1 maxval;
|
||||
#if defined (GFC_INTEGER_1_INFINITY)
|
||||
maxval = -GFC_INTEGER_1_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_1_HUGE-1);
|
||||
#endif
|
||||
#if defined (GFC_INTEGER_1_QUIET_NAN)
|
||||
GFC_INTEGER_8 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_INTEGER_1_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_8)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_1_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_INTEGER_16 maxval;
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_16 maxval;
|
||||
#if defined (GFC_INTEGER_16_INFINITY)
|
||||
maxval = -GFC_INTEGER_16_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_16_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_INTEGER_16 maxval;
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_16 maxval;
|
||||
#if defined (GFC_INTEGER_16_INFINITY)
|
||||
maxval = -GFC_INTEGER_16_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_16_HUGE-1);
|
||||
#endif
|
||||
#if defined (GFC_INTEGER_16_QUIET_NAN)
|
||||
GFC_INTEGER_8 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_INTEGER_16_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_8)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_16_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_INTEGER_2 maxval;
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_2 maxval;
|
||||
#if defined (GFC_INTEGER_2_INFINITY)
|
||||
maxval = -GFC_INTEGER_2_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_2_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_INTEGER_2 maxval;
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_2 maxval;
|
||||
#if defined (GFC_INTEGER_2_INFINITY)
|
||||
maxval = -GFC_INTEGER_2_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_2_HUGE-1);
|
||||
#endif
|
||||
#if defined (GFC_INTEGER_2_QUIET_NAN)
|
||||
GFC_INTEGER_8 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_INTEGER_2_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_8)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_2_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_INTEGER_4 maxval;
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_4 maxval;
|
||||
#if defined (GFC_INTEGER_4_INFINITY)
|
||||
maxval = -GFC_INTEGER_4_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_4_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_INTEGER_4 maxval;
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_4 maxval;
|
||||
#if defined (GFC_INTEGER_4_INFINITY)
|
||||
maxval = -GFC_INTEGER_4_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_4_HUGE-1);
|
||||
#endif
|
||||
#if defined (GFC_INTEGER_4_QUIET_NAN)
|
||||
GFC_INTEGER_8 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_INTEGER_4_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_8)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_4_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_INTEGER_8 maxval;
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_8 maxval;
|
||||
#if defined (GFC_INTEGER_8_INFINITY)
|
||||
maxval = -GFC_INTEGER_8_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_8_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_INTEGER_8 maxval;
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_INTEGER_8 maxval;
|
||||
#if defined (GFC_INTEGER_8_INFINITY)
|
||||
maxval = -GFC_INTEGER_8_INFINITY;
|
||||
#else
|
||||
maxval = (-GFC_INTEGER_8_HUGE-1);
|
||||
#endif
|
||||
#if defined (GFC_INTEGER_8_QUIET_NAN)
|
||||
GFC_INTEGER_8 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_INTEGER_8_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_8)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_INTEGER_8_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_REAL_10 maxval;
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_10 maxval;
|
||||
#if defined (GFC_REAL_10_INFINITY)
|
||||
maxval = -GFC_REAL_10_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_10_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_REAL_10 maxval;
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_10 maxval;
|
||||
#if defined (GFC_REAL_10_INFINITY)
|
||||
maxval = -GFC_REAL_10_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_10_HUGE;
|
||||
#endif
|
||||
#if defined (GFC_REAL_10_QUIET_NAN)
|
||||
GFC_INTEGER_8 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_REAL_10_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_8)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_10_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_REAL_16 maxval;
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_16 maxval;
|
||||
#if defined (GFC_REAL_16_INFINITY)
|
||||
maxval = -GFC_REAL_16_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_16_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_REAL_16 maxval;
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_16 maxval;
|
||||
#if defined (GFC_REAL_16_INFINITY)
|
||||
maxval = -GFC_REAL_16_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_16_HUGE;
|
||||
#endif
|
||||
#if defined (GFC_REAL_16_QUIET_NAN)
|
||||
GFC_INTEGER_8 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_REAL_16_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_8)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_16_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_REAL_4 maxval;
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_4 maxval;
|
||||
#if defined (GFC_REAL_4_INFINITY)
|
||||
maxval = -GFC_REAL_4_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_4_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_REAL_4 maxval;
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_4 maxval;
|
||||
#if defined (GFC_REAL_4_INFINITY)
|
||||
maxval = -GFC_REAL_4_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_4_HUGE;
|
||||
#endif
|
||||
#if defined (GFC_REAL_4_QUIET_NAN)
|
||||
GFC_INTEGER_8 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_REAL_4_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_8)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_4_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -85,15 +85,15 @@ maxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -129,7 +129,7 @@ maxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -143,22 +143,37 @@ maxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
GFC_REAL_8 maxval;
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_8 maxval;
|
||||
#if defined (GFC_REAL_8_INFINITY)
|
||||
maxval = -GFC_REAL_8_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
#endif
|
||||
result = 1;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > maxval || !result)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_8_QUIET_NAN)
|
||||
if (*src >= maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -168,28 +183,28 @@ maxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -269,15 +284,15 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -314,7 +329,7 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -329,22 +344,50 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
GFC_REAL_8 maxval;
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
GFC_REAL_8 maxval;
|
||||
#if defined (GFC_REAL_8_INFINITY)
|
||||
maxval = -GFC_REAL_8_INFINITY;
|
||||
#else
|
||||
maxval = -GFC_REAL_8_HUGE;
|
||||
#endif
|
||||
#if defined (GFC_REAL_8_QUIET_NAN)
|
||||
GFC_INTEGER_8 result2 = 0;
|
||||
#endif
|
||||
result = 0;
|
||||
if (len <= 0)
|
||||
*dest = 0;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && (*src > maxval || !result))
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_REAL_8_QUIET_NAN)
|
||||
if (!result2)
|
||||
result2 = (GFC_INTEGER_8)n + 1;
|
||||
if (*src >= maxval)
|
||||
#endif
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
#if defined (GFC_REAL_8_QUIET_NAN)
|
||||
if (unlikely (n >= len))
|
||||
result = result2;
|
||||
else
|
||||
#endif
|
||||
for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
if (*msrc && *src > maxval)
|
||||
{
|
||||
maxval = *src;
|
||||
result = (GFC_INTEGER_8)n + 1;
|
||||
}
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,30 +398,30 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,10 +469,10 @@ smaxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -437,15 +480,15 @@ smaxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -501,21 +544,21 @@ smaxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -84,15 +84,15 @@ maxval_i1 (gfc_array_i1 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -128,7 +128,7 @@ maxval_i1 (gfc_array_i1 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -142,17 +142,30 @@ maxval_i1 (gfc_array_i1 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
result = (-GFC_INTEGER_1_HUGE-1);
|
||||
if (len <= 0)
|
||||
#if defined (GFC_INTEGER_1_INFINITY)
|
||||
result = -GFC_INTEGER_1_INFINITY;
|
||||
#else
|
||||
result = (-GFC_INTEGER_1_HUGE-1);
|
||||
#endif
|
||||
if (len <= 0)
|
||||
*dest = (-GFC_INTEGER_1_HUGE-1);
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > result)
|
||||
result = *src;
|
||||
}
|
||||
#if defined (GFC_INTEGER_1_QUIET_NAN)
|
||||
if (*src >= result)
|
||||
break;
|
||||
}
|
||||
if (unlikely (n >= len))
|
||||
result = GFC_INTEGER_1_QUIET_NAN;
|
||||
else for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > result)
|
||||
result = *src;
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -162,28 +175,28 @@ maxval_i1 (gfc_array_i1 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -263,15 +276,15 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -308,7 +321,7 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -323,17 +336,45 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
result = (-GFC_INTEGER_1_HUGE-1);
|
||||
if (len <= 0)
|
||||
#if defined (GFC_INTEGER_1_INFINITY)
|
||||
result = -GFC_INTEGER_1_INFINITY;
|
||||
#else
|
||||
result = (-GFC_INTEGER_1_HUGE-1);
|
||||
#endif
|
||||
#if defined (GFC_INTEGER_1_QUIET_NAN)
|
||||
int non_empty_p = 0;
|
||||
#endif
|
||||
if (len <= 0)
|
||||
*dest = (-GFC_INTEGER_1_HUGE-1);
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && *src > result)
|
||||
result = *src;
|
||||
}
|
||||
#if defined (GFC_INTEGER_1_INFINITY) || defined (GFC_INTEGER_1_QUIET_NAN)
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_INTEGER_1_QUIET_NAN)
|
||||
non_empty_p = 1;
|
||||
if (*src >= result)
|
||||
#endif
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (unlikely (n >= len))
|
||||
{
|
||||
#if defined (GFC_INTEGER_1_QUIET_NAN)
|
||||
result = non_empty_p ? GFC_INTEGER_1_QUIET_NAN : (-GFC_INTEGER_1_HUGE-1);
|
||||
#else
|
||||
result = (-GFC_INTEGER_1_HUGE-1);
|
||||
#endif
|
||||
}
|
||||
else for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
#endif
|
||||
if (*msrc && *src > result)
|
||||
result = *src;
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -344,30 +385,30 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -415,10 +456,10 @@ smaxval_i1 (gfc_array_i1 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -426,15 +467,15 @@ smaxval_i1 (gfc_array_i1 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -490,21 +531,21 @@ smaxval_i1 (gfc_array_i1 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -84,15 +84,15 @@ maxval_i16 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -128,7 +128,7 @@ maxval_i16 (gfc_array_i16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -142,17 +142,30 @@ maxval_i16 (gfc_array_i16 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
result = (-GFC_INTEGER_16_HUGE-1);
|
||||
if (len <= 0)
|
||||
#if defined (GFC_INTEGER_16_INFINITY)
|
||||
result = -GFC_INTEGER_16_INFINITY;
|
||||
#else
|
||||
result = (-GFC_INTEGER_16_HUGE-1);
|
||||
#endif
|
||||
if (len <= 0)
|
||||
*dest = (-GFC_INTEGER_16_HUGE-1);
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > result)
|
||||
result = *src;
|
||||
}
|
||||
#if defined (GFC_INTEGER_16_QUIET_NAN)
|
||||
if (*src >= result)
|
||||
break;
|
||||
}
|
||||
if (unlikely (n >= len))
|
||||
result = GFC_INTEGER_16_QUIET_NAN;
|
||||
else for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > result)
|
||||
result = *src;
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -162,28 +175,28 @@ maxval_i16 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -263,15 +276,15 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -308,7 +321,7 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -323,17 +336,45 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
result = (-GFC_INTEGER_16_HUGE-1);
|
||||
if (len <= 0)
|
||||
#if defined (GFC_INTEGER_16_INFINITY)
|
||||
result = -GFC_INTEGER_16_INFINITY;
|
||||
#else
|
||||
result = (-GFC_INTEGER_16_HUGE-1);
|
||||
#endif
|
||||
#if defined (GFC_INTEGER_16_QUIET_NAN)
|
||||
int non_empty_p = 0;
|
||||
#endif
|
||||
if (len <= 0)
|
||||
*dest = (-GFC_INTEGER_16_HUGE-1);
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && *src > result)
|
||||
result = *src;
|
||||
}
|
||||
#if defined (GFC_INTEGER_16_INFINITY) || defined (GFC_INTEGER_16_QUIET_NAN)
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_INTEGER_16_QUIET_NAN)
|
||||
non_empty_p = 1;
|
||||
if (*src >= result)
|
||||
#endif
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (unlikely (n >= len))
|
||||
{
|
||||
#if defined (GFC_INTEGER_16_QUIET_NAN)
|
||||
result = non_empty_p ? GFC_INTEGER_16_QUIET_NAN : (-GFC_INTEGER_16_HUGE-1);
|
||||
#else
|
||||
result = (-GFC_INTEGER_16_HUGE-1);
|
||||
#endif
|
||||
}
|
||||
else for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
#endif
|
||||
if (*msrc && *src > result)
|
||||
result = *src;
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -344,30 +385,30 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -415,10 +456,10 @@ smaxval_i16 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -426,15 +467,15 @@ smaxval_i16 (gfc_array_i16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -490,21 +531,21 @@ smaxval_i16 (gfc_array_i16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -84,15 +84,15 @@ maxval_i2 (gfc_array_i2 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -128,7 +128,7 @@ maxval_i2 (gfc_array_i2 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -142,17 +142,30 @@ maxval_i2 (gfc_array_i2 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
result = (-GFC_INTEGER_2_HUGE-1);
|
||||
if (len <= 0)
|
||||
#if defined (GFC_INTEGER_2_INFINITY)
|
||||
result = -GFC_INTEGER_2_INFINITY;
|
||||
#else
|
||||
result = (-GFC_INTEGER_2_HUGE-1);
|
||||
#endif
|
||||
if (len <= 0)
|
||||
*dest = (-GFC_INTEGER_2_HUGE-1);
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > result)
|
||||
result = *src;
|
||||
}
|
||||
#if defined (GFC_INTEGER_2_QUIET_NAN)
|
||||
if (*src >= result)
|
||||
break;
|
||||
}
|
||||
if (unlikely (n >= len))
|
||||
result = GFC_INTEGER_2_QUIET_NAN;
|
||||
else for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > result)
|
||||
result = *src;
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -162,28 +175,28 @@ maxval_i2 (gfc_array_i2 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -263,15 +276,15 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -308,7 +321,7 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -323,17 +336,45 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
result = (-GFC_INTEGER_2_HUGE-1);
|
||||
if (len <= 0)
|
||||
#if defined (GFC_INTEGER_2_INFINITY)
|
||||
result = -GFC_INTEGER_2_INFINITY;
|
||||
#else
|
||||
result = (-GFC_INTEGER_2_HUGE-1);
|
||||
#endif
|
||||
#if defined (GFC_INTEGER_2_QUIET_NAN)
|
||||
int non_empty_p = 0;
|
||||
#endif
|
||||
if (len <= 0)
|
||||
*dest = (-GFC_INTEGER_2_HUGE-1);
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && *src > result)
|
||||
result = *src;
|
||||
}
|
||||
#if defined (GFC_INTEGER_2_INFINITY) || defined (GFC_INTEGER_2_QUIET_NAN)
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_INTEGER_2_QUIET_NAN)
|
||||
non_empty_p = 1;
|
||||
if (*src >= result)
|
||||
#endif
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (unlikely (n >= len))
|
||||
{
|
||||
#if defined (GFC_INTEGER_2_QUIET_NAN)
|
||||
result = non_empty_p ? GFC_INTEGER_2_QUIET_NAN : (-GFC_INTEGER_2_HUGE-1);
|
||||
#else
|
||||
result = (-GFC_INTEGER_2_HUGE-1);
|
||||
#endif
|
||||
}
|
||||
else for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
#endif
|
||||
if (*msrc && *src > result)
|
||||
result = *src;
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -344,30 +385,30 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -415,10 +456,10 @@ smaxval_i2 (gfc_array_i2 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -426,15 +467,15 @@ smaxval_i2 (gfc_array_i2 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -490,21 +531,21 @@ smaxval_i2 (gfc_array_i2 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -84,15 +84,15 @@ maxval_i4 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -128,7 +128,7 @@ maxval_i4 (gfc_array_i4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -142,17 +142,30 @@ maxval_i4 (gfc_array_i4 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
result = (-GFC_INTEGER_4_HUGE-1);
|
||||
if (len <= 0)
|
||||
#if defined (GFC_INTEGER_4_INFINITY)
|
||||
result = -GFC_INTEGER_4_INFINITY;
|
||||
#else
|
||||
result = (-GFC_INTEGER_4_HUGE-1);
|
||||
#endif
|
||||
if (len <= 0)
|
||||
*dest = (-GFC_INTEGER_4_HUGE-1);
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > result)
|
||||
result = *src;
|
||||
}
|
||||
#if defined (GFC_INTEGER_4_QUIET_NAN)
|
||||
if (*src >= result)
|
||||
break;
|
||||
}
|
||||
if (unlikely (n >= len))
|
||||
result = GFC_INTEGER_4_QUIET_NAN;
|
||||
else for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > result)
|
||||
result = *src;
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -162,28 +175,28 @@ maxval_i4 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -263,15 +276,15 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -308,7 +321,7 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -323,17 +336,45 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
result = (-GFC_INTEGER_4_HUGE-1);
|
||||
if (len <= 0)
|
||||
#if defined (GFC_INTEGER_4_INFINITY)
|
||||
result = -GFC_INTEGER_4_INFINITY;
|
||||
#else
|
||||
result = (-GFC_INTEGER_4_HUGE-1);
|
||||
#endif
|
||||
#if defined (GFC_INTEGER_4_QUIET_NAN)
|
||||
int non_empty_p = 0;
|
||||
#endif
|
||||
if (len <= 0)
|
||||
*dest = (-GFC_INTEGER_4_HUGE-1);
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && *src > result)
|
||||
result = *src;
|
||||
}
|
||||
#if defined (GFC_INTEGER_4_INFINITY) || defined (GFC_INTEGER_4_QUIET_NAN)
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_INTEGER_4_QUIET_NAN)
|
||||
non_empty_p = 1;
|
||||
if (*src >= result)
|
||||
#endif
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (unlikely (n >= len))
|
||||
{
|
||||
#if defined (GFC_INTEGER_4_QUIET_NAN)
|
||||
result = non_empty_p ? GFC_INTEGER_4_QUIET_NAN : (-GFC_INTEGER_4_HUGE-1);
|
||||
#else
|
||||
result = (-GFC_INTEGER_4_HUGE-1);
|
||||
#endif
|
||||
}
|
||||
else for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
#endif
|
||||
if (*msrc && *src > result)
|
||||
result = *src;
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -344,30 +385,30 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -415,10 +456,10 @@ smaxval_i4 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -426,15 +467,15 @@ smaxval_i4 (gfc_array_i4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -490,21 +531,21 @@ smaxval_i4 (gfc_array_i4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -84,15 +84,15 @@ maxval_i8 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -128,7 +128,7 @@ maxval_i8 (gfc_array_i8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -142,17 +142,30 @@ maxval_i8 (gfc_array_i8 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
result = (-GFC_INTEGER_8_HUGE-1);
|
||||
if (len <= 0)
|
||||
#if defined (GFC_INTEGER_8_INFINITY)
|
||||
result = -GFC_INTEGER_8_INFINITY;
|
||||
#else
|
||||
result = (-GFC_INTEGER_8_HUGE-1);
|
||||
#endif
|
||||
if (len <= 0)
|
||||
*dest = (-GFC_INTEGER_8_HUGE-1);
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > result)
|
||||
result = *src;
|
||||
}
|
||||
#if defined (GFC_INTEGER_8_QUIET_NAN)
|
||||
if (*src >= result)
|
||||
break;
|
||||
}
|
||||
if (unlikely (n >= len))
|
||||
result = GFC_INTEGER_8_QUIET_NAN;
|
||||
else for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > result)
|
||||
result = *src;
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -162,28 +175,28 @@ maxval_i8 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -263,15 +276,15 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -308,7 +321,7 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -323,17 +336,45 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
result = (-GFC_INTEGER_8_HUGE-1);
|
||||
if (len <= 0)
|
||||
#if defined (GFC_INTEGER_8_INFINITY)
|
||||
result = -GFC_INTEGER_8_INFINITY;
|
||||
#else
|
||||
result = (-GFC_INTEGER_8_HUGE-1);
|
||||
#endif
|
||||
#if defined (GFC_INTEGER_8_QUIET_NAN)
|
||||
int non_empty_p = 0;
|
||||
#endif
|
||||
if (len <= 0)
|
||||
*dest = (-GFC_INTEGER_8_HUGE-1);
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && *src > result)
|
||||
result = *src;
|
||||
}
|
||||
#if defined (GFC_INTEGER_8_INFINITY) || defined (GFC_INTEGER_8_QUIET_NAN)
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_INTEGER_8_QUIET_NAN)
|
||||
non_empty_p = 1;
|
||||
if (*src >= result)
|
||||
#endif
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (unlikely (n >= len))
|
||||
{
|
||||
#if defined (GFC_INTEGER_8_QUIET_NAN)
|
||||
result = non_empty_p ? GFC_INTEGER_8_QUIET_NAN : (-GFC_INTEGER_8_HUGE-1);
|
||||
#else
|
||||
result = (-GFC_INTEGER_8_HUGE-1);
|
||||
#endif
|
||||
}
|
||||
else for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
#endif
|
||||
if (*msrc && *src > result)
|
||||
result = *src;
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -344,30 +385,30 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -415,10 +456,10 @@ smaxval_i8 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -426,15 +467,15 @@ smaxval_i8 (gfc_array_i8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -490,21 +531,21 @@ smaxval_i8 (gfc_array_i8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -84,15 +84,15 @@ maxval_r10 (gfc_array_r10 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -128,7 +128,7 @@ maxval_r10 (gfc_array_r10 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -142,17 +142,30 @@ maxval_r10 (gfc_array_r10 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
result = -GFC_REAL_10_HUGE;
|
||||
if (len <= 0)
|
||||
#if defined (GFC_REAL_10_INFINITY)
|
||||
result = -GFC_REAL_10_INFINITY;
|
||||
#else
|
||||
result = -GFC_REAL_10_HUGE;
|
||||
#endif
|
||||
if (len <= 0)
|
||||
*dest = -GFC_REAL_10_HUGE;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > result)
|
||||
result = *src;
|
||||
}
|
||||
#if defined (GFC_REAL_10_QUIET_NAN)
|
||||
if (*src >= result)
|
||||
break;
|
||||
}
|
||||
if (unlikely (n >= len))
|
||||
result = GFC_REAL_10_QUIET_NAN;
|
||||
else for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > result)
|
||||
result = *src;
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -162,28 +175,28 @@ maxval_r10 (gfc_array_r10 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -263,15 +276,15 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -308,7 +321,7 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -323,17 +336,45 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
result = -GFC_REAL_10_HUGE;
|
||||
if (len <= 0)
|
||||
#if defined (GFC_REAL_10_INFINITY)
|
||||
result = -GFC_REAL_10_INFINITY;
|
||||
#else
|
||||
result = -GFC_REAL_10_HUGE;
|
||||
#endif
|
||||
#if defined (GFC_REAL_10_QUIET_NAN)
|
||||
int non_empty_p = 0;
|
||||
#endif
|
||||
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;
|
||||
}
|
||||
#if defined (GFC_REAL_10_INFINITY) || defined (GFC_REAL_10_QUIET_NAN)
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_REAL_10_QUIET_NAN)
|
||||
non_empty_p = 1;
|
||||
if (*src >= result)
|
||||
#endif
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (unlikely (n >= len))
|
||||
{
|
||||
#if defined (GFC_REAL_10_QUIET_NAN)
|
||||
result = non_empty_p ? GFC_REAL_10_QUIET_NAN : -GFC_REAL_10_HUGE;
|
||||
#else
|
||||
result = -GFC_REAL_10_HUGE;
|
||||
#endif
|
||||
}
|
||||
else for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
#endif
|
||||
if (*msrc && *src > result)
|
||||
result = *src;
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -344,30 +385,30 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -415,10 +456,10 @@ smaxval_r10 (gfc_array_r10 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -426,15 +467,15 @@ smaxval_r10 (gfc_array_r10 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -490,21 +531,21 @@ smaxval_r10 (gfc_array_r10 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -84,15 +84,15 @@ maxval_r16 (gfc_array_r16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -128,7 +128,7 @@ maxval_r16 (gfc_array_r16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -142,17 +142,30 @@ maxval_r16 (gfc_array_r16 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
result = -GFC_REAL_16_HUGE;
|
||||
if (len <= 0)
|
||||
#if defined (GFC_REAL_16_INFINITY)
|
||||
result = -GFC_REAL_16_INFINITY;
|
||||
#else
|
||||
result = -GFC_REAL_16_HUGE;
|
||||
#endif
|
||||
if (len <= 0)
|
||||
*dest = -GFC_REAL_16_HUGE;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > result)
|
||||
result = *src;
|
||||
}
|
||||
#if defined (GFC_REAL_16_QUIET_NAN)
|
||||
if (*src >= result)
|
||||
break;
|
||||
}
|
||||
if (unlikely (n >= len))
|
||||
result = GFC_REAL_16_QUIET_NAN;
|
||||
else for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > result)
|
||||
result = *src;
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -162,28 +175,28 @@ maxval_r16 (gfc_array_r16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -263,15 +276,15 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -308,7 +321,7 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -323,17 +336,45 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
result = -GFC_REAL_16_HUGE;
|
||||
if (len <= 0)
|
||||
#if defined (GFC_REAL_16_INFINITY)
|
||||
result = -GFC_REAL_16_INFINITY;
|
||||
#else
|
||||
result = -GFC_REAL_16_HUGE;
|
||||
#endif
|
||||
#if defined (GFC_REAL_16_QUIET_NAN)
|
||||
int non_empty_p = 0;
|
||||
#endif
|
||||
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;
|
||||
}
|
||||
#if defined (GFC_REAL_16_INFINITY) || defined (GFC_REAL_16_QUIET_NAN)
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_REAL_16_QUIET_NAN)
|
||||
non_empty_p = 1;
|
||||
if (*src >= result)
|
||||
#endif
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (unlikely (n >= len))
|
||||
{
|
||||
#if defined (GFC_REAL_16_QUIET_NAN)
|
||||
result = non_empty_p ? GFC_REAL_16_QUIET_NAN : -GFC_REAL_16_HUGE;
|
||||
#else
|
||||
result = -GFC_REAL_16_HUGE;
|
||||
#endif
|
||||
}
|
||||
else for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
#endif
|
||||
if (*msrc && *src > result)
|
||||
result = *src;
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -344,30 +385,30 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -415,10 +456,10 @@ smaxval_r16 (gfc_array_r16 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -426,15 +467,15 @@ smaxval_r16 (gfc_array_r16 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -490,21 +531,21 @@ smaxval_r16 (gfc_array_r16 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -84,15 +84,15 @@ maxval_r4 (gfc_array_r4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -128,7 +128,7 @@ maxval_r4 (gfc_array_r4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -142,17 +142,30 @@ maxval_r4 (gfc_array_r4 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
result = -GFC_REAL_4_HUGE;
|
||||
if (len <= 0)
|
||||
#if defined (GFC_REAL_4_INFINITY)
|
||||
result = -GFC_REAL_4_INFINITY;
|
||||
#else
|
||||
result = -GFC_REAL_4_HUGE;
|
||||
#endif
|
||||
if (len <= 0)
|
||||
*dest = -GFC_REAL_4_HUGE;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > result)
|
||||
result = *src;
|
||||
}
|
||||
#if defined (GFC_REAL_4_QUIET_NAN)
|
||||
if (*src >= result)
|
||||
break;
|
||||
}
|
||||
if (unlikely (n >= len))
|
||||
result = GFC_REAL_4_QUIET_NAN;
|
||||
else for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > result)
|
||||
result = *src;
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -162,28 +175,28 @@ maxval_r4 (gfc_array_r4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -263,15 +276,15 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -308,7 +321,7 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -323,17 +336,45 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
result = -GFC_REAL_4_HUGE;
|
||||
if (len <= 0)
|
||||
#if defined (GFC_REAL_4_INFINITY)
|
||||
result = -GFC_REAL_4_INFINITY;
|
||||
#else
|
||||
result = -GFC_REAL_4_HUGE;
|
||||
#endif
|
||||
#if defined (GFC_REAL_4_QUIET_NAN)
|
||||
int non_empty_p = 0;
|
||||
#endif
|
||||
if (len <= 0)
|
||||
*dest = -GFC_REAL_4_HUGE;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && *src > result)
|
||||
result = *src;
|
||||
}
|
||||
#if defined (GFC_REAL_4_INFINITY) || defined (GFC_REAL_4_QUIET_NAN)
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_REAL_4_QUIET_NAN)
|
||||
non_empty_p = 1;
|
||||
if (*src >= result)
|
||||
#endif
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (unlikely (n >= len))
|
||||
{
|
||||
#if defined (GFC_REAL_4_QUIET_NAN)
|
||||
result = non_empty_p ? GFC_REAL_4_QUIET_NAN : -GFC_REAL_4_HUGE;
|
||||
#else
|
||||
result = -GFC_REAL_4_HUGE;
|
||||
#endif
|
||||
}
|
||||
else for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
#endif
|
||||
if (*msrc && *src > result)
|
||||
result = *src;
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -344,30 +385,30 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -415,10 +456,10 @@ smaxval_r4 (gfc_array_r4 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -426,15 +467,15 @@ smaxval_r4 (gfc_array_r4 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -490,21 +531,21 @@ smaxval_r4 (gfc_array_r4 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -84,15 +84,15 @@ maxval_r8 (gfc_array_r8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -128,7 +128,7 @@ maxval_r8 (gfc_array_r8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
len = 0;
|
||||
len = 0;
|
||||
}
|
||||
|
||||
base = array->data;
|
||||
|
|
@ -142,17 +142,30 @@ maxval_r8 (gfc_array_r8 * const restrict retarray,
|
|||
src = base;
|
||||
{
|
||||
|
||||
result = -GFC_REAL_8_HUGE;
|
||||
if (len <= 0)
|
||||
#if defined (GFC_REAL_8_INFINITY)
|
||||
result = -GFC_REAL_8_INFINITY;
|
||||
#else
|
||||
result = -GFC_REAL_8_HUGE;
|
||||
#endif
|
||||
if (len <= 0)
|
||||
*dest = -GFC_REAL_8_HUGE;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta)
|
||||
{
|
||||
|
||||
if (*src > result)
|
||||
result = *src;
|
||||
}
|
||||
#if defined (GFC_REAL_8_QUIET_NAN)
|
||||
if (*src >= result)
|
||||
break;
|
||||
}
|
||||
if (unlikely (n >= len))
|
||||
result = GFC_REAL_8_QUIET_NAN;
|
||||
else for (; n < len; n++, src += delta)
|
||||
{
|
||||
#endif
|
||||
if (*src > result)
|
||||
result = *src;
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -162,28 +175,28 @@ maxval_r8 (gfc_array_r8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
{
|
||||
/* 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 probably not worth it. */
|
||||
base -= sstride[n] * extent[n];
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
{
|
||||
/* Break out of the look. */
|
||||
continue_loop = 0;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
base += sstride[n];
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -263,15 +276,15 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
|
||||
* extent[rank-1];
|
||||
|
|
@ -308,7 +321,7 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray,
|
|||
count[n] = 0;
|
||||
dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
|
||||
if (extent[n] <= 0)
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
dest = retarray->data;
|
||||
|
|
@ -323,17 +336,45 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray,
|
|||
msrc = mbase;
|
||||
{
|
||||
|
||||
result = -GFC_REAL_8_HUGE;
|
||||
if (len <= 0)
|
||||
#if defined (GFC_REAL_8_INFINITY)
|
||||
result = -GFC_REAL_8_INFINITY;
|
||||
#else
|
||||
result = -GFC_REAL_8_HUGE;
|
||||
#endif
|
||||
#if defined (GFC_REAL_8_QUIET_NAN)
|
||||
int non_empty_p = 0;
|
||||
#endif
|
||||
if (len <= 0)
|
||||
*dest = -GFC_REAL_8_HUGE;
|
||||
else
|
||||
{
|
||||
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
|
||||
if (*msrc && *src > result)
|
||||
result = *src;
|
||||
}
|
||||
#if defined (GFC_REAL_8_INFINITY) || defined (GFC_REAL_8_QUIET_NAN)
|
||||
if (*msrc)
|
||||
{
|
||||
#if defined (GFC_REAL_8_QUIET_NAN)
|
||||
non_empty_p = 1;
|
||||
if (*src >= result)
|
||||
#endif
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (unlikely (n >= len))
|
||||
{
|
||||
#if defined (GFC_REAL_8_QUIET_NAN)
|
||||
result = non_empty_p ? GFC_REAL_8_QUIET_NAN : -GFC_REAL_8_HUGE;
|
||||
#else
|
||||
result = -GFC_REAL_8_HUGE;
|
||||
#endif
|
||||
}
|
||||
else for (; n < len; n++, src += delta, msrc += mdelta)
|
||||
{
|
||||
#endif
|
||||
if (*msrc && *src > result)
|
||||
result = *src;
|
||||
}
|
||||
*dest = result;
|
||||
}
|
||||
}
|
||||
|
|
@ -344,30 +385,30 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray,
|
|||
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 probably 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];
|
||||
}
|
||||
}
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -415,10 +456,10 @@ smaxval_r8 (gfc_array_r8 * const restrict retarray,
|
|||
{
|
||||
sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
|
||||
extent[n] =
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
GFC_DESCRIPTOR_EXTENT(array,n + 1);
|
||||
|
||||
if (extent[n] <= 0)
|
||||
extent[n] = 0;
|
||||
extent[n] = 0;
|
||||
}
|
||||
|
||||
if (retarray->data == NULL)
|
||||
|
|
@ -426,15 +467,15 @@ smaxval_r8 (gfc_array_r8 * const restrict retarray,
|
|||
size_t alloc_size, str;
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
{
|
||||
if (n == 0)
|
||||
str = 1;
|
||||
else
|
||||
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
|
||||
|
||||
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
retarray->offset = 0;
|
||||
retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
|
||||
|
|
@ -490,21 +531,21 @@ smaxval_r8 (gfc_array_r8 * const restrict retarray,
|
|||
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 probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
dest -= dstride[n] * extent[n];
|
||||
n++;
|
||||
if (n == rank)
|
||||
return;
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
dest += dstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_16_i1 (gfc_array_i16 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_16_i1 (gfc_array_i16 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_1 minval;
|
||||
|
||||
minval = GFC_INTEGER_1_HUGE;
|
||||
GFC_INTEGER_1 minval;
|
||||
#if defined(GFC_INTEGER_1_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_1_INFINITY)
|
||||
minval = GFC_INTEGER_1_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_1_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_1_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_16_i1 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_1 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_INTEGER_1_HUGE;
|
||||
|
||||
#if defined(GFC_INTEGER_1_INFINITY)
|
||||
minval = GFC_INTEGER_1_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_1_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_1_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_16_i16 (gfc_array_i16 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_16_i16 (gfc_array_i16 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_16 minval;
|
||||
|
||||
minval = GFC_INTEGER_16_HUGE;
|
||||
GFC_INTEGER_16 minval;
|
||||
#if defined(GFC_INTEGER_16_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_16_INFINITY)
|
||||
minval = GFC_INTEGER_16_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_16_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_16_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_16_i16 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_16 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_INTEGER_16_HUGE;
|
||||
|
||||
#if defined(GFC_INTEGER_16_INFINITY)
|
||||
minval = GFC_INTEGER_16_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_16_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_16_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_16_i2 (gfc_array_i16 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_16_i2 (gfc_array_i16 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_2 minval;
|
||||
|
||||
minval = GFC_INTEGER_2_HUGE;
|
||||
GFC_INTEGER_2 minval;
|
||||
#if defined(GFC_INTEGER_2_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_2_INFINITY)
|
||||
minval = GFC_INTEGER_2_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_2_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_2_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_16_i2 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_2 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_INTEGER_2_HUGE;
|
||||
|
||||
#if defined(GFC_INTEGER_2_INFINITY)
|
||||
minval = GFC_INTEGER_2_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_2_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_2_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_16_i4 (gfc_array_i16 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_16_i4 (gfc_array_i16 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_4 minval;
|
||||
|
||||
minval = GFC_INTEGER_4_HUGE;
|
||||
GFC_INTEGER_4 minval;
|
||||
#if defined(GFC_INTEGER_4_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_4_INFINITY)
|
||||
minval = GFC_INTEGER_4_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_4_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_4_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_16_i4 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_4 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_INTEGER_4_HUGE;
|
||||
|
||||
#if defined(GFC_INTEGER_4_INFINITY)
|
||||
minval = GFC_INTEGER_4_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_4_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_4_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_16_i8 (gfc_array_i16 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_16_i8 (gfc_array_i16 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_8 minval;
|
||||
|
||||
minval = GFC_INTEGER_8_HUGE;
|
||||
GFC_INTEGER_8 minval;
|
||||
#if defined(GFC_INTEGER_8_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_8_INFINITY)
|
||||
minval = GFC_INTEGER_8_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_8_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_8_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_16_i8 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_8 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_INTEGER_8_HUGE;
|
||||
|
||||
#if defined(GFC_INTEGER_8_INFINITY)
|
||||
minval = GFC_INTEGER_8_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_8_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_8_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_16_r10 (gfc_array_i16 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_16_r10 (gfc_array_i16 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_REAL_10 minval;
|
||||
|
||||
minval = GFC_REAL_10_HUGE;
|
||||
GFC_REAL_10 minval;
|
||||
#if defined(GFC_REAL_10_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_REAL_10_INFINITY)
|
||||
minval = GFC_REAL_10_INFINITY;
|
||||
#else
|
||||
minval = GFC_REAL_10_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_REAL_10_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_16_r10 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_REAL_10 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_REAL_10_HUGE;
|
||||
|
||||
#if defined(GFC_REAL_10_INFINITY)
|
||||
minval = GFC_REAL_10_INFINITY;
|
||||
#else
|
||||
minval = GFC_REAL_10_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_REAL_10_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_16_r16 (gfc_array_i16 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_16_r16 (gfc_array_i16 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_REAL_16 minval;
|
||||
|
||||
minval = GFC_REAL_16_HUGE;
|
||||
GFC_REAL_16 minval;
|
||||
#if defined(GFC_REAL_16_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_REAL_16_INFINITY)
|
||||
minval = GFC_REAL_16_INFINITY;
|
||||
#else
|
||||
minval = GFC_REAL_16_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_REAL_16_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_16_r16 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_REAL_16 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_REAL_16_HUGE;
|
||||
|
||||
#if defined(GFC_REAL_16_INFINITY)
|
||||
minval = GFC_REAL_16_INFINITY;
|
||||
#else
|
||||
minval = GFC_REAL_16_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_REAL_16_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_16_r4 (gfc_array_i16 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_16_r4 (gfc_array_i16 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_REAL_4 minval;
|
||||
|
||||
minval = GFC_REAL_4_HUGE;
|
||||
GFC_REAL_4 minval;
|
||||
#if defined(GFC_REAL_4_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_REAL_4_INFINITY)
|
||||
minval = GFC_REAL_4_INFINITY;
|
||||
#else
|
||||
minval = GFC_REAL_4_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_REAL_4_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_16_r4 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_REAL_4 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_REAL_4_HUGE;
|
||||
|
||||
#if defined(GFC_REAL_4_INFINITY)
|
||||
minval = GFC_REAL_4_INFINITY;
|
||||
#else
|
||||
minval = GFC_REAL_4_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_REAL_4_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_16_r8 (gfc_array_i16 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_16_r8 (gfc_array_i16 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_REAL_8 minval;
|
||||
|
||||
minval = GFC_REAL_8_HUGE;
|
||||
GFC_REAL_8 minval;
|
||||
#if defined(GFC_REAL_8_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_REAL_8_INFINITY)
|
||||
minval = GFC_REAL_8_INFINITY;
|
||||
#else
|
||||
minval = GFC_REAL_8_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_REAL_8_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_16_r8 (gfc_array_i16 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_REAL_8 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_REAL_8_HUGE;
|
||||
|
||||
#if defined(GFC_REAL_8_INFINITY)
|
||||
minval = GFC_REAL_8_INFINITY;
|
||||
#else
|
||||
minval = GFC_REAL_8_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_REAL_8_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_4_i1 (gfc_array_i4 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_4_i1 (gfc_array_i4 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_1 minval;
|
||||
|
||||
minval = GFC_INTEGER_1_HUGE;
|
||||
GFC_INTEGER_1 minval;
|
||||
#if defined(GFC_INTEGER_1_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_1_INFINITY)
|
||||
minval = GFC_INTEGER_1_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_1_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_1_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_4_i1 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_1 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_INTEGER_1_HUGE;
|
||||
|
||||
#if defined(GFC_INTEGER_1_INFINITY)
|
||||
minval = GFC_INTEGER_1_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_1_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_1_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_4_i16 (gfc_array_i4 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_4_i16 (gfc_array_i4 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_16 minval;
|
||||
|
||||
minval = GFC_INTEGER_16_HUGE;
|
||||
GFC_INTEGER_16 minval;
|
||||
#if defined(GFC_INTEGER_16_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_16_INFINITY)
|
||||
minval = GFC_INTEGER_16_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_16_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_16_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_4_i16 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_16 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_INTEGER_16_HUGE;
|
||||
|
||||
#if defined(GFC_INTEGER_16_INFINITY)
|
||||
minval = GFC_INTEGER_16_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_16_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_16_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_4_i2 (gfc_array_i4 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_4_i2 (gfc_array_i4 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_2 minval;
|
||||
|
||||
minval = GFC_INTEGER_2_HUGE;
|
||||
GFC_INTEGER_2 minval;
|
||||
#if defined(GFC_INTEGER_2_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_2_INFINITY)
|
||||
minval = GFC_INTEGER_2_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_2_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_2_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_4_i2 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_2 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_INTEGER_2_HUGE;
|
||||
|
||||
#if defined(GFC_INTEGER_2_INFINITY)
|
||||
minval = GFC_INTEGER_2_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_2_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_2_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_4_i4 (gfc_array_i4 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_4_i4 (gfc_array_i4 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_4 minval;
|
||||
|
||||
minval = GFC_INTEGER_4_HUGE;
|
||||
GFC_INTEGER_4 minval;
|
||||
#if defined(GFC_INTEGER_4_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_4_INFINITY)
|
||||
minval = GFC_INTEGER_4_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_4_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_4_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_4_i4 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_4 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_INTEGER_4_HUGE;
|
||||
|
||||
#if defined(GFC_INTEGER_4_INFINITY)
|
||||
minval = GFC_INTEGER_4_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_4_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_4_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_4_i8 (gfc_array_i4 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_4_i8 (gfc_array_i4 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_8 minval;
|
||||
|
||||
minval = GFC_INTEGER_8_HUGE;
|
||||
GFC_INTEGER_8 minval;
|
||||
#if defined(GFC_INTEGER_8_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_8_INFINITY)
|
||||
minval = GFC_INTEGER_8_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_8_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_8_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_4_i8 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_8 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_INTEGER_8_HUGE;
|
||||
|
||||
#if defined(GFC_INTEGER_8_INFINITY)
|
||||
minval = GFC_INTEGER_8_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_8_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_8_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_4_r10 (gfc_array_i4 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_4_r10 (gfc_array_i4 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_REAL_10 minval;
|
||||
|
||||
minval = GFC_REAL_10_HUGE;
|
||||
GFC_REAL_10 minval;
|
||||
#if defined(GFC_REAL_10_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_REAL_10_INFINITY)
|
||||
minval = GFC_REAL_10_INFINITY;
|
||||
#else
|
||||
minval = GFC_REAL_10_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_REAL_10_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_4_r10 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_REAL_10 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_REAL_10_HUGE;
|
||||
|
||||
#if defined(GFC_REAL_10_INFINITY)
|
||||
minval = GFC_REAL_10_INFINITY;
|
||||
#else
|
||||
minval = GFC_REAL_10_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_REAL_10_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_4_r16 (gfc_array_i4 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_4_r16 (gfc_array_i4 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_REAL_16 minval;
|
||||
|
||||
minval = GFC_REAL_16_HUGE;
|
||||
GFC_REAL_16 minval;
|
||||
#if defined(GFC_REAL_16_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_REAL_16_INFINITY)
|
||||
minval = GFC_REAL_16_INFINITY;
|
||||
#else
|
||||
minval = GFC_REAL_16_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_REAL_16_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_4_r16 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_REAL_16 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_REAL_16_HUGE;
|
||||
|
||||
#if defined(GFC_REAL_16_INFINITY)
|
||||
minval = GFC_REAL_16_INFINITY;
|
||||
#else
|
||||
minval = GFC_REAL_16_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_REAL_16_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_4_r4 (gfc_array_i4 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_4_r4 (gfc_array_i4 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_REAL_4 minval;
|
||||
|
||||
minval = GFC_REAL_4_HUGE;
|
||||
GFC_REAL_4 minval;
|
||||
#if defined(GFC_REAL_4_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_REAL_4_INFINITY)
|
||||
minval = GFC_REAL_4_INFINITY;
|
||||
#else
|
||||
minval = GFC_REAL_4_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_REAL_4_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_4_r4 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_REAL_4 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_REAL_4_HUGE;
|
||||
|
||||
#if defined(GFC_REAL_4_INFINITY)
|
||||
minval = GFC_REAL_4_INFINITY;
|
||||
#else
|
||||
minval = GFC_REAL_4_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_REAL_4_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_4_r8 (gfc_array_i4 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_4_r8 (gfc_array_i4 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_REAL_8 minval;
|
||||
|
||||
minval = GFC_REAL_8_HUGE;
|
||||
GFC_REAL_8 minval;
|
||||
#if defined(GFC_REAL_8_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_REAL_8_INFINITY)
|
||||
minval = GFC_REAL_8_INFINITY;
|
||||
#else
|
||||
minval = GFC_REAL_8_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_REAL_8_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_4_r8 (gfc_array_i4 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_REAL_8 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_REAL_8_HUGE;
|
||||
|
||||
#if defined(GFC_REAL_8_INFINITY)
|
||||
minval = GFC_REAL_8_INFINITY;
|
||||
#else
|
||||
minval = GFC_REAL_8_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_REAL_8_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_8_i1 (gfc_array_i8 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_8_i1 (gfc_array_i8 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_1 minval;
|
||||
|
||||
minval = GFC_INTEGER_1_HUGE;
|
||||
GFC_INTEGER_1 minval;
|
||||
#if defined(GFC_INTEGER_1_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_1_INFINITY)
|
||||
minval = GFC_INTEGER_1_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_1_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_1_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_8_i1 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_1 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_INTEGER_1_HUGE;
|
||||
|
||||
#if defined(GFC_INTEGER_1_INFINITY)
|
||||
minval = GFC_INTEGER_1_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_1_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_1_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_8_i16 (gfc_array_i8 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_8_i16 (gfc_array_i8 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_16 minval;
|
||||
|
||||
minval = GFC_INTEGER_16_HUGE;
|
||||
GFC_INTEGER_16 minval;
|
||||
#if defined(GFC_INTEGER_16_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_16_INFINITY)
|
||||
minval = GFC_INTEGER_16_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_16_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_16_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_8_i16 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_16 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_INTEGER_16_HUGE;
|
||||
|
||||
#if defined(GFC_INTEGER_16_INFINITY)
|
||||
minval = GFC_INTEGER_16_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_16_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_16_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_8_i2 (gfc_array_i8 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_8_i2 (gfc_array_i8 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_2 minval;
|
||||
|
||||
minval = GFC_INTEGER_2_HUGE;
|
||||
GFC_INTEGER_2 minval;
|
||||
#if defined(GFC_INTEGER_2_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_2_INFINITY)
|
||||
minval = GFC_INTEGER_2_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_2_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_2_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_8_i2 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_2 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_INTEGER_2_HUGE;
|
||||
|
||||
#if defined(GFC_INTEGER_2_INFINITY)
|
||||
minval = GFC_INTEGER_2_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_2_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_2_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_8_i4 (gfc_array_i8 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_8_i4 (gfc_array_i8 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_4 minval;
|
||||
|
||||
minval = GFC_INTEGER_4_HUGE;
|
||||
GFC_INTEGER_4 minval;
|
||||
#if defined(GFC_INTEGER_4_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_4_INFINITY)
|
||||
minval = GFC_INTEGER_4_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_4_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_4_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_8_i4 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_4 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_INTEGER_4_HUGE;
|
||||
|
||||
#if defined(GFC_INTEGER_4_INFINITY)
|
||||
minval = GFC_INTEGER_4_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_4_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_4_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_8_i8 (gfc_array_i8 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_8_i8 (gfc_array_i8 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_INTEGER_8 minval;
|
||||
|
||||
minval = GFC_INTEGER_8_HUGE;
|
||||
GFC_INTEGER_8 minval;
|
||||
#if defined(GFC_INTEGER_8_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_INTEGER_8_INFINITY)
|
||||
minval = GFC_INTEGER_8_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_8_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_INTEGER_8_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_8_i8 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_INTEGER_8 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_INTEGER_8_HUGE;
|
||||
|
||||
#if defined(GFC_INTEGER_8_INFINITY)
|
||||
minval = GFC_INTEGER_8_INFINITY;
|
||||
#else
|
||||
minval = GFC_INTEGER_8_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_INTEGER_8_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ minloc0_8_r10 (gfc_array_i8 * const restrict retarray,
|
|||
else
|
||||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
|
||||
"MINLOC");
|
||||
}
|
||||
|
||||
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
|
||||
|
|
@ -87,51 +87,83 @@ minloc0_8_r10 (gfc_array_i8 * const restrict retarray,
|
|||
|
||||
/* Initialize the return value. */
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = 0;
|
||||
dest[n * dstride] = 1;
|
||||
{
|
||||
|
||||
GFC_REAL_10 minval;
|
||||
|
||||
minval = GFC_REAL_10_HUGE;
|
||||
GFC_REAL_10 minval;
|
||||
#if defined(GFC_REAL_10_QUIET_NAN)
|
||||
int fast = 0;
|
||||
#endif
|
||||
|
||||
#if defined(GFC_REAL_10_INFINITY)
|
||||
minval = GFC_REAL_10_INFINITY;
|
||||
#else
|
||||
minval = GFC_REAL_10_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*base < minval || !dest[0])
|
||||
{
|
||||
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];
|
||||
#if defined(GFC_REAL_10_QUIET_NAN)
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*base <= minval)
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
#endif
|
||||
if (*base < minval)
|
||||
{
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
}
|
||||
/* Implementation end. */
|
||||
/* Advance to the next element. */
|
||||
base += sstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -219,50 +251,87 @@ mminloc0_8_r10 (gfc_array_i8 * const restrict retarray,
|
|||
{
|
||||
|
||||
GFC_REAL_10 minval;
|
||||
int fast = 0;
|
||||
|
||||
minval = GFC_REAL_10_HUGE;
|
||||
|
||||
#if defined(GFC_REAL_10_INFINITY)
|
||||
minval = GFC_REAL_10_INFINITY;
|
||||
#else
|
||||
minval = GFC_REAL_10_HUGE;
|
||||
#endif
|
||||
while (base)
|
||||
{
|
||||
{
|
||||
/* Implementation start. */
|
||||
do
|
||||
{
|
||||
/* Implementation start. */
|
||||
|
||||
if (*mbase && (*base < minval || !dest[0]))
|
||||
{
|
||||
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];
|
||||
}
|
||||
while (0);
|
||||
if (unlikely (!fast))
|
||||
{
|
||||
do
|
||||
{
|
||||
if (*mbase)
|
||||
{
|
||||
#if defined(GFC_REAL_10_QUIET_NAN)
|
||||
if (unlikely (dest[0] == 0))
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
if (*base <= minval)
|
||||
#endif
|
||||
{
|
||||
fast = 1;
|
||||
minval = *base;
|
||||
for (n = 0; n < rank; n++)
|
||||
dest[n * dstride] = count[n] + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[0]);
|
||||
if (likely (fast))
|
||||
continue;
|
||||
}
|
||||
else do
|
||||
{
|
||||
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. */
|
||||
base += sstride[0];
|
||||
mbase += mstride[0];
|
||||
}
|
||||
while (++count[0] != extent[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 probably 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];
|
||||
}
|
||||
}
|
||||
do
|
||||
{
|
||||
/* 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 probably 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];
|
||||
}
|
||||
}
|
||||
while (count[n] == extent[n]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue