OSDN Git Service

2006-03-20 Thomas Koenig <Thomas.Koenig@online.de>
authortkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 20 Mar 2006 21:56:00 +0000 (21:56 +0000)
committertkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 20 Mar 2006 21:56:00 +0000 (21:56 +0000)
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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@112230 138bc75d-0d04-0410-961f-82ee72b054a4

135 files changed:
gcc/fortran/ChangeLog
gcc/fortran/iresolve.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/scalar_mask_2.f90 [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/generated/maxloc0_16_i16.c
libgfortran/generated/maxloc0_16_i4.c
libgfortran/generated/maxloc0_16_i8.c
libgfortran/generated/maxloc0_16_r10.c
libgfortran/generated/maxloc0_16_r16.c
libgfortran/generated/maxloc0_16_r4.c
libgfortran/generated/maxloc0_16_r8.c
libgfortran/generated/maxloc0_4_i16.c
libgfortran/generated/maxloc0_4_i4.c
libgfortran/generated/maxloc0_4_i8.c
libgfortran/generated/maxloc0_4_r10.c
libgfortran/generated/maxloc0_4_r16.c
libgfortran/generated/maxloc0_4_r4.c
libgfortran/generated/maxloc0_4_r8.c
libgfortran/generated/maxloc0_8_i16.c
libgfortran/generated/maxloc0_8_i4.c
libgfortran/generated/maxloc0_8_i8.c
libgfortran/generated/maxloc0_8_r10.c
libgfortran/generated/maxloc0_8_r16.c
libgfortran/generated/maxloc0_8_r4.c
libgfortran/generated/maxloc0_8_r8.c
libgfortran/generated/maxloc1_16_i16.c
libgfortran/generated/maxloc1_16_i4.c
libgfortran/generated/maxloc1_16_i8.c
libgfortran/generated/maxloc1_16_r10.c
libgfortran/generated/maxloc1_16_r16.c
libgfortran/generated/maxloc1_16_r4.c
libgfortran/generated/maxloc1_16_r8.c
libgfortran/generated/maxloc1_4_i16.c
libgfortran/generated/maxloc1_4_i4.c
libgfortran/generated/maxloc1_4_i8.c
libgfortran/generated/maxloc1_4_r10.c
libgfortran/generated/maxloc1_4_r16.c
libgfortran/generated/maxloc1_4_r4.c
libgfortran/generated/maxloc1_4_r8.c
libgfortran/generated/maxloc1_8_i16.c
libgfortran/generated/maxloc1_8_i4.c
libgfortran/generated/maxloc1_8_i8.c
libgfortran/generated/maxloc1_8_r10.c
libgfortran/generated/maxloc1_8_r16.c
libgfortran/generated/maxloc1_8_r4.c
libgfortran/generated/maxloc1_8_r8.c
libgfortran/generated/maxval_i16.c
libgfortran/generated/maxval_i4.c
libgfortran/generated/maxval_i8.c
libgfortran/generated/maxval_r10.c
libgfortran/generated/maxval_r16.c
libgfortran/generated/maxval_r4.c
libgfortran/generated/maxval_r8.c
libgfortran/generated/minloc0_16_i16.c
libgfortran/generated/minloc0_16_i4.c
libgfortran/generated/minloc0_16_i8.c
libgfortran/generated/minloc0_16_r10.c
libgfortran/generated/minloc0_16_r16.c
libgfortran/generated/minloc0_16_r4.c
libgfortran/generated/minloc0_16_r8.c
libgfortran/generated/minloc0_4_i16.c
libgfortran/generated/minloc0_4_i4.c
libgfortran/generated/minloc0_4_i8.c
libgfortran/generated/minloc0_4_r10.c
libgfortran/generated/minloc0_4_r16.c
libgfortran/generated/minloc0_4_r4.c
libgfortran/generated/minloc0_4_r8.c
libgfortran/generated/minloc0_8_i16.c
libgfortran/generated/minloc0_8_i4.c
libgfortran/generated/minloc0_8_i8.c
libgfortran/generated/minloc0_8_r10.c
libgfortran/generated/minloc0_8_r16.c
libgfortran/generated/minloc0_8_r4.c
libgfortran/generated/minloc0_8_r8.c
libgfortran/generated/minloc1_16_i16.c
libgfortran/generated/minloc1_16_i4.c
libgfortran/generated/minloc1_16_i8.c
libgfortran/generated/minloc1_16_r10.c
libgfortran/generated/minloc1_16_r16.c
libgfortran/generated/minloc1_16_r4.c
libgfortran/generated/minloc1_16_r8.c
libgfortran/generated/minloc1_4_i16.c
libgfortran/generated/minloc1_4_i4.c
libgfortran/generated/minloc1_4_i8.c
libgfortran/generated/minloc1_4_r10.c
libgfortran/generated/minloc1_4_r16.c
libgfortran/generated/minloc1_4_r4.c
libgfortran/generated/minloc1_4_r8.c
libgfortran/generated/minloc1_8_i16.c
libgfortran/generated/minloc1_8_i4.c
libgfortran/generated/minloc1_8_i8.c
libgfortran/generated/minloc1_8_r10.c
libgfortran/generated/minloc1_8_r16.c
libgfortran/generated/minloc1_8_r4.c
libgfortran/generated/minloc1_8_r8.c
libgfortran/generated/minval_i16.c
libgfortran/generated/minval_i4.c
libgfortran/generated/minval_i8.c
libgfortran/generated/minval_r10.c
libgfortran/generated/minval_r16.c
libgfortran/generated/minval_r4.c
libgfortran/generated/minval_r8.c
libgfortran/generated/product_c10.c
libgfortran/generated/product_c16.c
libgfortran/generated/product_c4.c
libgfortran/generated/product_c8.c
libgfortran/generated/product_i16.c
libgfortran/generated/product_i4.c
libgfortran/generated/product_i8.c
libgfortran/generated/product_r10.c
libgfortran/generated/product_r16.c
libgfortran/generated/product_r4.c
libgfortran/generated/product_r8.c
libgfortran/generated/sum_c10.c
libgfortran/generated/sum_c16.c
libgfortran/generated/sum_c4.c
libgfortran/generated/sum_c8.c
libgfortran/generated/sum_i16.c
libgfortran/generated/sum_i4.c
libgfortran/generated/sum_i8.c
libgfortran/generated/sum_r10.c
libgfortran/generated/sum_r16.c
libgfortran/generated/sum_r4.c
libgfortran/generated/sum_r8.c
libgfortran/m4/iforeach.m4
libgfortran/m4/ifunction.m4
libgfortran/m4/maxloc0.m4
libgfortran/m4/maxloc1.m4
libgfortran/m4/maxval.m4
libgfortran/m4/minloc0.m4
libgfortran/m4/minloc1.m4
libgfortran/m4/minval.m4
libgfortran/m4/product.m4
libgfortran/m4/sum.m4

index 8101aae..7256b6e 100644 (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
index f961c77..df562f7 100644 (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);
 }
 
index 92e62fc..b7d52ac 100644 (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
diff --git a/gcc/testsuite/gfortran.dg/scalar_mask_2.f90 b/gcc/testsuite/gfortran.dg/scalar_mask_2.f90
new file mode 100644 (file)
index 0000000..adc7bbd
--- /dev/null
@@ -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
index 1ea7ffa..9a0a808 100644 (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
index 93ad9e4..ab341d8 100644 (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
index 6808f69..51bee31 100644 (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
index ed3061a..dd8fb46 100644 (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
index e427ba5..793885d 100644 (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
index b457997..e3d0c7f 100644 (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
index e9dbcbf..eedeaff 100644 (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
index 07d7aef..0e93c2a 100644 (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
index 08f3180..01d7870 100644 (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
index 9c342d9..7b1260c 100644 (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
index 9e3d66b..18b81c6 100644 (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
index c44fedd..59e521c 100644 (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
index e5ff44f..18bf738 100644 (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
index f5dba47..daa379c 100644 (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
index a82ceda..063fed0 100644 (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
index 35fd1f7..1e1dbf2 100644 (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
index 16320bd..2a08cd8 100644 (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
index 99ab4b9..b17a445 100644 (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
index eaaff9f..63c1467 100644 (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
index e0d1a42..c1fe42a 100644 (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
index 54047b5..58de2ca 100644 (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
index 820d3a7..e286a81 100644 (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
index 9595ac3..9f6408b 100644 (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
index cd668bb..7810033 100644 (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
index ab66598..6c6a790 100644 (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
index 90606dd..d122223 100644 (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
index 0a1939c..18d1225 100644 (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
index 445e8b0..f5fbcac 100644 (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
index 3a663bb..40922e3 100644 (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
index b881504..1dfb06d 100644 (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
index e8a053e..ae016ac 100644 (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
index ff5b7b9..d55059b 100644 (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
index 306cfe9..70a0b7b 100644 (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
index 6f6cd22..e3abb9c 100644 (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
index 3795ed8..bcecc57 100644 (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
index 82d4a67..5bcf032 100644 (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
index 69cb35e..8d5491a 100644 (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
index 6857896..5c187e2 100644 (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
index 5c5f836..ea12317 100644 (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
index e4f17d4..40972e6 100644 (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
index 0a5dd51..11f3e05 100644 (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
index 15a82f2..10bd416 100644 (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
index c89135e..534e6cd 100644 (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
index 9ae812e..2b50580 100644 (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
index 3ee7ce0..6513695 100644 (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
index f2cf7fc..fe78be1 100644 (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
index 9efa92a..5f9c5db 100644 (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
index a4d27be..a526691 100644 (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
index 42f95a1..23cee97 100644 (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
index f704425..2fd37e5 100644 (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
index 7bf58e3..d41276d 100644 (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
index b42205b..16e0863 100644 (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
index c687d10..bd2f08a 100644 (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
index 99ae91d..ab88d29 100644 (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
index d727f4c..c71a240 100644 (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
index 501a668..4cfa389 100644 (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
index 57783b6..52ef10b 100644 (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
index b71fbaa..5486e93 100644 (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
index c655b1a..519b10e 100644 (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
index 7f94829..3988838 100644 (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
index a29677d..5c0ccfb 100644 (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
index 61cf4b1..fbb75ba 100644 (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
index f55bbae..9111176 100644 (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
index d8a2f82..461bedb 100644 (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
index a6346cf..92bb0a2 100644 (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
index 2aa5453..6229244 100644 (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
index 63dd21a..01090ed 100644 (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
index c627e7e..8bd4251 100644 (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
index d4e3071..ea229d7 100644 (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
index c484e8d..e91466e 100644 (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
index 97f19ce..00d3718 100644 (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
index 75e5054..5c49e79 100644 (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
index d2fdd54..cba6b90 100644 (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
index 19ac6d7..ba8be39 100644 (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
index cc3d59b..3553c22 100644 (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
index 76e8787..258a5e2 100644 (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
index 46ed3b6..86ba667 100644 (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
index 2d8bbf9..1fe86e5 100644 (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
index 94712f4..5952d21 100644 (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
index a80d2c6..79321f1 100644 (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
index 55c8370..625328b 100644 (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
index 1d9b754..ab4d5b4 100644 (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
index df903cb..9ffdd33 100644 (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
index e723e92..a91ee8d 100644 (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
index 5fbf3ec..355333d 100644 (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
index 07cbf78..4e78589 100644 (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
index 917c0b2..ae71c33 100644 (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
index c9a1527..31cc822 100644 (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
index c36838c..3dd3b1e 100644 (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
index 9335294..9de92d0 100644 (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
index 69ebc29..a47ef25 100644 (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
index 7d662d5..2637fe6 100644 (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
index 5b34eaf..f1c2e38 100644 (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
index bcdb55f..bb79787 100644 (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
index eb37d48..deb5339 100644 (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
index a52e5a1..be02a66 100644 (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
index 61ecd81..cacd524 100644 (file)
@@ -339,4 +339,58 @@ mminval_r16 (gfc_array_r16 * const restrict retarray,
     }
 }
 
+
+extern void sminval_r16 (gfc_array_r16 * const restrict, 
+       gfc_array_r16 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(sminval_r16);
+
+void
+sminval_r16 (gfc_array_r16 * const restrict retarray, 
+       gfc_array_r16 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_REAL_16 *dest;
+
+  if (*mask)
+    {
+      minval_r16 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_REAL_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = GFC_REAL_16_HUGE ;
+}
+
 #endif
index 4eafed2..0f383d9 100644 (file)
@@ -339,4 +339,58 @@ mminval_r4 (gfc_array_r4 * const restrict retarray,
     }
 }
 
+
+extern void sminval_r4 (gfc_array_r4 * const restrict, 
+       gfc_array_r4 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(sminval_r4);
+
+void
+sminval_r4 (gfc_array_r4 * const restrict retarray, 
+       gfc_array_r4 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_REAL_4 *dest;
+
+  if (*mask)
+    {
+      minval_r4 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_REAL_4) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = GFC_REAL_4_HUGE ;
+}
+
 #endif
index 6b83f9b..31ba619 100644 (file)
@@ -339,4 +339,58 @@ mminval_r8 (gfc_array_r8 * const restrict retarray,
     }
 }
 
+
+extern void sminval_r8 (gfc_array_r8 * const restrict, 
+       gfc_array_r8 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(sminval_r8);
+
+void
+sminval_r8 (gfc_array_r8 * const restrict retarray, 
+       gfc_array_r8 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_REAL_8 *dest;
+
+  if (*mask)
+    {
+      minval_r8 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_REAL_8) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = GFC_REAL_8_HUGE ;
+}
+
 #endif
index bc1e9f0..59552f2 100644 (file)
@@ -337,4 +337,58 @@ mproduct_c10 (gfc_array_c10 * const restrict retarray,
     }
 }
 
+
+extern void sproduct_c10 (gfc_array_c10 * const restrict, 
+       gfc_array_c10 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(sproduct_c10);
+
+void
+sproduct_c10 (gfc_array_c10 * const restrict retarray, 
+       gfc_array_c10 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_COMPLEX_10 *dest;
+
+  if (*mask)
+    {
+      product_c10 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_COMPLEX_10) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 1 ;
+}
+
 #endif
index c5ac52f..97b6ac1 100644 (file)
@@ -337,4 +337,58 @@ mproduct_c16 (gfc_array_c16 * const restrict retarray,
     }
 }
 
+
+extern void sproduct_c16 (gfc_array_c16 * const restrict, 
+       gfc_array_c16 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(sproduct_c16);
+
+void
+sproduct_c16 (gfc_array_c16 * const restrict retarray, 
+       gfc_array_c16 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_COMPLEX_16 *dest;
+
+  if (*mask)
+    {
+      product_c16 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_COMPLEX_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 1 ;
+}
+
 #endif
index c8e932b..14dc21e 100644 (file)
@@ -337,4 +337,58 @@ mproduct_c4 (gfc_array_c4 * const restrict retarray,
     }
 }
 
+
+extern void sproduct_c4 (gfc_array_c4 * const restrict, 
+       gfc_array_c4 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(sproduct_c4);
+
+void
+sproduct_c4 (gfc_array_c4 * const restrict retarray, 
+       gfc_array_c4 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_COMPLEX_4 *dest;
+
+  if (*mask)
+    {
+      product_c4 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_COMPLEX_4) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 1 ;
+}
+
 #endif
index 5648579..3313f2a 100644 (file)
@@ -337,4 +337,58 @@ mproduct_c8 (gfc_array_c8 * const restrict retarray,
     }
 }
 
+
+extern void sproduct_c8 (gfc_array_c8 * const restrict, 
+       gfc_array_c8 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(sproduct_c8);
+
+void
+sproduct_c8 (gfc_array_c8 * const restrict retarray, 
+       gfc_array_c8 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_COMPLEX_8 *dest;
+
+  if (*mask)
+    {
+      product_c8 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_COMPLEX_8) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 1 ;
+}
+
 #endif
index 2b2f314..7079dc4 100644 (file)
@@ -337,4 +337,58 @@ mproduct_i16 (gfc_array_i16 * const restrict retarray,
     }
 }
 
+
+extern void sproduct_i16 (gfc_array_i16 * const restrict, 
+       gfc_array_i16 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(sproduct_i16);
+
+void
+sproduct_i16 (gfc_array_i16 * const restrict retarray, 
+       gfc_array_i16 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_INTEGER_16 *dest;
+
+  if (*mask)
+    {
+      product_i16 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 1 ;
+}
+
 #endif
index 19a7858..da88e97 100644 (file)
@@ -337,4 +337,58 @@ mproduct_i4 (gfc_array_i4 * const restrict retarray,
     }
 }
 
+
+extern void sproduct_i4 (gfc_array_i4 * const restrict, 
+       gfc_array_i4 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(sproduct_i4);
+
+void
+sproduct_i4 (gfc_array_i4 * const restrict retarray, 
+       gfc_array_i4 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_INTEGER_4 *dest;
+
+  if (*mask)
+    {
+      product_i4 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 1 ;
+}
+
 #endif
index 22b5135..c60e8f7 100644 (file)
@@ -337,4 +337,58 @@ mproduct_i8 (gfc_array_i8 * const restrict retarray,
     }
 }
 
+
+extern void sproduct_i8 (gfc_array_i8 * const restrict, 
+       gfc_array_i8 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(sproduct_i8);
+
+void
+sproduct_i8 (gfc_array_i8 * const restrict retarray, 
+       gfc_array_i8 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_INTEGER_8 *dest;
+
+  if (*mask)
+    {
+      product_i8 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 1 ;
+}
+
 #endif
index 9777df6..710216f 100644 (file)
@@ -337,4 +337,58 @@ mproduct_r10 (gfc_array_r10 * const restrict retarray,
     }
 }
 
+
+extern void sproduct_r10 (gfc_array_r10 * const restrict, 
+       gfc_array_r10 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(sproduct_r10);
+
+void
+sproduct_r10 (gfc_array_r10 * const restrict retarray, 
+       gfc_array_r10 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_REAL_10 *dest;
+
+  if (*mask)
+    {
+      product_r10 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_REAL_10) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 1 ;
+}
+
 #endif
index e9d84ea..b6df4dd 100644 (file)
@@ -337,4 +337,58 @@ mproduct_r16 (gfc_array_r16 * const restrict retarray,
     }
 }
 
+
+extern void sproduct_r16 (gfc_array_r16 * const restrict, 
+       gfc_array_r16 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(sproduct_r16);
+
+void
+sproduct_r16 (gfc_array_r16 * const restrict retarray, 
+       gfc_array_r16 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_REAL_16 *dest;
+
+  if (*mask)
+    {
+      product_r16 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_REAL_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 1 ;
+}
+
 #endif
index 8b421d3..e31b394 100644 (file)
@@ -337,4 +337,58 @@ mproduct_r4 (gfc_array_r4 * const restrict retarray,
     }
 }
 
+
+extern void sproduct_r4 (gfc_array_r4 * const restrict, 
+       gfc_array_r4 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(sproduct_r4);
+
+void
+sproduct_r4 (gfc_array_r4 * const restrict retarray, 
+       gfc_array_r4 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_REAL_4 *dest;
+
+  if (*mask)
+    {
+      product_r4 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_REAL_4) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 1 ;
+}
+
 #endif
index 57094cf..a2e805c 100644 (file)
@@ -337,4 +337,58 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray,
     }
 }
 
+
+extern void sproduct_r8 (gfc_array_r8 * const restrict, 
+       gfc_array_r8 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(sproduct_r8);
+
+void
+sproduct_r8 (gfc_array_r8 * const restrict retarray, 
+       gfc_array_r8 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_REAL_8 *dest;
+
+  if (*mask)
+    {
+      product_r8 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_REAL_8) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 1 ;
+}
+
 #endif
index 393f04e..344fd3f 100644 (file)
@@ -337,4 +337,58 @@ msum_c10 (gfc_array_c10 * const restrict retarray,
     }
 }
 
+
+extern void ssum_c10 (gfc_array_c10 * const restrict, 
+       gfc_array_c10 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(ssum_c10);
+
+void
+ssum_c10 (gfc_array_c10 * const restrict retarray, 
+       gfc_array_c10 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_COMPLEX_10 *dest;
+
+  if (*mask)
+    {
+      sum_c10 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_COMPLEX_10) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 0 ;
+}
+
 #endif
index 9e5c8ed..8cdf976 100644 (file)
@@ -337,4 +337,58 @@ msum_c16 (gfc_array_c16 * const restrict retarray,
     }
 }
 
+
+extern void ssum_c16 (gfc_array_c16 * const restrict, 
+       gfc_array_c16 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(ssum_c16);
+
+void
+ssum_c16 (gfc_array_c16 * const restrict retarray, 
+       gfc_array_c16 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_COMPLEX_16 *dest;
+
+  if (*mask)
+    {
+      sum_c16 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_COMPLEX_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 0 ;
+}
+
 #endif
index 72d28f8..1e113ad 100644 (file)
@@ -337,4 +337,58 @@ msum_c4 (gfc_array_c4 * const restrict retarray,
     }
 }
 
+
+extern void ssum_c4 (gfc_array_c4 * const restrict, 
+       gfc_array_c4 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(ssum_c4);
+
+void
+ssum_c4 (gfc_array_c4 * const restrict retarray, 
+       gfc_array_c4 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_COMPLEX_4 *dest;
+
+  if (*mask)
+    {
+      sum_c4 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_COMPLEX_4) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 0 ;
+}
+
 #endif
index 485b46d..eec1b78 100644 (file)
@@ -337,4 +337,58 @@ msum_c8 (gfc_array_c8 * const restrict retarray,
     }
 }
 
+
+extern void ssum_c8 (gfc_array_c8 * const restrict, 
+       gfc_array_c8 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(ssum_c8);
+
+void
+ssum_c8 (gfc_array_c8 * const restrict retarray, 
+       gfc_array_c8 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_COMPLEX_8 *dest;
+
+  if (*mask)
+    {
+      sum_c8 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_COMPLEX_8) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 0 ;
+}
+
 #endif
index 0044689..2a37836 100644 (file)
@@ -337,4 +337,58 @@ msum_i16 (gfc_array_i16 * const restrict retarray,
     }
 }
 
+
+extern void ssum_i16 (gfc_array_i16 * const restrict, 
+       gfc_array_i16 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(ssum_i16);
+
+void
+ssum_i16 (gfc_array_i16 * const restrict retarray, 
+       gfc_array_i16 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_INTEGER_16 *dest;
+
+  if (*mask)
+    {
+      sum_i16 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 0 ;
+}
+
 #endif
index f00c4ea..4062a3b 100644 (file)
@@ -337,4 +337,58 @@ msum_i4 (gfc_array_i4 * const restrict retarray,
     }
 }
 
+
+extern void ssum_i4 (gfc_array_i4 * const restrict, 
+       gfc_array_i4 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(ssum_i4);
+
+void
+ssum_i4 (gfc_array_i4 * const restrict retarray, 
+       gfc_array_i4 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_INTEGER_4 *dest;
+
+  if (*mask)
+    {
+      sum_i4 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 0 ;
+}
+
 #endif
index 78505da..ce02c06 100644 (file)
@@ -337,4 +337,58 @@ msum_i8 (gfc_array_i8 * const restrict retarray,
     }
 }
 
+
+extern void ssum_i8 (gfc_array_i8 * const restrict, 
+       gfc_array_i8 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(ssum_i8);
+
+void
+ssum_i8 (gfc_array_i8 * const restrict retarray, 
+       gfc_array_i8 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_INTEGER_8 *dest;
+
+  if (*mask)
+    {
+      sum_i8 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 0 ;
+}
+
 #endif
index 4907102..07f6ae3 100644 (file)
@@ -337,4 +337,58 @@ msum_r10 (gfc_array_r10 * const restrict retarray,
     }
 }
 
+
+extern void ssum_r10 (gfc_array_r10 * const restrict, 
+       gfc_array_r10 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(ssum_r10);
+
+void
+ssum_r10 (gfc_array_r10 * const restrict retarray, 
+       gfc_array_r10 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_REAL_10 *dest;
+
+  if (*mask)
+    {
+      sum_r10 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_REAL_10) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 0 ;
+}
+
 #endif
index eddd45b..975bc25 100644 (file)
@@ -337,4 +337,58 @@ msum_r16 (gfc_array_r16 * const restrict retarray,
     }
 }
 
+
+extern void ssum_r16 (gfc_array_r16 * const restrict, 
+       gfc_array_r16 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(ssum_r16);
+
+void
+ssum_r16 (gfc_array_r16 * const restrict retarray, 
+       gfc_array_r16 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_REAL_16 *dest;
+
+  if (*mask)
+    {
+      sum_r16 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_REAL_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 0 ;
+}
+
 #endif
index 97bf717..db905ae 100644 (file)
@@ -337,4 +337,58 @@ msum_r4 (gfc_array_r4 * const restrict retarray,
     }
 }
 
+
+extern void ssum_r4 (gfc_array_r4 * const restrict, 
+       gfc_array_r4 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(ssum_r4);
+
+void
+ssum_r4 (gfc_array_r4 * const restrict retarray, 
+       gfc_array_r4 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_REAL_4 *dest;
+
+  if (*mask)
+    {
+      sum_r4 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_REAL_4) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 0 ;
+}
+
 #endif
index 0f3b49c..ed2440b 100644 (file)
@@ -337,4 +337,58 @@ msum_r8 (gfc_array_r8 * const restrict retarray,
     }
 }
 
+
+extern void ssum_r8 (gfc_array_r8 * const restrict, 
+       gfc_array_r8 * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(ssum_r8);
+
+void
+ssum_r8 (gfc_array_r8 * const restrict retarray, 
+       gfc_array_r8 * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  GFC_REAL_8 *dest;
+
+  if (*mask)
+    {
+      sum_r8 (retarray, array, pdim);
+      return;
+    }
+    rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_REAL_8) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = 0 ;
+}
+
 #endif
index cfe5639..7d20213 100644 (file)
@@ -248,3 +248,56 @@ $1
 START_MASKED_FOREACH_BLOCK
 $2
 FINISH_MASKED_FOREACH_FUNCTION')dnl
+define(SCALAR_FOREACH_FUNCTION,
+`
+extern void `s'name`'rtype_qual`_'atype_code (rtype * const restrict, 
+       atype * const restrict, GFC_LOGICAL_4 *);
+export_proto(`s'name`'rtype_qual`_'atype_code);
+
+void
+`s'name`'rtype_qual`_'atype_code (rtype * const restrict retarray, 
+       atype * const restrict array,
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type dstride;
+  index_type n;
+  rtype_name *dest;
+
+  if (*mask)
+    {
+      name`'rtype_qual`_'atype_code (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 (rtype_name) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n<rank; n++)
+    dest[n * dstride] = $1 ;
+}')dnl
index caf9dba..d1a34da 100644 (file)
@@ -317,6 +317,60 @@ define(FINISH_MASKED_ARRAY_FUNCTION,
         }
     }
 }')dnl
+define(SCALAR_ARRAY_FUNCTION,
+`
+extern void `s'name`'rtype_qual`_'atype_code (rtype * const restrict, 
+       atype * const restrict, const index_type * const restrict,
+       GFC_LOGICAL_4 *);
+export_proto(`s'name`'rtype_qual`_'atype_code);
+
+void
+`s'name`'rtype_qual`_'atype_code (rtype * const restrict retarray, 
+       atype * const restrict array, 
+       const index_type * const restrict pdim, 
+       GFC_LOGICAL_4 * mask)
+{
+  index_type rank;
+  index_type n;
+  index_type dstride;
+  rtype_name *dest;
+
+  if (*mask)
+    {
+      name`'rtype_qual`_'atype_code (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 (rtype_name) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+    dstride = retarray->dim[0].stride;
+    dest = retarray->data;
+
+    for (n = 0; n < rank; n++)
+      dest[n * dstride] = $1 ;
+}')dnl
 define(ARRAY_FUNCTION,
 `START_ARRAY_FUNCTION
 $2
index 9feaa4b..a7e88f0 100644 (file)
@@ -64,4 +64,5 @@ MASKED_FOREACH_FUNCTION(
         dest[n * dstride] = count[n] + 1;
     }')
 
+SCALAR_FOREACH_FUNCTION(`0')
 #endif
index 1613684..3a6ed5a 100644 (file)
@@ -60,4 +60,6 @@ MASKED_ARRAY_FUNCTION(0,
       result = (rtype_name)n + 1;
     }')
 
+SCALAR_ARRAY_FUNCTION(0)
+
 #endif
index 9bdf0d0..07cbbdd 100644 (file)
@@ -49,4 +49,6 @@ MASKED_ARRAY_FUNCTION(atype_min,
 `  if (*msrc && *src > result)
     result = *src;')
 
+SCALAR_ARRAY_FUNCTION(atype_min)
+
 #endif
index 1c2aa18..33bfe31 100644 (file)
@@ -64,4 +64,5 @@ MASKED_FOREACH_FUNCTION(
         dest[n * dstride] = count[n] + 1;
     }')
 
+SCALAR_FOREACH_FUNCTION(`0')
 #endif
index 0c116eb..f923ca8 100644 (file)
@@ -60,4 +60,6 @@ MASKED_ARRAY_FUNCTION(0,
       result = (rtype_name)n + 1;
     }')
 
+SCALAR_ARRAY_FUNCTION(0)
+
 #endif
index 9bd37f4..af02319 100644 (file)
@@ -49,4 +49,6 @@ MASKED_ARRAY_FUNCTION(atype_max,
 `  if (*msrc && *src < result)
     result = *src;')
 
+SCALAR_ARRAY_FUNCTION(atype_max)
+
 #endif
index df77372..47ee25b 100644 (file)
@@ -47,4 +47,6 @@ MASKED_ARRAY_FUNCTION(1,
 `  if (*msrc)
     result *= *src;')
 
+SCALAR_ARRAY_FUNCTION(1)
+
 #endif
index 1d91c0d..a940688 100644 (file)
@@ -47,4 +47,6 @@ MASKED_ARRAY_FUNCTION(0,
 `  if (*msrc)
     result += *src;')
 
+SCALAR_ARRAY_FUNCTION(0)
+
 #endif