From cb2777a3a59a56309fcd3801e30a3f0d2e9a8158 Mon Sep 17 00:00:00 2001 From: tkoenig Date: Mon, 27 Mar 2006 20:05:24 +0000 Subject: 2006-03-27 Thomas Koenig PR fortran/20935 Backport from mainline * m4/iforeach.m4: Add SCALAR_FOREACH_FUNCTION macro. * m4/ifunction.m4: Add SCALAR_ARRAY_FUNCTION macro. * m4/minloc0.m4: Use SCALAR_FOREACH_FUNCTION. * m4/minloc1.m4: Use SCALAR_ARRAY_FUNCTION. * m4/maxloc0.m4: Use SCALAR_FOREACH_FUNCTION. * m4/maxloc1.m4: Use SCALAR_ARRAY_FUNCTION. * m4/minval.m4: Likewise. * m4/maxval.m4: Likewise. * m4/product.m4: Likewise. * m4/sum.m4: Likewise. * minloc0_16_i16.c : Regenerated. * minloc0_16_i4.c : Regenerated. * minloc0_16_i8.c : Regenerated. * minloc0_16_r10.c : Regenerated. * minloc0_16_r16.c : Regenerated. * minloc0_16_r4.c : Regenerated. * minloc0_16_r8.c : Regenerated. * minloc0_4_i16.c : Regenerated. * minloc0_4_i4.c : Regenerated. * minloc0_4_i8.c : Regenerated. * minloc0_4_r10.c : Regenerated. * minloc0_4_r16.c : Regenerated. * minloc0_4_r4.c : Regenerated. * minloc0_4_r8.c : Regenerated. * minloc0_8_i16.c : Regenerated. * minloc0_8_i4.c : Regenerated. * minloc0_8_i8.c : Regenerated. * minloc0_8_r10.c : Regenerated. * minloc0_8_r16.c : Regenerated. * minloc0_8_r4.c : Regenerated. * minloc0_8_r8.c : Regenerated. * minloc1_16_i16.c : Regenerated. * minloc1_16_i4.c : Regenerated. * minloc1_16_i8.c : Regenerated. * minloc1_16_r10.c : Regenerated. * minloc1_16_r16.c : Regenerated. * minloc1_16_r4.c : Regenerated. * minloc1_16_r8.c : Regenerated. * minloc1_4_i16.c : Regenerated. * minloc1_4_i4.c : Regenerated. * minloc1_4_i8.c : Regenerated. * minloc1_4_r10.c : Regenerated. * minloc1_4_r16.c : Regenerated. * minloc1_4_r4.c : Regenerated. * minloc1_4_r8.c : Regenerated. * minloc1_8_i16.c : Regenerated. * minloc1_8_i4.c : Regenerated. * minloc1_8_i8.c : Regenerated. * minloc1_8_r10.c : Regenerated. * minloc1_8_r16.c : Regenerated. * minloc1_8_r4.c : Regenerated. * minloc1_8_r8.c : Regenerated. * maxloc0_16_i16.c : Regenerated. * maxloc0_16_i4.c : Regenerated. * maxloc0_16_i8.c : Regenerated. * maxloc0_16_r10.c : Regenerated. * maxloc0_16_r16.c : Regenerated. * maxloc0_16_r4.c : Regenerated. * maxloc0_16_r8.c : Regenerated. * maxloc0_4_i16.c : Regenerated. * maxloc0_4_i4.c : Regenerated. * maxloc0_4_i8.c : Regenerated. * maxloc0_4_r10.c : Regenerated. * maxloc0_4_r16.c : Regenerated. * maxloc0_4_r4.c : Regenerated. * maxloc0_4_r8.c : Regenerated. * maxloc0_8_i16.c : Regenerated. * maxloc0_8_i4.c : Regenerated. * maxloc0_8_i8.c : Regenerated. * maxloc0_8_r10.c : Regenerated. * maxloc0_8_r16.c : Regenerated. * maxloc0_8_r4.c : Regenerated. * maxloc0_8_r8.c : Regenerated. * maxloc1_16_i16.c : Regenerated. * maxloc1_16_i4.c : Regenerated. * maxloc1_16_i8.c : Regenerated. * maxloc1_16_r10.c : Regenerated. * maxloc1_16_r16.c : Regenerated. * maxloc1_16_r4.c : Regenerated. * maxloc1_16_r8.c : Regenerated. * maxloc1_4_i16.c : Regenerated. * maxloc1_4_i4.c : Regenerated. * maxloc1_4_i8.c : Regenerated. * maxloc1_4_r10.c : Regenerated. * maxloc1_4_r16.c : Regenerated. * maxloc1_4_r4.c : Regenerated. * maxloc1_4_r8.c : Regenerated. * maxloc1_8_i16.c : Regenerated. * maxloc1_8_i4.c : Regenerated. * maxloc1_8_i8.c : Regenerated. * maxloc1_8_r10.c : Regenerated. * maxloc1_8_r16.c : Regenerated. * maxloc1_8_r4.c : Regenerated. * maxloc1_8_r8.c : Regenerated. * maxval_i16.c : Regenerated. * maxval_i4.c : Regenerated. * maxval_i8.c : Regenerated. * maxval_r10.c : Regenerated. * maxval_r16.c : Regenerated. * maxval_r4.c : Regenerated. * maxval_r8.c : Regenerated. * minval_i16.c : Regenerated. * minval_i4.c : Regenerated. * minval_i8.c : Regenerated. * minval_r10.c : Regenerated. * minval_r16.c : Regenerated. * minval_r4.c : Regenerated. * minval_r8.c : Regenerated. * sum_c10.c : Regenerated. * sum_c16.c : Regenerated. * sum_c4.c : Regenerated. * sum_c8.c : Regenerated. * sum_i16.c : Regenerated. * sum_i4.c : Regenerated. * sum_i8.c : Regenerated. * sum_r10.c : Regenerated. * sum_r16.c : Regenerated. * sum_r4.c : Regenerated. * sum_r8.c : Regenerated. * product_c10.c : Regenerated. * product_c16.c : Regenerated. * product_c4.c : Regenerated. * product_c8.c : Regenerated. * product_i16.c : Regenerated. * product_i4.c : Regenerated. * product_i8.c : Regenerated. * product_r10.c : Regenerated. * product_r16.c : Regenerated. * product_r4.c : Regenerated. * product_r8.c : Regenerated. 2006-03-27 Paul Thomas PR fortran/25378 Backport from mainline * libgfortran/m4/minloc1.m4: Set the initial position to zero and modify the condition for updating it, to implement the F2003 requirement for all(mask).eq.false. * libgfortran/m4/maxloc1.m4: The same. * libgfortran/m4/iforeach.m4: The same. * libgfortran/m4/minloc0.m4: The same. * libgfortran/m4/maxloc0.m4: The same. * libgfortran/generated/maxloc0_16_i16.c: Regenerated, together with 41 others. * libgfortran/generated/minloc0_16_i16.c: Regenerated, together with 41 others. 2006-03-27 Thomas Koenig PR fortran/20935 Backport from mainline * iresolve.c (gfc_resolve_maxloc): If mask is scalar, prefix the function name with an "s". If the mask is scalar or if its kind is smaller than gfc_default_logical_kind, coerce it to default kind. (gfc_resolve_maxval): Likewise. (gfc_resolve_minloc): Likewise. (gfc_resolve_minval): Likewise. (gfc_resolve_product): Likewise. (gfc_resolve_sum): Likewise. 2006-03-27 Paul Thomas PR fortran/25378 Backport from mainline * trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Set the initial position to zero and modify the condition for updating it, to implement the F2003 requirement for all(mask) is false. 2006-03-27 Thomas Koenig PR fortran/20935 Backport from mainline * gfortran.dg/scalar_mask_2.f90: New test case. 2006-03-27 Paul Thomas PR fortran/25378 Backport from mainline * gfortran.fortran-torture/execute/intrinsic_mmloc_3.f90: Expand test to include more permuatations of mask and index. * testsuite/gfortran.dg/scalar_mask_1.f90: Modify last test to respond to F2003 spec. that the position returned for an all false mask && condition is zero. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_1-branch@112425 138bc75d-0d04-0410-961f-82ee72b054a4 --- libgfortran/generated/maxloc0_16_i16.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/maxloc0_16_i4.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/maxloc0_16_i8.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/maxloc0_16_r10.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/maxloc0_16_r16.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/maxloc0_16_r4.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/maxloc0_16_r8.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/maxloc0_4_i16.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/maxloc0_4_i4.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/maxloc0_4_i8.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/maxloc0_4_r10.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/maxloc0_4_r16.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/maxloc0_4_r4.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/maxloc0_4_r8.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/maxloc0_8_i16.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/maxloc0_8_i4.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/maxloc0_8_i8.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/maxloc0_8_r10.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/maxloc0_8_r16.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/maxloc0_8_r4.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/maxloc0_8_r8.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/maxloc1_16_i16.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/maxloc1_16_i4.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/maxloc1_16_i8.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/maxloc1_16_r10.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/maxloc1_16_r16.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/maxloc1_16_r4.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/maxloc1_16_r8.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/maxloc1_4_i16.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/maxloc1_4_i4.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/maxloc1_4_i8.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/maxloc1_4_r10.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/maxloc1_4_r16.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/maxloc1_4_r4.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/maxloc1_4_r8.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/maxloc1_8_i16.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/maxloc1_8_i4.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/maxloc1_8_i8.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/maxloc1_8_r10.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/maxloc1_8_r16.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/maxloc1_8_r4.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/maxloc1_8_r8.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/maxval_i16.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/maxval_i4.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/maxval_i8.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/maxval_r10.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/maxval_r16.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/maxval_r4.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/maxval_r8.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/minloc0_16_i16.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/minloc0_16_i4.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/minloc0_16_i8.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/minloc0_16_r10.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/minloc0_16_r16.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/minloc0_16_r4.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/minloc0_16_r8.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/minloc0_4_i16.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/minloc0_4_i4.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/minloc0_4_i8.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/minloc0_4_r10.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/minloc0_4_r16.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/minloc0_4_r4.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/minloc0_4_r8.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/minloc0_8_i16.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/minloc0_8_i4.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/minloc0_8_i8.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/minloc0_8_r10.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/minloc0_8_r16.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/minloc0_8_r4.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/minloc0_8_r8.c | 60 +++++++++++++++++++++++++++++--- libgfortran/generated/minloc1_16_i16.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/minloc1_16_i4.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/minloc1_16_i8.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/minloc1_16_r10.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/minloc1_16_r16.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/minloc1_16_r4.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/minloc1_16_r8.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/minloc1_4_i16.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/minloc1_4_i4.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/minloc1_4_i8.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/minloc1_4_r10.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/minloc1_4_r16.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/minloc1_4_r4.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/minloc1_4_r8.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/minloc1_8_i16.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/minloc1_8_i4.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/minloc1_8_i8.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/minloc1_8_r10.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/minloc1_8_r16.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/minloc1_8_r4.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/minloc1_8_r8.c | 62 +++++++++++++++++++++++++++++++--- libgfortran/generated/minval_i16.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/minval_i4.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/minval_i8.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/minval_r10.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/minval_r16.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/minval_r4.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/minval_r8.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/product_c10.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/product_c16.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/product_c4.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/product_c8.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/product_i16.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/product_i4.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/product_i8.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/product_r10.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/product_r16.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/product_r4.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/product_r8.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/sum_c10.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/sum_c16.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/sum_c4.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/sum_c8.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/sum_i16.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/sum_i4.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/sum_i8.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/sum_r10.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/sum_r16.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/sum_r4.c | 54 +++++++++++++++++++++++++++++ libgfortran/generated/sum_r8.c | 54 +++++++++++++++++++++++++++++ 120 files changed, 6732 insertions(+), 336 deletions(-) (limited to 'libgfortran/generated') diff --git a/libgfortran/generated/maxloc0_16_i16.c b/libgfortran/generated/maxloc0_16_i16.c index ca934a14d70..8df42b45cc3 100644 --- a/libgfortran/generated/maxloc0_16_i16.c +++ b/libgfortran/generated/maxloc0_16_i16.c @@ -104,7 +104,7 @@ maxloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array) /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_INTEGER_16 maxval; @@ -116,7 +116,7 @@ maxloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array) { /* Implementation start. */ - if (*base > maxval) + if (*base > maxval || !dest[0]) { maxval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mmaxloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_INTEGER_16 maxval; @@ -249,7 +249,7 @@ mmaxloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array, { /* Implementation start. */ - if (*mbase && *base > maxval) + if (*mbase && (*base > maxval || !dest[0])) { maxval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mmaxloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array, } } + +extern void smaxloc0_16_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_16_i16); + +void +smaxloc0_16_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc0_16_i16 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n maxval) + if (*base > maxval || !dest[0]) { maxval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mmaxloc0_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_INTEGER_4 maxval; @@ -249,7 +249,7 @@ mmaxloc0_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 *array, { /* Implementation start. */ - if (*mbase && *base > maxval) + if (*mbase && (*base > maxval || !dest[0])) { maxval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mmaxloc0_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 *array, } } + +extern void smaxloc0_16_i4 (gfc_array_i16 * const restrict, + gfc_array_i4 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_16_i4); + +void +smaxloc0_16_i4 (gfc_array_i16 * const restrict retarray, + gfc_array_i4 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc0_16_i4 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n maxval) + if (*base > maxval || !dest[0]) { maxval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mmaxloc0_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_INTEGER_8 maxval; @@ -249,7 +249,7 @@ mmaxloc0_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 *array, { /* Implementation start. */ - if (*mbase && *base > maxval) + if (*mbase && (*base > maxval || !dest[0])) { maxval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mmaxloc0_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 *array, } } + +extern void smaxloc0_16_i8 (gfc_array_i16 * const restrict, + gfc_array_i8 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_16_i8); + +void +smaxloc0_16_i8 (gfc_array_i16 * const restrict retarray, + gfc_array_i8 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc0_16_i8 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n maxval) + if (*base > maxval || !dest[0]) { maxval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mmaxloc0_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_REAL_10 maxval; @@ -249,7 +249,7 @@ mmaxloc0_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 *array, { /* Implementation start. */ - if (*mbase && *base > maxval) + if (*mbase && (*base > maxval || !dest[0])) { maxval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mmaxloc0_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 *array, } } + +extern void smaxloc0_16_r10 (gfc_array_i16 * const restrict, + gfc_array_r10 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_16_r10); + +void +smaxloc0_16_r10 (gfc_array_i16 * const restrict retarray, + gfc_array_r10 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc0_16_r10 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n maxval) + if (*base > maxval || !dest[0]) { maxval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mmaxloc0_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_REAL_16 maxval; @@ -249,7 +249,7 @@ mmaxloc0_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 *array, { /* Implementation start. */ - if (*mbase && *base > maxval) + if (*mbase && (*base > maxval || !dest[0])) { maxval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mmaxloc0_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 *array, } } + +extern void smaxloc0_16_r16 (gfc_array_i16 * const restrict, + gfc_array_r16 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_16_r16); + +void +smaxloc0_16_r16 (gfc_array_i16 * const restrict retarray, + gfc_array_r16 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc0_16_r16 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n maxval) + if (*base > maxval || !dest[0]) { maxval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mmaxloc0_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_REAL_4 maxval; @@ -249,7 +249,7 @@ mmaxloc0_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 *array, { /* Implementation start. */ - if (*mbase && *base > maxval) + if (*mbase && (*base > maxval || !dest[0])) { maxval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mmaxloc0_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 *array, } } + +extern void smaxloc0_16_r4 (gfc_array_i16 * const restrict, + gfc_array_r4 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_16_r4); + +void +smaxloc0_16_r4 (gfc_array_i16 * const restrict retarray, + gfc_array_r4 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc0_16_r4 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n maxval) + if (*base > maxval || !dest[0]) { maxval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mmaxloc0_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_REAL_8 maxval; @@ -249,7 +249,7 @@ mmaxloc0_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 *array, { /* Implementation start. */ - if (*mbase && *base > maxval) + if (*mbase && (*base > maxval || !dest[0])) { maxval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mmaxloc0_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 *array, } } + +extern void smaxloc0_16_r8 (gfc_array_i16 * const restrict, + gfc_array_r8 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_16_r8); + +void +smaxloc0_16_r8 (gfc_array_i16 * const restrict retarray, + gfc_array_r8 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc0_16_r8 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n maxval) + if (*base > maxval || !dest[0]) { maxval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mmaxloc0_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_INTEGER_16 maxval; @@ -249,7 +249,7 @@ mmaxloc0_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 *array, { /* Implementation start. */ - if (*mbase && *base > maxval) + if (*mbase && (*base > maxval || !dest[0])) { maxval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mmaxloc0_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 *array, } } + +extern void smaxloc0_4_i16 (gfc_array_i4 * const restrict, + gfc_array_i16 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_4_i16); + +void +smaxloc0_4_i16 (gfc_array_i4 * const restrict retarray, + gfc_array_i16 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc0_4_i16 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n maxval) + if (*base > maxval || !dest[0]) { maxval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mmaxloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_INTEGER_4 maxval; @@ -249,7 +249,7 @@ mmaxloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array, { /* Implementation start. */ - if (*mbase && *base > maxval) + if (*mbase && (*base > maxval || !dest[0])) { maxval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mmaxloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array, } } + +extern void smaxloc0_4_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_4_i4); + +void +smaxloc0_4_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc0_4_i4 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n maxval) + if (*base > maxval || !dest[0]) { maxval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mmaxloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_INTEGER_8 maxval; @@ -249,7 +249,7 @@ mmaxloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array, { /* Implementation start. */ - if (*mbase && *base > maxval) + if (*mbase && (*base > maxval || !dest[0])) { maxval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mmaxloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array, } } + +extern void smaxloc0_4_i8 (gfc_array_i4 * const restrict, + gfc_array_i8 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_4_i8); + +void +smaxloc0_4_i8 (gfc_array_i4 * const restrict retarray, + gfc_array_i8 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc0_4_i8 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n maxval) + if (*base > maxval || !dest[0]) { maxval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mmaxloc0_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_REAL_10 maxval; @@ -249,7 +249,7 @@ mmaxloc0_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 *array, { /* Implementation start. */ - if (*mbase && *base > maxval) + if (*mbase && (*base > maxval || !dest[0])) { maxval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mmaxloc0_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 *array, } } + +extern void smaxloc0_4_r10 (gfc_array_i4 * const restrict, + gfc_array_r10 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_4_r10); + +void +smaxloc0_4_r10 (gfc_array_i4 * const restrict retarray, + gfc_array_r10 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc0_4_r10 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n maxval) + if (*base > maxval || !dest[0]) { maxval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mmaxloc0_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_REAL_16 maxval; @@ -249,7 +249,7 @@ mmaxloc0_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 *array, { /* Implementation start. */ - if (*mbase && *base > maxval) + if (*mbase && (*base > maxval || !dest[0])) { maxval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mmaxloc0_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 *array, } } + +extern void smaxloc0_4_r16 (gfc_array_i4 * const restrict, + gfc_array_r16 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_4_r16); + +void +smaxloc0_4_r16 (gfc_array_i4 * const restrict retarray, + gfc_array_r16 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc0_4_r16 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n maxval) + if (*base > maxval || !dest[0]) { maxval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mmaxloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_REAL_4 maxval; @@ -249,7 +249,7 @@ mmaxloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array, { /* Implementation start. */ - if (*mbase && *base > maxval) + if (*mbase && (*base > maxval || !dest[0])) { maxval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mmaxloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array, } } + +extern void smaxloc0_4_r4 (gfc_array_i4 * const restrict, + gfc_array_r4 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_4_r4); + +void +smaxloc0_4_r4 (gfc_array_i4 * const restrict retarray, + gfc_array_r4 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc0_4_r4 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n maxval) + if (*base > maxval || !dest[0]) { maxval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mmaxloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_REAL_8 maxval; @@ -249,7 +249,7 @@ mmaxloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array, { /* Implementation start. */ - if (*mbase && *base > maxval) + if (*mbase && (*base > maxval || !dest[0])) { maxval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mmaxloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array, } } + +extern void smaxloc0_4_r8 (gfc_array_i4 * const restrict, + gfc_array_r8 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_4_r8); + +void +smaxloc0_4_r8 (gfc_array_i4 * const restrict retarray, + gfc_array_r8 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc0_4_r8 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n maxval) + if (*base > maxval || !dest[0]) { maxval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mmaxloc0_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_INTEGER_16 maxval; @@ -249,7 +249,7 @@ mmaxloc0_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 *array, { /* Implementation start. */ - if (*mbase && *base > maxval) + if (*mbase && (*base > maxval || !dest[0])) { maxval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mmaxloc0_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 *array, } } + +extern void smaxloc0_8_i16 (gfc_array_i8 * const restrict, + gfc_array_i16 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_8_i16); + +void +smaxloc0_8_i16 (gfc_array_i8 * const restrict retarray, + gfc_array_i16 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc0_8_i16 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n maxval) + if (*base > maxval || !dest[0]) { maxval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mmaxloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_INTEGER_4 maxval; @@ -249,7 +249,7 @@ mmaxloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array, { /* Implementation start. */ - if (*mbase && *base > maxval) + if (*mbase && (*base > maxval || !dest[0])) { maxval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mmaxloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array, } } + +extern void smaxloc0_8_i4 (gfc_array_i8 * const restrict, + gfc_array_i4 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_8_i4); + +void +smaxloc0_8_i4 (gfc_array_i8 * const restrict retarray, + gfc_array_i4 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc0_8_i4 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n maxval) + if (*base > maxval || !dest[0]) { maxval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mmaxloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_INTEGER_8 maxval; @@ -249,7 +249,7 @@ mmaxloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array, { /* Implementation start. */ - if (*mbase && *base > maxval) + if (*mbase && (*base > maxval || !dest[0])) { maxval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mmaxloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array, } } + +extern void smaxloc0_8_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_8_i8); + +void +smaxloc0_8_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc0_8_i8 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n maxval) + if (*base > maxval || !dest[0]) { maxval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mmaxloc0_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_REAL_10 maxval; @@ -249,7 +249,7 @@ mmaxloc0_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 *array, { /* Implementation start. */ - if (*mbase && *base > maxval) + if (*mbase && (*base > maxval || !dest[0])) { maxval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mmaxloc0_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 *array, } } + +extern void smaxloc0_8_r10 (gfc_array_i8 * const restrict, + gfc_array_r10 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_8_r10); + +void +smaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, + gfc_array_r10 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc0_8_r10 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n maxval) + if (*base > maxval || !dest[0]) { maxval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mmaxloc0_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_REAL_16 maxval; @@ -249,7 +249,7 @@ mmaxloc0_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 *array, { /* Implementation start. */ - if (*mbase && *base > maxval) + if (*mbase && (*base > maxval || !dest[0])) { maxval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mmaxloc0_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 *array, } } + +extern void smaxloc0_8_r16 (gfc_array_i8 * const restrict, + gfc_array_r16 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_8_r16); + +void +smaxloc0_8_r16 (gfc_array_i8 * const restrict retarray, + gfc_array_r16 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc0_8_r16 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n maxval) + if (*base > maxval || !dest[0]) { maxval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mmaxloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_REAL_4 maxval; @@ -249,7 +249,7 @@ mmaxloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array, { /* Implementation start. */ - if (*mbase && *base > maxval) + if (*mbase && (*base > maxval || !dest[0])) { maxval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mmaxloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array, } } + +extern void smaxloc0_8_r4 (gfc_array_i8 * const restrict, + gfc_array_r4 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_8_r4); + +void +smaxloc0_8_r4 (gfc_array_i8 * const restrict retarray, + gfc_array_r4 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc0_8_r4 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n maxval) + if (*base > maxval || !dest[0]) { maxval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mmaxloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_REAL_8 maxval; @@ -249,7 +249,7 @@ mmaxloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array, { /* Implementation start. */ - if (*mbase && *base > maxval) + if (*mbase && (*base > maxval || !dest[0])) { maxval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mmaxloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array, } } + +extern void smaxloc0_8_r8 (gfc_array_i8 * const restrict, + gfc_array_r8 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_8_r8); + +void +smaxloc0_8_r8 (gfc_array_i8 * const restrict retarray, + gfc_array_r8 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc0_8_r8 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n maxval) + if (*src > maxval || !result) { maxval = *src; result = (GFC_INTEGER_16)n + 1; @@ -293,7 +293,7 @@ mmaxloc1_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array, GFC_INTEGER_16 maxval; maxval = -GFC_INTEGER_16_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mmaxloc1_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src > maxval) + if (*msrc && (*src > maxval || !result)) { maxval = *src; result = (GFC_INTEGER_16)n + 1; @@ -344,4 +344,58 @@ mmaxloc1_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array, } } + +extern void smaxloc1_16_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_16_i16); + +void +smaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc1_16_i16 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/maxloc1_16_i4.c b/libgfortran/generated/maxloc1_16_i4.c index 9df85ec107a..746b8ea453d 100644 --- a/libgfortran/generated/maxloc1_16_i4.c +++ b/libgfortran/generated/maxloc1_16_i4.c @@ -129,7 +129,7 @@ maxloc1_16_i4 (gfc_array_i16 *retarray, gfc_array_i4 *array, index_type *pdim) GFC_INTEGER_4 maxval; maxval = -GFC_INTEGER_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ maxloc1_16_i4 (gfc_array_i16 *retarray, gfc_array_i4 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src > maxval) + if (*src > maxval || !result) { maxval = *src; result = (GFC_INTEGER_16)n + 1; @@ -293,7 +293,7 @@ mmaxloc1_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 * array, GFC_INTEGER_4 maxval; maxval = -GFC_INTEGER_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mmaxloc1_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src > maxval) + if (*msrc && (*src > maxval || !result)) { maxval = *src; result = (GFC_INTEGER_16)n + 1; @@ -344,4 +344,58 @@ mmaxloc1_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 * array, } } + +extern void smaxloc1_16_i4 (gfc_array_i16 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_16_i4); + +void +smaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc1_16_i4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/maxloc1_16_i8.c b/libgfortran/generated/maxloc1_16_i8.c index 8d6e003f383..b92392ceb75 100644 --- a/libgfortran/generated/maxloc1_16_i8.c +++ b/libgfortran/generated/maxloc1_16_i8.c @@ -129,7 +129,7 @@ maxloc1_16_i8 (gfc_array_i16 *retarray, gfc_array_i8 *array, index_type *pdim) GFC_INTEGER_8 maxval; maxval = -GFC_INTEGER_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ maxloc1_16_i8 (gfc_array_i16 *retarray, gfc_array_i8 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src > maxval) + if (*src > maxval || !result) { maxval = *src; result = (GFC_INTEGER_16)n + 1; @@ -293,7 +293,7 @@ mmaxloc1_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 * array, GFC_INTEGER_8 maxval; maxval = -GFC_INTEGER_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mmaxloc1_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src > maxval) + if (*msrc && (*src > maxval || !result)) { maxval = *src; result = (GFC_INTEGER_16)n + 1; @@ -344,4 +344,58 @@ mmaxloc1_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 * array, } } + +extern void smaxloc1_16_i8 (gfc_array_i16 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_16_i8); + +void +smaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc1_16_i8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/maxloc1_16_r10.c b/libgfortran/generated/maxloc1_16_r10.c index 64b277005ac..a41cc664f65 100644 --- a/libgfortran/generated/maxloc1_16_r10.c +++ b/libgfortran/generated/maxloc1_16_r10.c @@ -129,7 +129,7 @@ maxloc1_16_r10 (gfc_array_i16 *retarray, gfc_array_r10 *array, index_type *pdim) GFC_REAL_10 maxval; maxval = -GFC_REAL_10_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ maxloc1_16_r10 (gfc_array_i16 *retarray, gfc_array_r10 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src > maxval) + if (*src > maxval || !result) { maxval = *src; result = (GFC_INTEGER_16)n + 1; @@ -293,7 +293,7 @@ mmaxloc1_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 * array, GFC_REAL_10 maxval; maxval = -GFC_REAL_10_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mmaxloc1_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src > maxval) + if (*msrc && (*src > maxval || !result)) { maxval = *src; result = (GFC_INTEGER_16)n + 1; @@ -344,4 +344,58 @@ mmaxloc1_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 * array, } } + +extern void smaxloc1_16_r10 (gfc_array_i16 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_16_r10); + +void +smaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc1_16_r10 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/maxloc1_16_r16.c b/libgfortran/generated/maxloc1_16_r16.c index f6718083f5c..4cba2ba2cc9 100644 --- a/libgfortran/generated/maxloc1_16_r16.c +++ b/libgfortran/generated/maxloc1_16_r16.c @@ -129,7 +129,7 @@ maxloc1_16_r16 (gfc_array_i16 *retarray, gfc_array_r16 *array, index_type *pdim) GFC_REAL_16 maxval; maxval = -GFC_REAL_16_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ maxloc1_16_r16 (gfc_array_i16 *retarray, gfc_array_r16 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src > maxval) + if (*src > maxval || !result) { maxval = *src; result = (GFC_INTEGER_16)n + 1; @@ -293,7 +293,7 @@ mmaxloc1_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 * array, GFC_REAL_16 maxval; maxval = -GFC_REAL_16_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mmaxloc1_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src > maxval) + if (*msrc && (*src > maxval || !result)) { maxval = *src; result = (GFC_INTEGER_16)n + 1; @@ -344,4 +344,58 @@ mmaxloc1_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 * array, } } + +extern void smaxloc1_16_r16 (gfc_array_i16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_16_r16); + +void +smaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc1_16_r16 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/maxloc1_16_r4.c b/libgfortran/generated/maxloc1_16_r4.c index 902e97c994e..5b36cb42b56 100644 --- a/libgfortran/generated/maxloc1_16_r4.c +++ b/libgfortran/generated/maxloc1_16_r4.c @@ -129,7 +129,7 @@ maxloc1_16_r4 (gfc_array_i16 *retarray, gfc_array_r4 *array, index_type *pdim) GFC_REAL_4 maxval; maxval = -GFC_REAL_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ maxloc1_16_r4 (gfc_array_i16 *retarray, gfc_array_r4 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src > maxval) + if (*src > maxval || !result) { maxval = *src; result = (GFC_INTEGER_16)n + 1; @@ -293,7 +293,7 @@ mmaxloc1_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 * array, GFC_REAL_4 maxval; maxval = -GFC_REAL_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mmaxloc1_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src > maxval) + if (*msrc && (*src > maxval || !result)) { maxval = *src; result = (GFC_INTEGER_16)n + 1; @@ -344,4 +344,58 @@ mmaxloc1_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 * array, } } + +extern void smaxloc1_16_r4 (gfc_array_i16 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_16_r4); + +void +smaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc1_16_r4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/maxloc1_16_r8.c b/libgfortran/generated/maxloc1_16_r8.c index 3e28d6706e2..a8797b0b8de 100644 --- a/libgfortran/generated/maxloc1_16_r8.c +++ b/libgfortran/generated/maxloc1_16_r8.c @@ -129,7 +129,7 @@ maxloc1_16_r8 (gfc_array_i16 *retarray, gfc_array_r8 *array, index_type *pdim) GFC_REAL_8 maxval; maxval = -GFC_REAL_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ maxloc1_16_r8 (gfc_array_i16 *retarray, gfc_array_r8 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src > maxval) + if (*src > maxval || !result) { maxval = *src; result = (GFC_INTEGER_16)n + 1; @@ -293,7 +293,7 @@ mmaxloc1_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 * array, GFC_REAL_8 maxval; maxval = -GFC_REAL_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mmaxloc1_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src > maxval) + if (*msrc && (*src > maxval || !result)) { maxval = *src; result = (GFC_INTEGER_16)n + 1; @@ -344,4 +344,58 @@ mmaxloc1_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 * array, } } + +extern void smaxloc1_16_r8 (gfc_array_i16 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_16_r8); + +void +smaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc1_16_r8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/maxloc1_4_i16.c b/libgfortran/generated/maxloc1_4_i16.c index 8ca2cf1195b..420a553d737 100644 --- a/libgfortran/generated/maxloc1_4_i16.c +++ b/libgfortran/generated/maxloc1_4_i16.c @@ -129,7 +129,7 @@ maxloc1_4_i16 (gfc_array_i4 *retarray, gfc_array_i16 *array, index_type *pdim) GFC_INTEGER_16 maxval; maxval = -GFC_INTEGER_16_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ maxloc1_4_i16 (gfc_array_i4 *retarray, gfc_array_i16 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src > maxval) + if (*src > maxval || !result) { maxval = *src; result = (GFC_INTEGER_4)n + 1; @@ -293,7 +293,7 @@ mmaxloc1_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 * array, GFC_INTEGER_16 maxval; maxval = -GFC_INTEGER_16_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mmaxloc1_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src > maxval) + if (*msrc && (*src > maxval || !result)) { maxval = *src; result = (GFC_INTEGER_4)n + 1; @@ -344,4 +344,58 @@ mmaxloc1_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 * array, } } + +extern void smaxloc1_4_i16 (gfc_array_i4 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_4_i16); + +void +smaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc1_4_i16 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/maxloc1_4_i4.c b/libgfortran/generated/maxloc1_4_i4.c index 06a657cca4e..f18a4cd13f0 100644 --- a/libgfortran/generated/maxloc1_4_i4.c +++ b/libgfortran/generated/maxloc1_4_i4.c @@ -129,7 +129,7 @@ maxloc1_4_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim) GFC_INTEGER_4 maxval; maxval = -GFC_INTEGER_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ maxloc1_4_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src > maxval) + if (*src > maxval || !result) { maxval = *src; result = (GFC_INTEGER_4)n + 1; @@ -293,7 +293,7 @@ mmaxloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, GFC_INTEGER_4 maxval; maxval = -GFC_INTEGER_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mmaxloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src > maxval) + if (*msrc && (*src > maxval || !result)) { maxval = *src; result = (GFC_INTEGER_4)n + 1; @@ -344,4 +344,58 @@ mmaxloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, } } + +extern void smaxloc1_4_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_4_i4); + +void +smaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc1_4_i4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/maxloc1_4_i8.c b/libgfortran/generated/maxloc1_4_i8.c index f03b36ca6a6..81022138d3b 100644 --- a/libgfortran/generated/maxloc1_4_i8.c +++ b/libgfortran/generated/maxloc1_4_i8.c @@ -129,7 +129,7 @@ maxloc1_4_i8 (gfc_array_i4 *retarray, gfc_array_i8 *array, index_type *pdim) GFC_INTEGER_8 maxval; maxval = -GFC_INTEGER_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ maxloc1_4_i8 (gfc_array_i4 *retarray, gfc_array_i8 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src > maxval) + if (*src > maxval || !result) { maxval = *src; result = (GFC_INTEGER_4)n + 1; @@ -293,7 +293,7 @@ mmaxloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 * array, GFC_INTEGER_8 maxval; maxval = -GFC_INTEGER_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mmaxloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src > maxval) + if (*msrc && (*src > maxval || !result)) { maxval = *src; result = (GFC_INTEGER_4)n + 1; @@ -344,4 +344,58 @@ mmaxloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 * array, } } + +extern void smaxloc1_4_i8 (gfc_array_i4 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_4_i8); + +void +smaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc1_4_i8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/maxloc1_4_r10.c b/libgfortran/generated/maxloc1_4_r10.c index 854b0b8042e..e5d73208bb5 100644 --- a/libgfortran/generated/maxloc1_4_r10.c +++ b/libgfortran/generated/maxloc1_4_r10.c @@ -129,7 +129,7 @@ maxloc1_4_r10 (gfc_array_i4 *retarray, gfc_array_r10 *array, index_type *pdim) GFC_REAL_10 maxval; maxval = -GFC_REAL_10_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ maxloc1_4_r10 (gfc_array_i4 *retarray, gfc_array_r10 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src > maxval) + if (*src > maxval || !result) { maxval = *src; result = (GFC_INTEGER_4)n + 1; @@ -293,7 +293,7 @@ mmaxloc1_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 * array, GFC_REAL_10 maxval; maxval = -GFC_REAL_10_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mmaxloc1_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src > maxval) + if (*msrc && (*src > maxval || !result)) { maxval = *src; result = (GFC_INTEGER_4)n + 1; @@ -344,4 +344,58 @@ mmaxloc1_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 * array, } } + +extern void smaxloc1_4_r10 (gfc_array_i4 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_4_r10); + +void +smaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc1_4_r10 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/maxloc1_4_r16.c b/libgfortran/generated/maxloc1_4_r16.c index fdabd1ae4f2..bb440b81601 100644 --- a/libgfortran/generated/maxloc1_4_r16.c +++ b/libgfortran/generated/maxloc1_4_r16.c @@ -129,7 +129,7 @@ maxloc1_4_r16 (gfc_array_i4 *retarray, gfc_array_r16 *array, index_type *pdim) GFC_REAL_16 maxval; maxval = -GFC_REAL_16_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ maxloc1_4_r16 (gfc_array_i4 *retarray, gfc_array_r16 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src > maxval) + if (*src > maxval || !result) { maxval = *src; result = (GFC_INTEGER_4)n + 1; @@ -293,7 +293,7 @@ mmaxloc1_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 * array, GFC_REAL_16 maxval; maxval = -GFC_REAL_16_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mmaxloc1_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src > maxval) + if (*msrc && (*src > maxval || !result)) { maxval = *src; result = (GFC_INTEGER_4)n + 1; @@ -344,4 +344,58 @@ mmaxloc1_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 * array, } } + +extern void smaxloc1_4_r16 (gfc_array_i4 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_4_r16); + +void +smaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc1_4_r16 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/maxloc1_4_r4.c b/libgfortran/generated/maxloc1_4_r4.c index 34510e7de1a..780987e8b0f 100644 --- a/libgfortran/generated/maxloc1_4_r4.c +++ b/libgfortran/generated/maxloc1_4_r4.c @@ -129,7 +129,7 @@ maxloc1_4_r4 (gfc_array_i4 *retarray, gfc_array_r4 *array, index_type *pdim) GFC_REAL_4 maxval; maxval = -GFC_REAL_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ maxloc1_4_r4 (gfc_array_i4 *retarray, gfc_array_r4 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src > maxval) + if (*src > maxval || !result) { maxval = *src; result = (GFC_INTEGER_4)n + 1; @@ -293,7 +293,7 @@ mmaxloc1_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 * array, GFC_REAL_4 maxval; maxval = -GFC_REAL_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mmaxloc1_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src > maxval) + if (*msrc && (*src > maxval || !result)) { maxval = *src; result = (GFC_INTEGER_4)n + 1; @@ -344,4 +344,58 @@ mmaxloc1_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 * array, } } + +extern void smaxloc1_4_r4 (gfc_array_i4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_4_r4); + +void +smaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc1_4_r4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/maxloc1_4_r8.c b/libgfortran/generated/maxloc1_4_r8.c index ea67079c6c0..e2b3b3d507a 100644 --- a/libgfortran/generated/maxloc1_4_r8.c +++ b/libgfortran/generated/maxloc1_4_r8.c @@ -129,7 +129,7 @@ maxloc1_4_r8 (gfc_array_i4 *retarray, gfc_array_r8 *array, index_type *pdim) GFC_REAL_8 maxval; maxval = -GFC_REAL_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ maxloc1_4_r8 (gfc_array_i4 *retarray, gfc_array_r8 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src > maxval) + if (*src > maxval || !result) { maxval = *src; result = (GFC_INTEGER_4)n + 1; @@ -293,7 +293,7 @@ mmaxloc1_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 * array, GFC_REAL_8 maxval; maxval = -GFC_REAL_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mmaxloc1_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src > maxval) + if (*msrc && (*src > maxval || !result)) { maxval = *src; result = (GFC_INTEGER_4)n + 1; @@ -344,4 +344,58 @@ mmaxloc1_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 * array, } } + +extern void smaxloc1_4_r8 (gfc_array_i4 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_4_r8); + +void +smaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc1_4_r8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/maxloc1_8_i16.c b/libgfortran/generated/maxloc1_8_i16.c index f3ba50b32c3..bb3849311de 100644 --- a/libgfortran/generated/maxloc1_8_i16.c +++ b/libgfortran/generated/maxloc1_8_i16.c @@ -129,7 +129,7 @@ maxloc1_8_i16 (gfc_array_i8 *retarray, gfc_array_i16 *array, index_type *pdim) GFC_INTEGER_16 maxval; maxval = -GFC_INTEGER_16_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ maxloc1_8_i16 (gfc_array_i8 *retarray, gfc_array_i16 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src > maxval) + if (*src > maxval || !result) { maxval = *src; result = (GFC_INTEGER_8)n + 1; @@ -293,7 +293,7 @@ mmaxloc1_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 * array, GFC_INTEGER_16 maxval; maxval = -GFC_INTEGER_16_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mmaxloc1_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src > maxval) + if (*msrc && (*src > maxval || !result)) { maxval = *src; result = (GFC_INTEGER_8)n + 1; @@ -344,4 +344,58 @@ mmaxloc1_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 * array, } } + +extern void smaxloc1_8_i16 (gfc_array_i8 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_8_i16); + +void +smaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc1_8_i16 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/maxloc1_8_i4.c b/libgfortran/generated/maxloc1_8_i4.c index 1c095ff7bb9..544b32bef78 100644 --- a/libgfortran/generated/maxloc1_8_i4.c +++ b/libgfortran/generated/maxloc1_8_i4.c @@ -129,7 +129,7 @@ maxloc1_8_i4 (gfc_array_i8 *retarray, gfc_array_i4 *array, index_type *pdim) GFC_INTEGER_4 maxval; maxval = -GFC_INTEGER_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ maxloc1_8_i4 (gfc_array_i8 *retarray, gfc_array_i4 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src > maxval) + if (*src > maxval || !result) { maxval = *src; result = (GFC_INTEGER_8)n + 1; @@ -293,7 +293,7 @@ mmaxloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 * array, GFC_INTEGER_4 maxval; maxval = -GFC_INTEGER_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mmaxloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src > maxval) + if (*msrc && (*src > maxval || !result)) { maxval = *src; result = (GFC_INTEGER_8)n + 1; @@ -344,4 +344,58 @@ mmaxloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 * array, } } + +extern void smaxloc1_8_i4 (gfc_array_i8 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_8_i4); + +void +smaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc1_8_i4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/maxloc1_8_i8.c b/libgfortran/generated/maxloc1_8_i8.c index ee6d269f307..7073a3ab9b9 100644 --- a/libgfortran/generated/maxloc1_8_i8.c +++ b/libgfortran/generated/maxloc1_8_i8.c @@ -129,7 +129,7 @@ maxloc1_8_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim) GFC_INTEGER_8 maxval; maxval = -GFC_INTEGER_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ maxloc1_8_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src > maxval) + if (*src > maxval || !result) { maxval = *src; result = (GFC_INTEGER_8)n + 1; @@ -293,7 +293,7 @@ mmaxloc1_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, GFC_INTEGER_8 maxval; maxval = -GFC_INTEGER_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mmaxloc1_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src > maxval) + if (*msrc && (*src > maxval || !result)) { maxval = *src; result = (GFC_INTEGER_8)n + 1; @@ -344,4 +344,58 @@ mmaxloc1_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, } } + +extern void smaxloc1_8_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_8_i8); + +void +smaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc1_8_i8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/maxloc1_8_r10.c b/libgfortran/generated/maxloc1_8_r10.c index 67c77330142..4c7e8105ca0 100644 --- a/libgfortran/generated/maxloc1_8_r10.c +++ b/libgfortran/generated/maxloc1_8_r10.c @@ -129,7 +129,7 @@ maxloc1_8_r10 (gfc_array_i8 *retarray, gfc_array_r10 *array, index_type *pdim) GFC_REAL_10 maxval; maxval = -GFC_REAL_10_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ maxloc1_8_r10 (gfc_array_i8 *retarray, gfc_array_r10 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src > maxval) + if (*src > maxval || !result) { maxval = *src; result = (GFC_INTEGER_8)n + 1; @@ -293,7 +293,7 @@ mmaxloc1_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 * array, GFC_REAL_10 maxval; maxval = -GFC_REAL_10_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mmaxloc1_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src > maxval) + if (*msrc && (*src > maxval || !result)) { maxval = *src; result = (GFC_INTEGER_8)n + 1; @@ -344,4 +344,58 @@ mmaxloc1_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 * array, } } + +extern void smaxloc1_8_r10 (gfc_array_i8 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_8_r10); + +void +smaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc1_8_r10 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/maxloc1_8_r16.c b/libgfortran/generated/maxloc1_8_r16.c index d0b607f25dc..e79388d1964 100644 --- a/libgfortran/generated/maxloc1_8_r16.c +++ b/libgfortran/generated/maxloc1_8_r16.c @@ -129,7 +129,7 @@ maxloc1_8_r16 (gfc_array_i8 *retarray, gfc_array_r16 *array, index_type *pdim) GFC_REAL_16 maxval; maxval = -GFC_REAL_16_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ maxloc1_8_r16 (gfc_array_i8 *retarray, gfc_array_r16 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src > maxval) + if (*src > maxval || !result) { maxval = *src; result = (GFC_INTEGER_8)n + 1; @@ -293,7 +293,7 @@ mmaxloc1_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 * array, GFC_REAL_16 maxval; maxval = -GFC_REAL_16_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mmaxloc1_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src > maxval) + if (*msrc && (*src > maxval || !result)) { maxval = *src; result = (GFC_INTEGER_8)n + 1; @@ -344,4 +344,58 @@ mmaxloc1_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 * array, } } + +extern void smaxloc1_8_r16 (gfc_array_i8 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_8_r16); + +void +smaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc1_8_r16 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/maxloc1_8_r4.c b/libgfortran/generated/maxloc1_8_r4.c index a7dd5ca1c0e..7f4ce91dc0c 100644 --- a/libgfortran/generated/maxloc1_8_r4.c +++ b/libgfortran/generated/maxloc1_8_r4.c @@ -129,7 +129,7 @@ maxloc1_8_r4 (gfc_array_i8 *retarray, gfc_array_r4 *array, index_type *pdim) GFC_REAL_4 maxval; maxval = -GFC_REAL_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ maxloc1_8_r4 (gfc_array_i8 *retarray, gfc_array_r4 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src > maxval) + if (*src > maxval || !result) { maxval = *src; result = (GFC_INTEGER_8)n + 1; @@ -293,7 +293,7 @@ mmaxloc1_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 * array, GFC_REAL_4 maxval; maxval = -GFC_REAL_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mmaxloc1_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src > maxval) + if (*msrc && (*src > maxval || !result)) { maxval = *src; result = (GFC_INTEGER_8)n + 1; @@ -344,4 +344,58 @@ mmaxloc1_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 * array, } } + +extern void smaxloc1_8_r4 (gfc_array_i8 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_8_r4); + +void +smaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc1_8_r4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/maxloc1_8_r8.c b/libgfortran/generated/maxloc1_8_r8.c index 188a4105a5c..6fa4fb4e6c7 100644 --- a/libgfortran/generated/maxloc1_8_r8.c +++ b/libgfortran/generated/maxloc1_8_r8.c @@ -129,7 +129,7 @@ maxloc1_8_r8 (gfc_array_i8 *retarray, gfc_array_r8 *array, index_type *pdim) GFC_REAL_8 maxval; maxval = -GFC_REAL_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ maxloc1_8_r8 (gfc_array_i8 *retarray, gfc_array_r8 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src > maxval) + if (*src > maxval || !result) { maxval = *src; result = (GFC_INTEGER_8)n + 1; @@ -293,7 +293,7 @@ mmaxloc1_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 * array, GFC_REAL_8 maxval; maxval = -GFC_REAL_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mmaxloc1_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src > maxval) + if (*msrc && (*src > maxval || !result)) { maxval = *src; result = (GFC_INTEGER_8)n + 1; @@ -344,4 +344,58 @@ mmaxloc1_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 * array, } } + +extern void smaxloc1_8_r8 (gfc_array_i8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_8_r8); + +void +smaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc1_8_r8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/maxval_i16.c b/libgfortran/generated/maxval_i16.c index cdcfe020727..0bbfce34c30 100644 --- a/libgfortran/generated/maxval_i16.c +++ b/libgfortran/generated/maxval_i16.c @@ -333,4 +333,58 @@ mmaxval_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array, } } + +extern void smaxval_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxval_i16); + +void +smaxval_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxval_i16 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = -GFC_INTEGER_16_HUGE ; +} + #endif diff --git a/libgfortran/generated/maxval_i4.c b/libgfortran/generated/maxval_i4.c index 5f1ba4d65b1..1a66ce30ecc 100644 --- a/libgfortran/generated/maxval_i4.c +++ b/libgfortran/generated/maxval_i4.c @@ -333,4 +333,58 @@ mmaxval_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, } } + +extern void smaxval_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxval_i4); + +void +smaxval_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxval_i4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = -GFC_INTEGER_4_HUGE ; +} + #endif diff --git a/libgfortran/generated/maxval_i8.c b/libgfortran/generated/maxval_i8.c index f1d16f3b389..ef19c83253e 100644 --- a/libgfortran/generated/maxval_i8.c +++ b/libgfortran/generated/maxval_i8.c @@ -333,4 +333,58 @@ mmaxval_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, } } + +extern void smaxval_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxval_i8); + +void +smaxval_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxval_i8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = -GFC_INTEGER_8_HUGE ; +} + #endif diff --git a/libgfortran/generated/maxval_r10.c b/libgfortran/generated/maxval_r10.c index 07c7d7d462a..b99f2176349 100644 --- a/libgfortran/generated/maxval_r10.c +++ b/libgfortran/generated/maxval_r10.c @@ -333,4 +333,58 @@ mmaxval_r10 (gfc_array_r10 * retarray, gfc_array_r10 * array, } } + +extern void smaxval_r10 (gfc_array_r10 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxval_r10); + +void +smaxval_r10 (gfc_array_r10 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_REAL_10 *dest; + + if (*mask) + { + maxval_r10 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_REAL_10) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = -GFC_REAL_10_HUGE ; +} + #endif diff --git a/libgfortran/generated/maxval_r16.c b/libgfortran/generated/maxval_r16.c index 0f8f246fb17..52c35770c67 100644 --- a/libgfortran/generated/maxval_r16.c +++ b/libgfortran/generated/maxval_r16.c @@ -333,4 +333,58 @@ mmaxval_r16 (gfc_array_r16 * retarray, gfc_array_r16 * array, } } + +extern void smaxval_r16 (gfc_array_r16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxval_r16); + +void +smaxval_r16 (gfc_array_r16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_REAL_16 *dest; + + if (*mask) + { + maxval_r16 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_REAL_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = -GFC_REAL_16_HUGE ; +} + #endif diff --git a/libgfortran/generated/maxval_r4.c b/libgfortran/generated/maxval_r4.c index 4d56bbf5b16..a2a8edad306 100644 --- a/libgfortran/generated/maxval_r4.c +++ b/libgfortran/generated/maxval_r4.c @@ -333,4 +333,58 @@ mmaxval_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array, } } + +extern void smaxval_r4 (gfc_array_r4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxval_r4); + +void +smaxval_r4 (gfc_array_r4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_REAL_4 *dest; + + if (*mask) + { + maxval_r4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_REAL_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = -GFC_REAL_4_HUGE ; +} + #endif diff --git a/libgfortran/generated/maxval_r8.c b/libgfortran/generated/maxval_r8.c index d84e18ccd0c..680b9122567 100644 --- a/libgfortran/generated/maxval_r8.c +++ b/libgfortran/generated/maxval_r8.c @@ -333,4 +333,58 @@ mmaxval_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array, } } + +extern void smaxval_r8 (gfc_array_r8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxval_r8); + +void +smaxval_r8 (gfc_array_r8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_REAL_8 *dest; + + if (*mask) + { + maxval_r8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_REAL_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = -GFC_REAL_8_HUGE ; +} + #endif diff --git a/libgfortran/generated/minloc0_16_i16.c b/libgfortran/generated/minloc0_16_i16.c index af097faad01..ac78034856e 100644 --- a/libgfortran/generated/minloc0_16_i16.c +++ b/libgfortran/generated/minloc0_16_i16.c @@ -104,7 +104,7 @@ minloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array) /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_INTEGER_16 minval; @@ -116,7 +116,7 @@ minloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array) { /* Implementation start. */ - if (*base < minval) + if (*base < minval || !dest[0]) { minval = *base; for (n = 0; n < rank; n++) @@ -237,7 +237,7 @@ mminloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 1; + dest[n * dstride] = 0; { GFC_INTEGER_16 minval; @@ -249,7 +249,7 @@ mminloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array, { /* Implementation start. */ - if (*mbase && *base < minval) + if (*mbase && (*base < minval || !dest[0])) { minval = *base; for (n = 0; n < rank; n++) @@ -289,4 +289,56 @@ mminloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array, } } + +extern void sminloc0_16_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_16_i16); + +void +sminloc0_16_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + minloc0_16_i16 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/minloc1_16_i4.c b/libgfortran/generated/minloc1_16_i4.c index b7fe1a0843f..aa0591e2ea7 100644 --- a/libgfortran/generated/minloc1_16_i4.c +++ b/libgfortran/generated/minloc1_16_i4.c @@ -129,7 +129,7 @@ minloc1_16_i4 (gfc_array_i16 *retarray, gfc_array_i4 *array, index_type *pdim) GFC_INTEGER_4 minval; minval = GFC_INTEGER_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ minloc1_16_i4 (gfc_array_i16 *retarray, gfc_array_i4 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src < minval) + if (*src < minval || !result) { minval = *src; result = (GFC_INTEGER_16)n + 1; @@ -293,7 +293,7 @@ mminloc1_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 * array, GFC_INTEGER_4 minval; minval = GFC_INTEGER_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mminloc1_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src < minval) + if (*msrc && (*src < minval || !result)) { minval = *src; result = (GFC_INTEGER_16)n + 1; @@ -344,4 +344,58 @@ mminloc1_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 * array, } } + +extern void sminloc1_16_i4 (gfc_array_i16 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_16_i4); + +void +sminloc1_16_i4 (gfc_array_i16 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_16 *dest; + + if (*mask) + { + minloc1_16_i4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/minloc1_16_i8.c b/libgfortran/generated/minloc1_16_i8.c index 20c17f2a9cb..e7a7bb15431 100644 --- a/libgfortran/generated/minloc1_16_i8.c +++ b/libgfortran/generated/minloc1_16_i8.c @@ -129,7 +129,7 @@ minloc1_16_i8 (gfc_array_i16 *retarray, gfc_array_i8 *array, index_type *pdim) GFC_INTEGER_8 minval; minval = GFC_INTEGER_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ minloc1_16_i8 (gfc_array_i16 *retarray, gfc_array_i8 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src < minval) + if (*src < minval || !result) { minval = *src; result = (GFC_INTEGER_16)n + 1; @@ -293,7 +293,7 @@ mminloc1_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 * array, GFC_INTEGER_8 minval; minval = GFC_INTEGER_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mminloc1_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src < minval) + if (*msrc && (*src < minval || !result)) { minval = *src; result = (GFC_INTEGER_16)n + 1; @@ -344,4 +344,58 @@ mminloc1_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 * array, } } + +extern void sminloc1_16_i8 (gfc_array_i16 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_16_i8); + +void +sminloc1_16_i8 (gfc_array_i16 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_16 *dest; + + if (*mask) + { + minloc1_16_i8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/minloc1_16_r10.c b/libgfortran/generated/minloc1_16_r10.c index 48519c2697e..71e8db0d846 100644 --- a/libgfortran/generated/minloc1_16_r10.c +++ b/libgfortran/generated/minloc1_16_r10.c @@ -129,7 +129,7 @@ minloc1_16_r10 (gfc_array_i16 *retarray, gfc_array_r10 *array, index_type *pdim) GFC_REAL_10 minval; minval = GFC_REAL_10_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ minloc1_16_r10 (gfc_array_i16 *retarray, gfc_array_r10 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src < minval) + if (*src < minval || !result) { minval = *src; result = (GFC_INTEGER_16)n + 1; @@ -293,7 +293,7 @@ mminloc1_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 * array, GFC_REAL_10 minval; minval = GFC_REAL_10_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mminloc1_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src < minval) + if (*msrc && (*src < minval || !result)) { minval = *src; result = (GFC_INTEGER_16)n + 1; @@ -344,4 +344,58 @@ mminloc1_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 * array, } } + +extern void sminloc1_16_r10 (gfc_array_i16 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_16_r10); + +void +sminloc1_16_r10 (gfc_array_i16 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_16 *dest; + + if (*mask) + { + minloc1_16_r10 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/minloc1_16_r16.c b/libgfortran/generated/minloc1_16_r16.c index 41fed8a3067..eb3c09fcf58 100644 --- a/libgfortran/generated/minloc1_16_r16.c +++ b/libgfortran/generated/minloc1_16_r16.c @@ -129,7 +129,7 @@ minloc1_16_r16 (gfc_array_i16 *retarray, gfc_array_r16 *array, index_type *pdim) GFC_REAL_16 minval; minval = GFC_REAL_16_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ minloc1_16_r16 (gfc_array_i16 *retarray, gfc_array_r16 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src < minval) + if (*src < minval || !result) { minval = *src; result = (GFC_INTEGER_16)n + 1; @@ -293,7 +293,7 @@ mminloc1_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 * array, GFC_REAL_16 minval; minval = GFC_REAL_16_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mminloc1_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src < minval) + if (*msrc && (*src < minval || !result)) { minval = *src; result = (GFC_INTEGER_16)n + 1; @@ -344,4 +344,58 @@ mminloc1_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 * array, } } + +extern void sminloc1_16_r16 (gfc_array_i16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_16_r16); + +void +sminloc1_16_r16 (gfc_array_i16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_16 *dest; + + if (*mask) + { + minloc1_16_r16 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/minloc1_16_r4.c b/libgfortran/generated/minloc1_16_r4.c index b3a4017a9f7..99d4591eaad 100644 --- a/libgfortran/generated/minloc1_16_r4.c +++ b/libgfortran/generated/minloc1_16_r4.c @@ -129,7 +129,7 @@ minloc1_16_r4 (gfc_array_i16 *retarray, gfc_array_r4 *array, index_type *pdim) GFC_REAL_4 minval; minval = GFC_REAL_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ minloc1_16_r4 (gfc_array_i16 *retarray, gfc_array_r4 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src < minval) + if (*src < minval || !result) { minval = *src; result = (GFC_INTEGER_16)n + 1; @@ -293,7 +293,7 @@ mminloc1_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 * array, GFC_REAL_4 minval; minval = GFC_REAL_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mminloc1_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src < minval) + if (*msrc && (*src < minval || !result)) { minval = *src; result = (GFC_INTEGER_16)n + 1; @@ -344,4 +344,58 @@ mminloc1_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 * array, } } + +extern void sminloc1_16_r4 (gfc_array_i16 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_16_r4); + +void +sminloc1_16_r4 (gfc_array_i16 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_16 *dest; + + if (*mask) + { + minloc1_16_r4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/minloc1_16_r8.c b/libgfortran/generated/minloc1_16_r8.c index a9a0267aa5a..ffbb7a8758e 100644 --- a/libgfortran/generated/minloc1_16_r8.c +++ b/libgfortran/generated/minloc1_16_r8.c @@ -129,7 +129,7 @@ minloc1_16_r8 (gfc_array_i16 *retarray, gfc_array_r8 *array, index_type *pdim) GFC_REAL_8 minval; minval = GFC_REAL_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ minloc1_16_r8 (gfc_array_i16 *retarray, gfc_array_r8 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src < minval) + if (*src < minval || !result) { minval = *src; result = (GFC_INTEGER_16)n + 1; @@ -293,7 +293,7 @@ mminloc1_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 * array, GFC_REAL_8 minval; minval = GFC_REAL_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mminloc1_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src < minval) + if (*msrc && (*src < minval || !result)) { minval = *src; result = (GFC_INTEGER_16)n + 1; @@ -344,4 +344,58 @@ mminloc1_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 * array, } } + +extern void sminloc1_16_r8 (gfc_array_i16 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_16_r8); + +void +sminloc1_16_r8 (gfc_array_i16 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_16 *dest; + + if (*mask) + { + minloc1_16_r8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/minloc1_4_i16.c b/libgfortran/generated/minloc1_4_i16.c index 3446a1a585c..283171b9dc1 100644 --- a/libgfortran/generated/minloc1_4_i16.c +++ b/libgfortran/generated/minloc1_4_i16.c @@ -129,7 +129,7 @@ minloc1_4_i16 (gfc_array_i4 *retarray, gfc_array_i16 *array, index_type *pdim) GFC_INTEGER_16 minval; minval = GFC_INTEGER_16_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ minloc1_4_i16 (gfc_array_i4 *retarray, gfc_array_i16 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src < minval) + if (*src < minval || !result) { minval = *src; result = (GFC_INTEGER_4)n + 1; @@ -293,7 +293,7 @@ mminloc1_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 * array, GFC_INTEGER_16 minval; minval = GFC_INTEGER_16_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mminloc1_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src < minval) + if (*msrc && (*src < minval || !result)) { minval = *src; result = (GFC_INTEGER_4)n + 1; @@ -344,4 +344,58 @@ mminloc1_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 * array, } } + +extern void sminloc1_4_i16 (gfc_array_i4 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_4_i16); + +void +sminloc1_4_i16 (gfc_array_i4 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_4 *dest; + + if (*mask) + { + minloc1_4_i16 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/minloc1_4_i4.c b/libgfortran/generated/minloc1_4_i4.c index f7207192b1c..fee3caf995c 100644 --- a/libgfortran/generated/minloc1_4_i4.c +++ b/libgfortran/generated/minloc1_4_i4.c @@ -129,7 +129,7 @@ minloc1_4_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim) GFC_INTEGER_4 minval; minval = GFC_INTEGER_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ minloc1_4_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src < minval) + if (*src < minval || !result) { minval = *src; result = (GFC_INTEGER_4)n + 1; @@ -293,7 +293,7 @@ mminloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, GFC_INTEGER_4 minval; minval = GFC_INTEGER_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mminloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src < minval) + if (*msrc && (*src < minval || !result)) { minval = *src; result = (GFC_INTEGER_4)n + 1; @@ -344,4 +344,58 @@ mminloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, } } + +extern void sminloc1_4_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_4_i4); + +void +sminloc1_4_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_4 *dest; + + if (*mask) + { + minloc1_4_i4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/minloc1_4_i8.c b/libgfortran/generated/minloc1_4_i8.c index b049b19d755..67b08751076 100644 --- a/libgfortran/generated/minloc1_4_i8.c +++ b/libgfortran/generated/minloc1_4_i8.c @@ -129,7 +129,7 @@ minloc1_4_i8 (gfc_array_i4 *retarray, gfc_array_i8 *array, index_type *pdim) GFC_INTEGER_8 minval; minval = GFC_INTEGER_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ minloc1_4_i8 (gfc_array_i4 *retarray, gfc_array_i8 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src < minval) + if (*src < minval || !result) { minval = *src; result = (GFC_INTEGER_4)n + 1; @@ -293,7 +293,7 @@ mminloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 * array, GFC_INTEGER_8 minval; minval = GFC_INTEGER_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mminloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src < minval) + if (*msrc && (*src < minval || !result)) { minval = *src; result = (GFC_INTEGER_4)n + 1; @@ -344,4 +344,58 @@ mminloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 * array, } } + +extern void sminloc1_4_i8 (gfc_array_i4 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_4_i8); + +void +sminloc1_4_i8 (gfc_array_i4 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_4 *dest; + + if (*mask) + { + minloc1_4_i8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/minloc1_4_r10.c b/libgfortran/generated/minloc1_4_r10.c index 983db754f5f..f71359a15c6 100644 --- a/libgfortran/generated/minloc1_4_r10.c +++ b/libgfortran/generated/minloc1_4_r10.c @@ -129,7 +129,7 @@ minloc1_4_r10 (gfc_array_i4 *retarray, gfc_array_r10 *array, index_type *pdim) GFC_REAL_10 minval; minval = GFC_REAL_10_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ minloc1_4_r10 (gfc_array_i4 *retarray, gfc_array_r10 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src < minval) + if (*src < minval || !result) { minval = *src; result = (GFC_INTEGER_4)n + 1; @@ -293,7 +293,7 @@ mminloc1_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 * array, GFC_REAL_10 minval; minval = GFC_REAL_10_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mminloc1_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src < minval) + if (*msrc && (*src < minval || !result)) { minval = *src; result = (GFC_INTEGER_4)n + 1; @@ -344,4 +344,58 @@ mminloc1_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 * array, } } + +extern void sminloc1_4_r10 (gfc_array_i4 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_4_r10); + +void +sminloc1_4_r10 (gfc_array_i4 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_4 *dest; + + if (*mask) + { + minloc1_4_r10 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/minloc1_4_r16.c b/libgfortran/generated/minloc1_4_r16.c index 68f142125c9..23faf327dd6 100644 --- a/libgfortran/generated/minloc1_4_r16.c +++ b/libgfortran/generated/minloc1_4_r16.c @@ -129,7 +129,7 @@ minloc1_4_r16 (gfc_array_i4 *retarray, gfc_array_r16 *array, index_type *pdim) GFC_REAL_16 minval; minval = GFC_REAL_16_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ minloc1_4_r16 (gfc_array_i4 *retarray, gfc_array_r16 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src < minval) + if (*src < minval || !result) { minval = *src; result = (GFC_INTEGER_4)n + 1; @@ -293,7 +293,7 @@ mminloc1_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 * array, GFC_REAL_16 minval; minval = GFC_REAL_16_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mminloc1_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src < minval) + if (*msrc && (*src < minval || !result)) { minval = *src; result = (GFC_INTEGER_4)n + 1; @@ -344,4 +344,58 @@ mminloc1_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 * array, } } + +extern void sminloc1_4_r16 (gfc_array_i4 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_4_r16); + +void +sminloc1_4_r16 (gfc_array_i4 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_4 *dest; + + if (*mask) + { + minloc1_4_r16 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/minloc1_4_r4.c b/libgfortran/generated/minloc1_4_r4.c index e7191fd4de4..9555c131328 100644 --- a/libgfortran/generated/minloc1_4_r4.c +++ b/libgfortran/generated/minloc1_4_r4.c @@ -129,7 +129,7 @@ minloc1_4_r4 (gfc_array_i4 *retarray, gfc_array_r4 *array, index_type *pdim) GFC_REAL_4 minval; minval = GFC_REAL_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ minloc1_4_r4 (gfc_array_i4 *retarray, gfc_array_r4 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src < minval) + if (*src < minval || !result) { minval = *src; result = (GFC_INTEGER_4)n + 1; @@ -293,7 +293,7 @@ mminloc1_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 * array, GFC_REAL_4 minval; minval = GFC_REAL_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mminloc1_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src < minval) + if (*msrc && (*src < minval || !result)) { minval = *src; result = (GFC_INTEGER_4)n + 1; @@ -344,4 +344,58 @@ mminloc1_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 * array, } } + +extern void sminloc1_4_r4 (gfc_array_i4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_4_r4); + +void +sminloc1_4_r4 (gfc_array_i4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_4 *dest; + + if (*mask) + { + minloc1_4_r4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/minloc1_4_r8.c b/libgfortran/generated/minloc1_4_r8.c index 9d4c981cdc7..2b63060db32 100644 --- a/libgfortran/generated/minloc1_4_r8.c +++ b/libgfortran/generated/minloc1_4_r8.c @@ -129,7 +129,7 @@ minloc1_4_r8 (gfc_array_i4 *retarray, gfc_array_r8 *array, index_type *pdim) GFC_REAL_8 minval; minval = GFC_REAL_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ minloc1_4_r8 (gfc_array_i4 *retarray, gfc_array_r8 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src < minval) + if (*src < minval || !result) { minval = *src; result = (GFC_INTEGER_4)n + 1; @@ -293,7 +293,7 @@ mminloc1_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 * array, GFC_REAL_8 minval; minval = GFC_REAL_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mminloc1_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src < minval) + if (*msrc && (*src < minval || !result)) { minval = *src; result = (GFC_INTEGER_4)n + 1; @@ -344,4 +344,58 @@ mminloc1_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 * array, } } + +extern void sminloc1_4_r8 (gfc_array_i4 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_4_r8); + +void +sminloc1_4_r8 (gfc_array_i4 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_4 *dest; + + if (*mask) + { + minloc1_4_r8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/minloc1_8_i16.c b/libgfortran/generated/minloc1_8_i16.c index 13c2cb74a42..5f3c36f5687 100644 --- a/libgfortran/generated/minloc1_8_i16.c +++ b/libgfortran/generated/minloc1_8_i16.c @@ -129,7 +129,7 @@ minloc1_8_i16 (gfc_array_i8 *retarray, gfc_array_i16 *array, index_type *pdim) GFC_INTEGER_16 minval; minval = GFC_INTEGER_16_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ minloc1_8_i16 (gfc_array_i8 *retarray, gfc_array_i16 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src < minval) + if (*src < minval || !result) { minval = *src; result = (GFC_INTEGER_8)n + 1; @@ -293,7 +293,7 @@ mminloc1_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 * array, GFC_INTEGER_16 minval; minval = GFC_INTEGER_16_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mminloc1_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src < minval) + if (*msrc && (*src < minval || !result)) { minval = *src; result = (GFC_INTEGER_8)n + 1; @@ -344,4 +344,58 @@ mminloc1_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 * array, } } + +extern void sminloc1_8_i16 (gfc_array_i8 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_8_i16); + +void +sminloc1_8_i16 (gfc_array_i8 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_8 *dest; + + if (*mask) + { + minloc1_8_i16 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/minloc1_8_i4.c b/libgfortran/generated/minloc1_8_i4.c index f682c10936c..8947d6f1c41 100644 --- a/libgfortran/generated/minloc1_8_i4.c +++ b/libgfortran/generated/minloc1_8_i4.c @@ -129,7 +129,7 @@ minloc1_8_i4 (gfc_array_i8 *retarray, gfc_array_i4 *array, index_type *pdim) GFC_INTEGER_4 minval; minval = GFC_INTEGER_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ minloc1_8_i4 (gfc_array_i8 *retarray, gfc_array_i4 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src < minval) + if (*src < minval || !result) { minval = *src; result = (GFC_INTEGER_8)n + 1; @@ -293,7 +293,7 @@ mminloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 * array, GFC_INTEGER_4 minval; minval = GFC_INTEGER_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mminloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src < minval) + if (*msrc && (*src < minval || !result)) { minval = *src; result = (GFC_INTEGER_8)n + 1; @@ -344,4 +344,58 @@ mminloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 * array, } } + +extern void sminloc1_8_i4 (gfc_array_i8 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_8_i4); + +void +sminloc1_8_i4 (gfc_array_i8 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_8 *dest; + + if (*mask) + { + minloc1_8_i4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/minloc1_8_i8.c b/libgfortran/generated/minloc1_8_i8.c index 9a2a5231b5a..c16dad93579 100644 --- a/libgfortran/generated/minloc1_8_i8.c +++ b/libgfortran/generated/minloc1_8_i8.c @@ -129,7 +129,7 @@ minloc1_8_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim) GFC_INTEGER_8 minval; minval = GFC_INTEGER_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ minloc1_8_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src < minval) + if (*src < minval || !result) { minval = *src; result = (GFC_INTEGER_8)n + 1; @@ -293,7 +293,7 @@ mminloc1_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, GFC_INTEGER_8 minval; minval = GFC_INTEGER_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mminloc1_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src < minval) + if (*msrc && (*src < minval || !result)) { minval = *src; result = (GFC_INTEGER_8)n + 1; @@ -344,4 +344,58 @@ mminloc1_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, } } + +extern void sminloc1_8_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_8_i8); + +void +sminloc1_8_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_8 *dest; + + if (*mask) + { + minloc1_8_i8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/minloc1_8_r10.c b/libgfortran/generated/minloc1_8_r10.c index 2058453584a..6f2fbf8e81e 100644 --- a/libgfortran/generated/minloc1_8_r10.c +++ b/libgfortran/generated/minloc1_8_r10.c @@ -129,7 +129,7 @@ minloc1_8_r10 (gfc_array_i8 *retarray, gfc_array_r10 *array, index_type *pdim) GFC_REAL_10 minval; minval = GFC_REAL_10_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ minloc1_8_r10 (gfc_array_i8 *retarray, gfc_array_r10 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src < minval) + if (*src < minval || !result) { minval = *src; result = (GFC_INTEGER_8)n + 1; @@ -293,7 +293,7 @@ mminloc1_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 * array, GFC_REAL_10 minval; minval = GFC_REAL_10_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mminloc1_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src < minval) + if (*msrc && (*src < minval || !result)) { minval = *src; result = (GFC_INTEGER_8)n + 1; @@ -344,4 +344,58 @@ mminloc1_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 * array, } } + +extern void sminloc1_8_r10 (gfc_array_i8 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_8_r10); + +void +sminloc1_8_r10 (gfc_array_i8 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_8 *dest; + + if (*mask) + { + minloc1_8_r10 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/minloc1_8_r16.c b/libgfortran/generated/minloc1_8_r16.c index e417f620ba6..96e1842da91 100644 --- a/libgfortran/generated/minloc1_8_r16.c +++ b/libgfortran/generated/minloc1_8_r16.c @@ -129,7 +129,7 @@ minloc1_8_r16 (gfc_array_i8 *retarray, gfc_array_r16 *array, index_type *pdim) GFC_REAL_16 minval; minval = GFC_REAL_16_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ minloc1_8_r16 (gfc_array_i8 *retarray, gfc_array_r16 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src < minval) + if (*src < minval || !result) { minval = *src; result = (GFC_INTEGER_8)n + 1; @@ -293,7 +293,7 @@ mminloc1_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 * array, GFC_REAL_16 minval; minval = GFC_REAL_16_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mminloc1_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src < minval) + if (*msrc && (*src < minval || !result)) { minval = *src; result = (GFC_INTEGER_8)n + 1; @@ -344,4 +344,58 @@ mminloc1_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 * array, } } + +extern void sminloc1_8_r16 (gfc_array_i8 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_8_r16); + +void +sminloc1_8_r16 (gfc_array_i8 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_8 *dest; + + if (*mask) + { + minloc1_8_r16 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/minloc1_8_r4.c b/libgfortran/generated/minloc1_8_r4.c index 8f154dce275..6436d1d40ce 100644 --- a/libgfortran/generated/minloc1_8_r4.c +++ b/libgfortran/generated/minloc1_8_r4.c @@ -129,7 +129,7 @@ minloc1_8_r4 (gfc_array_i8 *retarray, gfc_array_r4 *array, index_type *pdim) GFC_REAL_4 minval; minval = GFC_REAL_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ minloc1_8_r4 (gfc_array_i8 *retarray, gfc_array_r4 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src < minval) + if (*src < minval || !result) { minval = *src; result = (GFC_INTEGER_8)n + 1; @@ -293,7 +293,7 @@ mminloc1_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 * array, GFC_REAL_4 minval; minval = GFC_REAL_4_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mminloc1_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src < minval) + if (*msrc && (*src < minval || !result)) { minval = *src; result = (GFC_INTEGER_8)n + 1; @@ -344,4 +344,58 @@ mminloc1_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 * array, } } + +extern void sminloc1_8_r4 (gfc_array_i8 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_8_r4); + +void +sminloc1_8_r4 (gfc_array_i8 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_8 *dest; + + if (*mask) + { + minloc1_8_r4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/minloc1_8_r8.c b/libgfortran/generated/minloc1_8_r8.c index 20a757a9217..2f9dfd74ecf 100644 --- a/libgfortran/generated/minloc1_8_r8.c +++ b/libgfortran/generated/minloc1_8_r8.c @@ -129,7 +129,7 @@ minloc1_8_r8 (gfc_array_i8 *retarray, gfc_array_r8 *array, index_type *pdim) GFC_REAL_8 minval; minval = GFC_REAL_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -137,7 +137,7 @@ minloc1_8_r8 (gfc_array_i8 *retarray, gfc_array_r8 *array, index_type *pdim) for (n = 0; n < len; n++, src += delta) { - if (*src < minval) + if (*src < minval || !result) { minval = *src; result = (GFC_INTEGER_8)n + 1; @@ -293,7 +293,7 @@ mminloc1_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 * array, GFC_REAL_8 minval; minval = GFC_REAL_8_HUGE; - result = 1; + result = 0; if (len <= 0) *dest = 0; else @@ -301,7 +301,7 @@ mminloc1_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 * array, for (n = 0; n < len; n++, src += delta, msrc += mdelta) { - if (*msrc && *src < minval) + if (*msrc && (*src < minval || !result)) { minval = *src; result = (GFC_INTEGER_8)n + 1; @@ -344,4 +344,58 @@ mminloc1_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 * array, } } + +extern void sminloc1_8_r8 (gfc_array_i8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_8_r8); + +void +sminloc1_8_r8 (gfc_array_i8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_8 *dest; + + if (*mask) + { + minloc1_8_r8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/minval_i16.c b/libgfortran/generated/minval_i16.c index 34963ae9725..58c8c879dc9 100644 --- a/libgfortran/generated/minval_i16.c +++ b/libgfortran/generated/minval_i16.c @@ -333,4 +333,58 @@ mminval_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array, } } + +extern void sminval_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminval_i16); + +void +sminval_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_16 *dest; + + if (*mask) + { + minval_i16 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = GFC_INTEGER_16_HUGE ; +} + #endif diff --git a/libgfortran/generated/minval_i4.c b/libgfortran/generated/minval_i4.c index 826d2e902e2..ca20596c564 100644 --- a/libgfortran/generated/minval_i4.c +++ b/libgfortran/generated/minval_i4.c @@ -333,4 +333,58 @@ mminval_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, } } + +extern void sminval_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminval_i4); + +void +sminval_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_4 *dest; + + if (*mask) + { + minval_i4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = GFC_INTEGER_4_HUGE ; +} + #endif diff --git a/libgfortran/generated/minval_i8.c b/libgfortran/generated/minval_i8.c index e58a97ba90d..908c8779f11 100644 --- a/libgfortran/generated/minval_i8.c +++ b/libgfortran/generated/minval_i8.c @@ -333,4 +333,58 @@ mminval_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, } } + +extern void sminval_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminval_i8); + +void +sminval_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_8 *dest; + + if (*mask) + { + minval_i8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = GFC_INTEGER_8_HUGE ; +} + #endif diff --git a/libgfortran/generated/minval_r10.c b/libgfortran/generated/minval_r10.c index ec494fba168..edcb9fc054f 100644 --- a/libgfortran/generated/minval_r10.c +++ b/libgfortran/generated/minval_r10.c @@ -333,4 +333,58 @@ mminval_r10 (gfc_array_r10 * retarray, gfc_array_r10 * array, } } + +extern void sminval_r10 (gfc_array_r10 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminval_r10); + +void +sminval_r10 (gfc_array_r10 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_REAL_10 *dest; + + if (*mask) + { + minval_r10 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_REAL_10) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = GFC_REAL_10_HUGE ; +} + #endif diff --git a/libgfortran/generated/minval_r16.c b/libgfortran/generated/minval_r16.c index d71b00756de..2a4dbfc0ab0 100644 --- a/libgfortran/generated/minval_r16.c +++ b/libgfortran/generated/minval_r16.c @@ -333,4 +333,58 @@ mminval_r16 (gfc_array_r16 * retarray, gfc_array_r16 * array, } } + +extern void sminval_r16 (gfc_array_r16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminval_r16); + +void +sminval_r16 (gfc_array_r16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_REAL_16 *dest; + + if (*mask) + { + minval_r16 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_REAL_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = GFC_REAL_16_HUGE ; +} + #endif diff --git a/libgfortran/generated/minval_r4.c b/libgfortran/generated/minval_r4.c index 8228f991fcb..468a0fcb028 100644 --- a/libgfortran/generated/minval_r4.c +++ b/libgfortran/generated/minval_r4.c @@ -333,4 +333,58 @@ mminval_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array, } } + +extern void sminval_r4 (gfc_array_r4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminval_r4); + +void +sminval_r4 (gfc_array_r4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_REAL_4 *dest; + + if (*mask) + { + minval_r4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_REAL_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = GFC_REAL_4_HUGE ; +} + #endif diff --git a/libgfortran/generated/minval_r8.c b/libgfortran/generated/minval_r8.c index 81a8b2127e8..265f5577e4a 100644 --- a/libgfortran/generated/minval_r8.c +++ b/libgfortran/generated/minval_r8.c @@ -333,4 +333,58 @@ mminval_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array, } } + +extern void sminval_r8 (gfc_array_r8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminval_r8); + +void +sminval_r8 (gfc_array_r8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_REAL_8 *dest; + + if (*mask) + { + minval_r8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_REAL_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = GFC_REAL_8_HUGE ; +} + #endif diff --git a/libgfortran/generated/product_c10.c b/libgfortran/generated/product_c10.c index 0313c712626..ad6db2685c0 100644 --- a/libgfortran/generated/product_c10.c +++ b/libgfortran/generated/product_c10.c @@ -331,4 +331,58 @@ mproduct_c10 (gfc_array_c10 * retarray, gfc_array_c10 * array, } } + +extern void sproduct_c10 (gfc_array_c10 * const restrict, + gfc_array_c10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_c10); + +void +sproduct_c10 (gfc_array_c10 * const restrict retarray, + gfc_array_c10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_COMPLEX_10 *dest; + + if (*mask) + { + product_c10 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_COMPLEX_10) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 1 ; +} + #endif diff --git a/libgfortran/generated/product_c16.c b/libgfortran/generated/product_c16.c index 866ed451134..b3a468a841c 100644 --- a/libgfortran/generated/product_c16.c +++ b/libgfortran/generated/product_c16.c @@ -331,4 +331,58 @@ mproduct_c16 (gfc_array_c16 * retarray, gfc_array_c16 * array, } } + +extern void sproduct_c16 (gfc_array_c16 * const restrict, + gfc_array_c16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_c16); + +void +sproduct_c16 (gfc_array_c16 * const restrict retarray, + gfc_array_c16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_COMPLEX_16 *dest; + + if (*mask) + { + product_c16 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_COMPLEX_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 1 ; +} + #endif diff --git a/libgfortran/generated/product_c4.c b/libgfortran/generated/product_c4.c index 42fb1ed2c6c..9277812f394 100644 --- a/libgfortran/generated/product_c4.c +++ b/libgfortran/generated/product_c4.c @@ -331,4 +331,58 @@ mproduct_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array, } } + +extern void sproduct_c4 (gfc_array_c4 * const restrict, + gfc_array_c4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_c4); + +void +sproduct_c4 (gfc_array_c4 * const restrict retarray, + gfc_array_c4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_COMPLEX_4 *dest; + + if (*mask) + { + product_c4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_COMPLEX_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 1 ; +} + #endif diff --git a/libgfortran/generated/product_c8.c b/libgfortran/generated/product_c8.c index c554c513fb9..459a593553f 100644 --- a/libgfortran/generated/product_c8.c +++ b/libgfortran/generated/product_c8.c @@ -331,4 +331,58 @@ mproduct_c8 (gfc_array_c8 * retarray, gfc_array_c8 * array, } } + +extern void sproduct_c8 (gfc_array_c8 * const restrict, + gfc_array_c8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_c8); + +void +sproduct_c8 (gfc_array_c8 * const restrict retarray, + gfc_array_c8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_COMPLEX_8 *dest; + + if (*mask) + { + product_c8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_COMPLEX_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 1 ; +} + #endif diff --git a/libgfortran/generated/product_i16.c b/libgfortran/generated/product_i16.c index 3c2aa9e4fba..6da2d5a29bb 100644 --- a/libgfortran/generated/product_i16.c +++ b/libgfortran/generated/product_i16.c @@ -331,4 +331,58 @@ mproduct_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array, } } + +extern void sproduct_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_i16); + +void +sproduct_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_16 *dest; + + if (*mask) + { + product_i16 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 1 ; +} + #endif diff --git a/libgfortran/generated/product_i4.c b/libgfortran/generated/product_i4.c index 3620d8da203..d0e72e6872c 100644 --- a/libgfortran/generated/product_i4.c +++ b/libgfortran/generated/product_i4.c @@ -331,4 +331,58 @@ mproduct_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, } } + +extern void sproduct_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_i4); + +void +sproduct_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_4 *dest; + + if (*mask) + { + product_i4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 1 ; +} + #endif diff --git a/libgfortran/generated/product_i8.c b/libgfortran/generated/product_i8.c index 65b0bb0fc42..eedf14ded43 100644 --- a/libgfortran/generated/product_i8.c +++ b/libgfortran/generated/product_i8.c @@ -331,4 +331,58 @@ mproduct_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, } } + +extern void sproduct_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_i8); + +void +sproduct_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_8 *dest; + + if (*mask) + { + product_i8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 1 ; +} + #endif diff --git a/libgfortran/generated/product_r10.c b/libgfortran/generated/product_r10.c index 292bbaa9726..b202aa125a4 100644 --- a/libgfortran/generated/product_r10.c +++ b/libgfortran/generated/product_r10.c @@ -331,4 +331,58 @@ mproduct_r10 (gfc_array_r10 * retarray, gfc_array_r10 * array, } } + +extern void sproduct_r10 (gfc_array_r10 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_r10); + +void +sproduct_r10 (gfc_array_r10 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_REAL_10 *dest; + + if (*mask) + { + product_r10 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_REAL_10) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 1 ; +} + #endif diff --git a/libgfortran/generated/product_r16.c b/libgfortran/generated/product_r16.c index f0a2c9818bb..321542e2fb5 100644 --- a/libgfortran/generated/product_r16.c +++ b/libgfortran/generated/product_r16.c @@ -331,4 +331,58 @@ mproduct_r16 (gfc_array_r16 * retarray, gfc_array_r16 * array, } } + +extern void sproduct_r16 (gfc_array_r16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_r16); + +void +sproduct_r16 (gfc_array_r16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_REAL_16 *dest; + + if (*mask) + { + product_r16 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_REAL_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 1 ; +} + #endif diff --git a/libgfortran/generated/product_r4.c b/libgfortran/generated/product_r4.c index 6ca9ff84cf2..198d4769770 100644 --- a/libgfortran/generated/product_r4.c +++ b/libgfortran/generated/product_r4.c @@ -331,4 +331,58 @@ mproduct_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array, } } + +extern void sproduct_r4 (gfc_array_r4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_r4); + +void +sproduct_r4 (gfc_array_r4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_REAL_4 *dest; + + if (*mask) + { + product_r4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_REAL_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 1 ; +} + #endif diff --git a/libgfortran/generated/product_r8.c b/libgfortran/generated/product_r8.c index d73ccc7b0e0..aa9f358d581 100644 --- a/libgfortran/generated/product_r8.c +++ b/libgfortran/generated/product_r8.c @@ -331,4 +331,58 @@ mproduct_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array, } } + +extern void sproduct_r8 (gfc_array_r8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_r8); + +void +sproduct_r8 (gfc_array_r8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_REAL_8 *dest; + + if (*mask) + { + product_r8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_REAL_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 1 ; +} + #endif diff --git a/libgfortran/generated/sum_c10.c b/libgfortran/generated/sum_c10.c index 655529a7fe9..9452db35e8d 100644 --- a/libgfortran/generated/sum_c10.c +++ b/libgfortran/generated/sum_c10.c @@ -331,4 +331,58 @@ msum_c10 (gfc_array_c10 * retarray, gfc_array_c10 * array, } } + +extern void ssum_c10 (gfc_array_c10 * const restrict, + gfc_array_c10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_c10); + +void +ssum_c10 (gfc_array_c10 * const restrict retarray, + gfc_array_c10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_COMPLEX_10 *dest; + + if (*mask) + { + sum_c10 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_COMPLEX_10) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/sum_c16.c b/libgfortran/generated/sum_c16.c index ee40ba5149c..8331692f991 100644 --- a/libgfortran/generated/sum_c16.c +++ b/libgfortran/generated/sum_c16.c @@ -331,4 +331,58 @@ msum_c16 (gfc_array_c16 * retarray, gfc_array_c16 * array, } } + +extern void ssum_c16 (gfc_array_c16 * const restrict, + gfc_array_c16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_c16); + +void +ssum_c16 (gfc_array_c16 * const restrict retarray, + gfc_array_c16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_COMPLEX_16 *dest; + + if (*mask) + { + sum_c16 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_COMPLEX_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/sum_c4.c b/libgfortran/generated/sum_c4.c index bb08a4b558d..f7da6de8148 100644 --- a/libgfortran/generated/sum_c4.c +++ b/libgfortran/generated/sum_c4.c @@ -331,4 +331,58 @@ msum_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array, } } + +extern void ssum_c4 (gfc_array_c4 * const restrict, + gfc_array_c4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_c4); + +void +ssum_c4 (gfc_array_c4 * const restrict retarray, + gfc_array_c4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_COMPLEX_4 *dest; + + if (*mask) + { + sum_c4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_COMPLEX_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/sum_c8.c b/libgfortran/generated/sum_c8.c index fd8e3560aa3..92192f103dc 100644 --- a/libgfortran/generated/sum_c8.c +++ b/libgfortran/generated/sum_c8.c @@ -331,4 +331,58 @@ msum_c8 (gfc_array_c8 * retarray, gfc_array_c8 * array, } } + +extern void ssum_c8 (gfc_array_c8 * const restrict, + gfc_array_c8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_c8); + +void +ssum_c8 (gfc_array_c8 * const restrict retarray, + gfc_array_c8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_COMPLEX_8 *dest; + + if (*mask) + { + sum_c8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_COMPLEX_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/sum_i16.c b/libgfortran/generated/sum_i16.c index b1ba2353fb9..50eff88aa55 100644 --- a/libgfortran/generated/sum_i16.c +++ b/libgfortran/generated/sum_i16.c @@ -331,4 +331,58 @@ msum_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array, } } + +extern void ssum_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_i16); + +void +ssum_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_16 *dest; + + if (*mask) + { + sum_i16 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/sum_i4.c b/libgfortran/generated/sum_i4.c index 1efb59e134e..c2a8583ccd5 100644 --- a/libgfortran/generated/sum_i4.c +++ b/libgfortran/generated/sum_i4.c @@ -331,4 +331,58 @@ msum_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, } } + +extern void ssum_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_i4); + +void +ssum_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_4 *dest; + + if (*mask) + { + sum_i4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/sum_i8.c b/libgfortran/generated/sum_i8.c index a7c3d2f6b83..80d76d78b34 100644 --- a/libgfortran/generated/sum_i8.c +++ b/libgfortran/generated/sum_i8.c @@ -331,4 +331,58 @@ msum_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, } } + +extern void ssum_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_i8); + +void +ssum_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_INTEGER_8 *dest; + + if (*mask) + { + sum_i8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/sum_r10.c b/libgfortran/generated/sum_r10.c index e0231ca645b..876ded1d9ce 100644 --- a/libgfortran/generated/sum_r10.c +++ b/libgfortran/generated/sum_r10.c @@ -331,4 +331,58 @@ msum_r10 (gfc_array_r10 * retarray, gfc_array_r10 * array, } } + +extern void ssum_r10 (gfc_array_r10 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_r10); + +void +ssum_r10 (gfc_array_r10 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_REAL_10 *dest; + + if (*mask) + { + sum_r10 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_REAL_10) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/sum_r16.c b/libgfortran/generated/sum_r16.c index 4168f8c0669..2a5bb5f83bc 100644 --- a/libgfortran/generated/sum_r16.c +++ b/libgfortran/generated/sum_r16.c @@ -331,4 +331,58 @@ msum_r16 (gfc_array_r16 * retarray, gfc_array_r16 * array, } } + +extern void ssum_r16 (gfc_array_r16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_r16); + +void +ssum_r16 (gfc_array_r16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_REAL_16 *dest; + + if (*mask) + { + sum_r16 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_REAL_16) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/sum_r4.c b/libgfortran/generated/sum_r4.c index bf76631811a..546fbfe08fa 100644 --- a/libgfortran/generated/sum_r4.c +++ b/libgfortran/generated/sum_r4.c @@ -331,4 +331,58 @@ msum_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array, } } + +extern void ssum_r4 (gfc_array_r4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_r4); + +void +ssum_r4 (gfc_array_r4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_REAL_4 *dest; + + if (*mask) + { + sum_r4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_REAL_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif diff --git a/libgfortran/generated/sum_r8.c b/libgfortran/generated/sum_r8.c index c6d0546b2c3..2cd42cc157a 100644 --- a/libgfortran/generated/sum_r8.c +++ b/libgfortran/generated/sum_r8.c @@ -331,4 +331,58 @@ msum_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array, } } + +extern void ssum_r8 (gfc_array_r8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_r8); + +void +ssum_r8 (gfc_array_r8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type n; + index_type dstride; + GFC_REAL_8 *dest; + + if (*mask) + { + sum_r8 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_REAL_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 0 ; +} + #endif -- cgit v1.2.1