re PR fortran/20935 (failed assertion for maxloc(n, mask=.true.))
2006-03-20 Thomas Koenig <Thomas.Koenig@online.de> PR fortran/20935 * 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-20 Thomas Koenig <Thomas.Koenig@online.de> PR fortran/20935 * 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-20 Thomas Koenig <Thomas.Koenig@online.de> PR fortran/20935 * gfortran.dg/scalar_mask_2.f90: New test case. From-SVN: r112230
This commit is contained in:
parent
ede497cfbd
commit
97a6203866
@ -1,3 +1,16 @@
|
||||
2006-03-20 Thomas Koenig <Thomas.Koenig@online.de>
|
||||
|
||||
PR fortran/20935
|
||||
* 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-19 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/26741
|
||||
|
@ -1093,7 +1093,27 @@ gfc_resolve_maxloc (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
|
||||
gfc_resolve_dim_arg (dim);
|
||||
}
|
||||
|
||||
name = mask ? "mmaxloc" : "maxloc";
|
||||
if (mask)
|
||||
{
|
||||
if (mask->rank == 0)
|
||||
name = "smaxloc";
|
||||
else
|
||||
name = "mmaxloc";
|
||||
|
||||
/* The mask can be kind 4 or 8 for the array case. For the
|
||||
scalar case, coerce it to default kind unconditionally. */
|
||||
if ((mask->ts.kind < gfc_default_logical_kind)
|
||||
|| (mask->rank == 0 && mask->ts.kind != gfc_default_logical_kind))
|
||||
{
|
||||
gfc_typespec ts;
|
||||
ts.type = BT_LOGICAL;
|
||||
ts.kind = gfc_default_logical_kind;
|
||||
gfc_convert_type_warn (mask, &ts, 2, 0);
|
||||
}
|
||||
}
|
||||
else
|
||||
name = "maxloc";
|
||||
|
||||
f->value.function.name =
|
||||
gfc_get_string (PREFIX("%s%d_%d_%c%d"), name, dim != NULL, f->ts.kind,
|
||||
gfc_type_letter (array->ts.type), array->ts.kind);
|
||||
@ -1104,6 +1124,8 @@ void
|
||||
gfc_resolve_maxval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
|
||||
gfc_expr * mask)
|
||||
{
|
||||
const char *name;
|
||||
|
||||
f->ts = array->ts;
|
||||
|
||||
if (dim != NULL)
|
||||
@ -1112,8 +1134,29 @@ gfc_resolve_maxval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
|
||||
gfc_resolve_dim_arg (dim);
|
||||
}
|
||||
|
||||
if (mask)
|
||||
{
|
||||
if (mask->rank == 0)
|
||||
name = "smaxval";
|
||||
else
|
||||
name = "mmaxval";
|
||||
|
||||
/* The mask can be kind 4 or 8 for the array case. For the
|
||||
scalar case, coerce it to default kind unconditionally. */
|
||||
if ((mask->ts.kind < gfc_default_logical_kind)
|
||||
|| (mask->rank == 0 && mask->ts.kind != gfc_default_logical_kind))
|
||||
{
|
||||
gfc_typespec ts;
|
||||
ts.type = BT_LOGICAL;
|
||||
ts.kind = gfc_default_logical_kind;
|
||||
gfc_convert_type_warn (mask, &ts, 2, 0);
|
||||
}
|
||||
}
|
||||
else
|
||||
name = "maxval";
|
||||
|
||||
f->value.function.name =
|
||||
gfc_get_string (PREFIX("%s_%c%d"), mask ? "mmaxval" : "maxval",
|
||||
gfc_get_string (PREFIX("%s_%c%d"), name,
|
||||
gfc_type_letter (array->ts.type), array->ts.kind);
|
||||
}
|
||||
|
||||
@ -1157,7 +1200,27 @@ gfc_resolve_minloc (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
|
||||
gfc_resolve_dim_arg (dim);
|
||||
}
|
||||
|
||||
name = mask ? "mminloc" : "minloc";
|
||||
if (mask)
|
||||
{
|
||||
if (mask->rank == 0)
|
||||
name = "sminloc";
|
||||
else
|
||||
name = "mminloc";
|
||||
|
||||
/* The mask can be kind 4 or 8 for the array case. For the
|
||||
scalar case, coerce it to default kind unconditionally. */
|
||||
if ((mask->ts.kind < gfc_default_logical_kind)
|
||||
|| (mask->rank == 0 && mask->ts.kind != gfc_default_logical_kind))
|
||||
{
|
||||
gfc_typespec ts;
|
||||
ts.type = BT_LOGICAL;
|
||||
ts.kind = gfc_default_logical_kind;
|
||||
gfc_convert_type_warn (mask, &ts, 2, 0);
|
||||
}
|
||||
}
|
||||
else
|
||||
name = "minloc";
|
||||
|
||||
f->value.function.name =
|
||||
gfc_get_string (PREFIX("%s%d_%d_%c%d"), name, dim != NULL, f->ts.kind,
|
||||
gfc_type_letter (array->ts.type), array->ts.kind);
|
||||
@ -1168,6 +1231,8 @@ void
|
||||
gfc_resolve_minval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
|
||||
gfc_expr * mask)
|
||||
{
|
||||
const char *name;
|
||||
|
||||
f->ts = array->ts;
|
||||
|
||||
if (dim != NULL)
|
||||
@ -1176,8 +1241,29 @@ gfc_resolve_minval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
|
||||
gfc_resolve_dim_arg (dim);
|
||||
}
|
||||
|
||||
if (mask)
|
||||
{
|
||||
if (mask->rank == 0)
|
||||
name = "sminval";
|
||||
else
|
||||
name = "mminval";
|
||||
|
||||
/* The mask can be kind 4 or 8 for the array case. For the
|
||||
scalar case, coerce it to default kind unconditionally. */
|
||||
if ((mask->ts.kind < gfc_default_logical_kind)
|
||||
|| (mask->rank == 0 && mask->ts.kind != gfc_default_logical_kind))
|
||||
{
|
||||
gfc_typespec ts;
|
||||
ts.type = BT_LOGICAL;
|
||||
ts.kind = gfc_default_logical_kind;
|
||||
gfc_convert_type_warn (mask, &ts, 2, 0);
|
||||
}
|
||||
}
|
||||
else
|
||||
name = "minval";
|
||||
|
||||
f->value.function.name =
|
||||
gfc_get_string (PREFIX("%s_%c%d"), mask ? "mminval" : "minval",
|
||||
gfc_get_string (PREFIX("%s_%c%d"), name,
|
||||
gfc_type_letter (array->ts.type), array->ts.kind);
|
||||
}
|
||||
|
||||
@ -1311,6 +1397,8 @@ void
|
||||
gfc_resolve_product (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
|
||||
gfc_expr * mask)
|
||||
{
|
||||
const char *name;
|
||||
|
||||
f->ts = array->ts;
|
||||
|
||||
if (dim != NULL)
|
||||
@ -1319,8 +1407,29 @@ gfc_resolve_product (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
|
||||
gfc_resolve_dim_arg (dim);
|
||||
}
|
||||
|
||||
if (mask)
|
||||
{
|
||||
if (mask->rank == 0)
|
||||
name = "sproduct";
|
||||
else
|
||||
name = "mproduct";
|
||||
|
||||
/* The mask can be kind 4 or 8 for the array case. For the
|
||||
scalar case, coerce it to default kind unconditionally. */
|
||||
if ((mask->ts.kind < gfc_default_logical_kind)
|
||||
|| (mask->rank == 0 && mask->ts.kind != gfc_default_logical_kind))
|
||||
{
|
||||
gfc_typespec ts;
|
||||
ts.type = BT_LOGICAL;
|
||||
ts.kind = gfc_default_logical_kind;
|
||||
gfc_convert_type_warn (mask, &ts, 2, 0);
|
||||
}
|
||||
}
|
||||
else
|
||||
name = "product";
|
||||
|
||||
f->value.function.name =
|
||||
gfc_get_string (PREFIX("%s_%c%d"), mask ? "mproduct" : "product",
|
||||
gfc_get_string (PREFIX("%s_%c%d"), name,
|
||||
gfc_type_letter (array->ts.type), array->ts.kind);
|
||||
}
|
||||
|
||||
@ -1733,8 +1842,31 @@ void
|
||||
gfc_resolve_sum (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
|
||||
gfc_expr * mask)
|
||||
{
|
||||
const char *name;
|
||||
|
||||
f->ts = array->ts;
|
||||
|
||||
if (mask)
|
||||
{
|
||||
if (mask->rank == 0)
|
||||
name = "ssum";
|
||||
else
|
||||
name = "msum";
|
||||
|
||||
/* The mask can be kind 4 or 8 for the array case. For the
|
||||
scalar case, coerce it to default kind unconditionally. */
|
||||
if ((mask->ts.kind < gfc_default_logical_kind)
|
||||
|| (mask->rank == 0 && mask->ts.kind != gfc_default_logical_kind))
|
||||
{
|
||||
gfc_typespec ts;
|
||||
ts.type = BT_LOGICAL;
|
||||
ts.kind = gfc_default_logical_kind;
|
||||
gfc_convert_type_warn (mask, &ts, 2, 0);
|
||||
}
|
||||
}
|
||||
else
|
||||
name = "sum";
|
||||
|
||||
if (dim != NULL)
|
||||
{
|
||||
f->rank = array->rank - 1;
|
||||
@ -1742,7 +1874,7 @@ gfc_resolve_sum (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
|
||||
}
|
||||
|
||||
f->value.function.name =
|
||||
gfc_get_string (PREFIX("%s_%c%d"), mask ? "msum" : "sum",
|
||||
gfc_get_string (PREFIX("%s_%c%d"), name,
|
||||
gfc_type_letter (array->ts.type), array->ts.kind);
|
||||
}
|
||||
|
||||
|
@ -1,3 +1,8 @@
|
||||
2006-03-20 Thomas Koenig <Thomas.Koenig@online.de>
|
||||
|
||||
PR fortran/20935
|
||||
* gfortran.dg/scalar_mask_2.f90: New test case.
|
||||
|
||||
2006-03-20 Andrew Pinski <pinskia@physics.uc.edu>
|
||||
|
||||
PR tree-opt/26629
|
||||
|
32
gcc/testsuite/gfortran.dg/scalar_mask_2.f90
Normal file
32
gcc/testsuite/gfortran.dg/scalar_mask_2.f90
Normal file
@ -0,0 +1,32 @@
|
||||
! { dg-do run }
|
||||
program main
|
||||
! Test scalar masks for different intrinsics.
|
||||
real, dimension(2,2) :: a
|
||||
logical(kind=2) :: lo
|
||||
lo = .false.
|
||||
a(1,1) = 1.
|
||||
a(1,2) = -1.
|
||||
a(2,1) = 13.
|
||||
a(2,2) = -31.
|
||||
if (any (minloc (a, lo) /= 0)) call abort
|
||||
if (any (minloc (a, .true.) /= (/ 2, 2 /))) call abort
|
||||
if (any (minloc(a, 1, .true.) /= (/ 1, 2/))) call abort
|
||||
if (any (minloc(a, 1, lo ) /= (/ 0, 0/))) call abort
|
||||
|
||||
if (any (maxloc (a, lo) /= 0)) call abort
|
||||
if (any (maxloc (a, .true.) /= (/ 2,1 /))) call abort
|
||||
if (any (maxloc(a, 1, .true.) /= (/ 2, 1/))) call abort
|
||||
if (any (maxloc(a, 1, lo) /= (/ 0, 0/))) call abort
|
||||
|
||||
if (any (maxval(a, 1, lo) /= -HUGE(a))) call abort
|
||||
if (any (maxval(a, 1, .true.) /= (/13., -1./))) call abort
|
||||
if (any (minval(a, 1, lo) /= HUGE(a))) call abort
|
||||
if (any (minval(a, 1, .true.) /= (/1., -31./))) call abort
|
||||
|
||||
if (any (product(a, 1, .true.) /= (/13., 31./))) call abort
|
||||
if (any (product(a, 1, lo ) /= (/1., 1./))) call abort
|
||||
|
||||
if (any (sum(a, 1, .true.) /= (/14., -32./))) call abort
|
||||
if (any (sum(a, 1, lo) /= (/0., 0./))) call abort
|
||||
|
||||
end program main
|
@ -1,3 +1,137 @@
|
||||
2006-03-20 Thomas Koenig <Thomas.Koenig@online.de>
|
||||
|
||||
PR fortran/20935
|
||||
* 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-17 Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||
|
||||
PR libgfortran/26509
|
||||
|
@ -293,4 +293,56 @@ mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mmaxloc0_8_i4 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mmaxloc0_8_i8 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mmaxloc0_8_r16 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mmaxloc0_8_r4 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mmaxloc0_8_r8 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -350,4 +350,58 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -339,4 +339,58 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -339,4 +339,58 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -339,4 +339,58 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -339,4 +339,58 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -339,4 +339,58 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -339,4 +339,58 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -339,4 +339,58 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -293,4 +293,56 @@ mminloc0_16_i16 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mminloc0_16_i4 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
extern void sminloc0_16_i4 (gfc_array_i16 * const restrict,
|
||||
gfc_array_i4 * const restrict, GFC_LOGICAL_4 *);
|
||||
export_proto(sminloc0_16_i4);
|
||||
|
||||
void
|
||||
sminloc0_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)
|
||||
{
|
||||
minloc0_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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mminloc0_16_i8 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
extern void sminloc0_16_i8 (gfc_array_i16 * const restrict,
|
||||
gfc_array_i8 * const restrict, GFC_LOGICAL_4 *);
|
||||
export_proto(sminloc0_16_i8);
|
||||
|
||||
void
|
||||
sminloc0_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)
|
||||
{
|
||||
minloc0_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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mminloc0_16_r10 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
extern void sminloc0_16_r10 (gfc_array_i16 * const restrict,
|
||||
gfc_array_r10 * const restrict, GFC_LOGICAL_4 *);
|
||||
export_proto(sminloc0_16_r10);
|
||||
|
||||
void
|
||||
sminloc0_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)
|
||||
{
|
||||
minloc0_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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mminloc0_16_r16 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
extern void sminloc0_16_r16 (gfc_array_i16 * const restrict,
|
||||
gfc_array_r16 * const restrict, GFC_LOGICAL_4 *);
|
||||
export_proto(sminloc0_16_r16);
|
||||
|
||||
void
|
||||
sminloc0_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)
|
||||
{
|
||||
minloc0_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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mminloc0_16_r4 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
extern void sminloc0_16_r4 (gfc_array_i16 * const restrict,
|
||||
gfc_array_r4 * const restrict, GFC_LOGICAL_4 *);
|
||||
export_proto(sminloc0_16_r4);
|
||||
|
||||
void
|
||||
sminloc0_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)
|
||||
{
|
||||
minloc0_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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mminloc0_16_r8 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
extern void sminloc0_16_r8 (gfc_array_i16 * const restrict,
|
||||
gfc_array_r8 * const restrict, GFC_LOGICAL_4 *);
|
||||
export_proto(sminloc0_16_r8);
|
||||
|
||||
void
|
||||
sminloc0_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)
|
||||
{
|
||||
minloc0_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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mminloc0_4_i16 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
extern void sminloc0_4_i16 (gfc_array_i4 * const restrict,
|
||||
gfc_array_i16 * const restrict, GFC_LOGICAL_4 *);
|
||||
export_proto(sminloc0_4_i16);
|
||||
|
||||
void
|
||||
sminloc0_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)
|
||||
{
|
||||
minloc0_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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mminloc0_4_i4 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
extern void sminloc0_4_i4 (gfc_array_i4 * const restrict,
|
||||
gfc_array_i4 * const restrict, GFC_LOGICAL_4 *);
|
||||
export_proto(sminloc0_4_i4);
|
||||
|
||||
void
|
||||
sminloc0_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)
|
||||
{
|
||||
minloc0_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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mminloc0_4_i8 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
extern void sminloc0_4_i8 (gfc_array_i4 * const restrict,
|
||||
gfc_array_i8 * const restrict, GFC_LOGICAL_4 *);
|
||||
export_proto(sminloc0_4_i8);
|
||||
|
||||
void
|
||||
sminloc0_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)
|
||||
{
|
||||
minloc0_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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mminloc0_4_r10 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
extern void sminloc0_4_r10 (gfc_array_i4 * const restrict,
|
||||
gfc_array_r10 * const restrict, GFC_LOGICAL_4 *);
|
||||
export_proto(sminloc0_4_r10);
|
||||
|
||||
void
|
||||
sminloc0_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)
|
||||
{
|
||||
minloc0_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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mminloc0_4_r16 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
extern void sminloc0_4_r16 (gfc_array_i4 * const restrict,
|
||||
gfc_array_r16 * const restrict, GFC_LOGICAL_4 *);
|
||||
export_proto(sminloc0_4_r16);
|
||||
|
||||
void
|
||||
sminloc0_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)
|
||||
{
|
||||
minloc0_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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mminloc0_4_r4 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
extern void sminloc0_4_r4 (gfc_array_i4 * const restrict,
|
||||
gfc_array_r4 * const restrict, GFC_LOGICAL_4 *);
|
||||
export_proto(sminloc0_4_r4);
|
||||
|
||||
void
|
||||
sminloc0_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)
|
||||
{
|
||||
minloc0_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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mminloc0_4_r8 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
extern void sminloc0_4_r8 (gfc_array_i4 * const restrict,
|
||||
gfc_array_r8 * const restrict, GFC_LOGICAL_4 *);
|
||||
export_proto(sminloc0_4_r8);
|
||||
|
||||
void
|
||||
sminloc0_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)
|
||||
{
|
||||
minloc0_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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mminloc0_8_i16 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
extern void sminloc0_8_i16 (gfc_array_i8 * const restrict,
|
||||
gfc_array_i16 * const restrict, GFC_LOGICAL_4 *);
|
||||
export_proto(sminloc0_8_i16);
|
||||
|
||||
void
|
||||
sminloc0_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)
|
||||
{
|
||||
minloc0_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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mminloc0_8_i4 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
extern void sminloc0_8_i4 (gfc_array_i8 * const restrict,
|
||||
gfc_array_i4 * const restrict, GFC_LOGICAL_4 *);
|
||||
export_proto(sminloc0_8_i4);
|
||||
|
||||
void
|
||||
sminloc0_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)
|
||||
{
|
||||
minloc0_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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mminloc0_8_i8 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
extern void sminloc0_8_i8 (gfc_array_i8 * const restrict,
|
||||
gfc_array_i8 * const restrict, GFC_LOGICAL_4 *);
|
||||
export_proto(sminloc0_8_i8);
|
||||
|
||||
void
|
||||
sminloc0_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)
|
||||
{
|
||||
minloc0_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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mminloc0_8_r10 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
extern void sminloc0_8_r10 (gfc_array_i8 * const restrict,
|
||||
gfc_array_r10 * const restrict, GFC_LOGICAL_4 *);
|
||||
export_proto(sminloc0_8_r10);
|
||||
|
||||
void
|
||||
sminloc0_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)
|
||||
{
|
||||
minloc0_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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mminloc0_8_r16 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
extern void sminloc0_8_r16 (gfc_array_i8 * const restrict,
|
||||
gfc_array_r16 * const restrict, GFC_LOGICAL_4 *);
|
||||
export_proto(sminloc0_8_r16);
|
||||
|
||||
void
|
||||
sminloc0_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)
|
||||
{
|
||||
minloc0_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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mminloc0_8_r4 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
extern void sminloc0_8_r4 (gfc_array_i8 * const restrict,
|
||||
gfc_array_r4 * const restrict, GFC_LOGICAL_4 *);
|
||||
export_proto(sminloc0_8_r4);
|
||||
|
||||
void
|
||||
sminloc0_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)
|
||||
{
|
||||
minloc0_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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -293,4 +293,56 @@ mminloc0_8_r8 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
extern void sminloc0_8_r8 (gfc_array_i8 * const restrict,
|
||||
gfc_array_r8 * const restrict, GFC_LOGICAL_4 *);
|
||||
export_proto(sminloc0_8_r8);
|
||||
|
||||
void
|
||||
sminloc0_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)
|
||||
{
|
||||
minloc0_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<rank; n++)
|
||||
dest[n * dstride] = 0 ;
|
||||
}
|
||||
#endif
|
||||
|
@ -350,4 +350,58 @@ mminloc1_16_i16 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
extern void sminloc1_16_i16 (gfc_array_i16 * const restrict,
|
||||
gfc_array_i16 * const restrict, const index_type * const restrict,
|
||||
GFC_LOGICAL_4 *);
|
||||
export_proto(sminloc1_16_i16);
|
||||
|
||||
void
|
||||
sminloc1_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)
|
||||
{
|
||||
minloc1_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
|
||||
|
@ -350,4 +350,58 @@ mminloc1_16_i4 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mminloc1_16_i8 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mminloc1_16_r10 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mminloc1_16_r16 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mminloc1_16_r4 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mminloc1_16_r8 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mminloc1_4_i16 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mminloc1_4_i4 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mminloc1_4_i8 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mminloc1_4_r10 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mminloc1_4_r16 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mminloc1_4_r4 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mminloc1_4_r8 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mminloc1_8_i16 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mminloc1_8_i4 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mminloc1_8_i8 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mminloc1_8_r10 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mminloc1_8_r16 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mminloc1_8_r4 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -350,4 +350,58 @@ mminloc1_8_r8 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -339,4 +339,58 @@ mminval_i16 (gfc_array_i16 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -339,4 +339,58 @@ mminval_i4 (gfc_array_i4 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -339,4 +339,58 @@ mminval_i8 (gfc_array_i8 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
@ -339,4 +339,58 @@ mminval_r10 (gfc_array_r10 * const restrict retarray,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user