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:
Thomas Koenig 2006-03-20 21:56:00 +00:00 committed by Thomas Koenig
parent ede497cfbd
commit 97a6203866
135 changed files with 6839 additions and 6 deletions

View File

@ -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

View File

@ -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);
}

View File

@ -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

View 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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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