OSDN Git Service

2005-04-09 Thomas Koenig <Thomas.Koenig@online.de>
authortkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 9 Apr 2005 21:38:47 +0000 (21:38 +0000)
committertkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 9 Apr 2005 21:38:47 +0000 (21:38 +0000)
        PR libfortran/19106
        PR libfortran/19014
        * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): ditto.
        If retarray->data is NULL (i.e. the front end does not
        know the rank and dimenson of the array), fill in its
        properties and allocate memory.
        Change the assertions about rank and dimension of retarray into
        runtime errors and only check them for retarray->data != NULL.
        Do the same for correcting the stride from 0 to 1 in retarray.
        (`m'name`'rtype_qual`_'atype_code): Likewise.
        * m4/iforeach.m4 (name`'rtype_qual`_'atype_code): Likewise.
        Change assertion about rank of array to runtime error.
        (`m'name`'rtype_qual`_'atype_code): Likewise.
        * generated/all_l4.c: Regenerated.
        * generated/all_l8.c: Regenerated.
        * generated/any_l4.c: Regenerated.
        * generated/any_l8.c: Regenerated.
        * generated/count_4_l4.c: Regenerated.
        * generated/count_4_l8.c: Regenerated.
        * generated/count_8_l4.c: Regenerated.
        * generated/count_8_l8.c: Regenerated.
        * generated/maxloc0_4_i4.c: Regenerated.
        * generated/maxloc0_4_i8.c: Regenerated.
        * generated/maxloc0_4_r4.c: Regenerated.
        * generated/maxloc0_4_r8.c: Regenerated.
        * generated/maxloc0_8_i4.c: Regenerated.
        * generated/maxloc0_8_i8.c: Regenerated.
        * generated/maxloc0_8_r4.c: Regenerated.
        * generated/maxloc0_8_r8.c: Regenerated.
        * generated/maxloc1_4_i4.c: Regenerated.
        * generated/maxloc1_4_i8.c: Regenerated.
        * generated/maxloc1_4_r4.c: Regenerated.
        * generated/maxloc1_4_r8.c: Regenerated.
        * generated/maxloc1_8_i4.c: Regenerated.
        * generated/maxloc1_8_i8.c: Regenerated.
        * generated/maxloc1_8_r4.c: Regenerated.
        * generated/maxloc1_8_r8.c: Regenerated.
        * generated/maxval_i4.c: Regenerated.
        * generated/maxval_i8.c: Regenerated.
        * generated/maxval_r4.c: Regenerated.
        * generated/maxval_r8.c: Regenerated.
        * generated/minloc0_4_i4.c: Regenerated.
        * generated/minloc0_4_i8.c: Regenerated.
        * generated/minloc0_4_r4.c: Regenerated.
        * generated/minloc0_4_r8.c: Regenerated.
        * generated/minloc0_8_i4.c: Regenerated.
        * generated/minloc0_8_i8.c: Regenerated.
        * generated/minloc0_8_r4.c: Regenerated.
        * generated/minloc0_8_r8.c: Regenerated.
        * generated/minloc1_4_i4.c: Regenerated.
        * generated/minloc1_4_i8.c: Regenerated.
        * generated/minloc1_4_r4.c: Regenerated.
        * generated/minloc1_4_r8.c: Regenerated.
        * generated/minloc1_8_i4.c: Regenerated.
        * generated/minloc1_8_i8.c: Regenerated.
        * generated/minloc1_8_r4.c: Regenerated.
        * generated/minloc1_8_r8.c: Regenerated.
        * generated/minval_i4.c: Regenerated.
        * generated/minval_i8.c: Regenerated.
        * generated/minval_r4.c: Regenerated.
        * generated/minval_r8.c: Regenerated.
        * generated/product_c4.c: Regenerated.
        * generated/product_c8.c: Regenerated.
        * generated/product_i4.c: Regenerated.
        * generated/product_i8.c: Regenerated.
        * generated/product_r4.c: Regenerated.
        * generated/product_r8.c: Regenerated.
        * generated/sum_c4.c: Regenerated.
        * generated/sum_c8.c: Regenerated.
        * generated/sum_i4.c: Regenerated.
        * generated/sum_i8.c: Regenerated.
        * generated/sum_r4.c: Regenerated.
        * generated/sum_r8.c: Regenerated.

2005-04-09  Thomas Koenig  <Thomas.Koenig@online.de>

        * gfortran.fortran-torture/execute/intrinsic_anyall.f90:
        Added test for callee-allocated arrays with write statements.
        * gfortran.fortran-torture/execute/intrinsic_count.f90: Likewise.
        * gfortran.fortran-torture/execute/intrinsic_mmloc.f90: Likewise.
        * gfortran.fortran-torture/execute/intrinsic_mmval.f90: Likewise.
        * gfortran.fortran-torture/execute/intrinsic_product.f90: Likewise.
        * gfortran.fortran-torture/execute/intrinsic_sum.f90: Likewise.

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

70 files changed:
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_anyall.f90
gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_count.f90
gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc.f90
gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmval.f90
gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_product.f90
gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_sum.f90
libgfortran/ChangeLog
libgfortran/generated/all_l4.c
libgfortran/generated/all_l8.c
libgfortran/generated/any_l4.c
libgfortran/generated/any_l8.c
libgfortran/generated/count_4_l4.c
libgfortran/generated/count_4_l8.c
libgfortran/generated/count_8_l4.c
libgfortran/generated/count_8_l8.c
libgfortran/generated/maxloc0_4_i4.c
libgfortran/generated/maxloc0_4_i8.c
libgfortran/generated/maxloc0_4_r4.c
libgfortran/generated/maxloc0_4_r8.c
libgfortran/generated/maxloc0_8_i4.c
libgfortran/generated/maxloc0_8_i8.c
libgfortran/generated/maxloc0_8_r4.c
libgfortran/generated/maxloc0_8_r8.c
libgfortran/generated/maxloc1_4_i4.c
libgfortran/generated/maxloc1_4_i8.c
libgfortran/generated/maxloc1_4_r4.c
libgfortran/generated/maxloc1_4_r8.c
libgfortran/generated/maxloc1_8_i4.c
libgfortran/generated/maxloc1_8_i8.c
libgfortran/generated/maxloc1_8_r4.c
libgfortran/generated/maxloc1_8_r8.c
libgfortran/generated/maxval_i4.c
libgfortran/generated/maxval_i8.c
libgfortran/generated/maxval_r4.c
libgfortran/generated/maxval_r8.c
libgfortran/generated/minloc0_4_i4.c
libgfortran/generated/minloc0_4_i8.c
libgfortran/generated/minloc0_4_r4.c
libgfortran/generated/minloc0_4_r8.c
libgfortran/generated/minloc0_8_i4.c
libgfortran/generated/minloc0_8_i8.c
libgfortran/generated/minloc0_8_r4.c
libgfortran/generated/minloc0_8_r8.c
libgfortran/generated/minloc1_4_i4.c
libgfortran/generated/minloc1_4_i8.c
libgfortran/generated/minloc1_4_r4.c
libgfortran/generated/minloc1_4_r8.c
libgfortran/generated/minloc1_8_i4.c
libgfortran/generated/minloc1_8_i8.c
libgfortran/generated/minloc1_8_r4.c
libgfortran/generated/minloc1_8_r8.c
libgfortran/generated/minval_i4.c
libgfortran/generated/minval_i8.c
libgfortran/generated/minval_r4.c
libgfortran/generated/minval_r8.c
libgfortran/generated/product_c4.c
libgfortran/generated/product_c8.c
libgfortran/generated/product_i4.c
libgfortran/generated/product_i8.c
libgfortran/generated/product_r4.c
libgfortran/generated/product_r8.c
libgfortran/generated/sum_c4.c
libgfortran/generated/sum_c8.c
libgfortran/generated/sum_i4.c
libgfortran/generated/sum_i8.c
libgfortran/generated/sum_r4.c
libgfortran/generated/sum_r8.c
libgfortran/m4/iforeach.m4
libgfortran/m4/ifunction.m4

index fe7b88e..1dfa145 100644 (file)
@@ -1,5 +1,15 @@
 2005-04-09  Thomas Koenig  <Thomas.Koenig@online.de>
 
+       * gfortran.fortran-torture/execute/intrinsic_anyall.f90:
+       Added test for callee-allocated arrays with write statements.
+       * gfortran.fortran-torture/execute/intrinsic_count.f90: Likewise.
+       * gfortran.fortran-torture/execute/intrinsic_mmloc.f90: Likewise.
+       * gfortran.fortran-torture/execute/intrinsic_mmval.f90: Likewise.
+       * gfortran.fortran-torture/execute/intrinsic_product.f90: Likewise.
+       * gfortran.fortran-torture/execute/intrinsic_sum.f90: Likewise.
+
+2005-04-09  Thomas Koenig  <Thomas.Koenig@online.de>
+
        PR libfortran/20163
        * gfortran.dg/open-options-blanks.f:  New test.
 
index d1b99da..4e392c5 100644 (file)
@@ -3,6 +3,7 @@ program anyall
    implicit none
    logical, dimension(3, 3) :: a
    logical, dimension(3) :: b
+   character(len=10) line
 
    a = .false.
    if (any(a)) call abort
@@ -13,6 +14,12 @@ program anyall
    if (.not. b(1)) call abort
    if (b(2)) call abort
    if (.not. b(3)) call abort
+   b = .false.
+   write (line, 9000) any(a,1)
+   read (line, 9000) b
+   if (.not. b(1)) call abort
+   if (b(2)) call abort
+   if (.not. b(3)) call abort
 
    a = .true.
    if (.not. all(a)) call abort
@@ -23,4 +30,12 @@ program anyall
    if (b(1)) call abort
    if (.not. b(2)) call abort
    if (b(3)) call abort
+   b = .false.
+   write (line, 9000) all(a,1)
+   read (line, 9000) b
+   if (b(1)) call abort
+   if (.not. b(2)) call abort
+   if (b(3)) call abort
+
+9000 format (9L1)
 end program
index a2de59f..f95c198 100644 (file)
@@ -4,6 +4,7 @@ program intrinsic_count
    logical(kind=4), dimension (3, 5) :: a
    integer(kind=4), dimension (5) :: b
    integer i
+   character(len=10) line
 
    a = .false.
    if (count(a) .ne. 0) call abort
@@ -13,9 +14,21 @@ program intrinsic_count
    a(2, 2) = .false.
    a(2, 5) = .false.
    if (count(a) .ne. 12) call abort
+   write (line, 9000) count(a)
+   read (line, 9000) i
+   if (i .ne. 12) call abort
 
    b(1:3) = count(a, 2);
    if (b(1) .ne. 4) call abort
    if (b(2) .ne. 3) call abort
    if (b(3) .ne. 5) call abort
+   b = 0
+   write (line, 9000) count(a,2)
+   read (line, 9000) b
+   if (b(1) .ne. 4) call abort
+   if (b(2) .ne. 3) call abort
+   if (b(3) .ne. 5) call abort
+
+9000 format(3I3)
+
 end program
index f64242a..ea73913 100644 (file)
@@ -5,6 +5,7 @@ program testmmloc
    integer, dimension (3) :: b
    logical, dimension (3, 3) :: m
    integer i
+   character(len=10) line
 
    a = reshape ((/1, 2, 3, 5, 4, 6, 9, 8, 7/), (/3, 3/));
 
@@ -12,6 +13,12 @@ program testmmloc
    if (b(1) .ne. 1) call abort
    if (b(2) .ne. 2) call abort
    if (b(3) .ne. 3) call abort
+   b = -1
+   write (line, 9000) minloc(a,1)
+   read (line, 9000) b
+   if (b(1) .ne. 1) call abort
+   if (b(2) .ne. 2) call abort
+   if (b(3) .ne. 3) call abort
 
    m = .true.
    m(1, 1) = .false.
@@ -20,19 +27,43 @@ program testmmloc
    if (b(1) .ne. 2) call abort
    if (b(2) .ne. 2) call abort
    if (b(3) .ne. 3) call abort
+   b = -1
+   write (line, 9000) minloc(a, 1, m)
+   read (line, 9000) b
+   if (b(1) .ne. 2) call abort
+   if (b(2) .ne. 2) call abort
+   if (b(3) .ne. 3) call abort
 
    b(1:2) = minloc(a)
    if (b(1) .ne. 1) call abort
    if (b(2) .ne. 1) call abort
+   b = -1
+   write (line, 9000) minloc(a)
+   read (line, 9000) b
+   if (b(1) .ne. 1) call abort
+   if (b(2) .ne. 1) call abort
+   if (b(3) .ne. 0) call abort
 
    b(1:2) = minloc(a, mask=m)
    if (b(1) .ne. 2) call abort
    if (b(2) .ne. 1) call abort
+   b = -1
+   write (line, 9000) minloc(a, mask=m)
+   read (line, 9000) b
+   if (b(1) .ne. 2) call abort
+   if (b(2) .ne. 1) call abort
+   if (b(3) .ne. 0) call abort
 
    b = maxloc (a, 1)
    if (b(1) .ne. 3) call abort
    if (b(2) .ne. 3) call abort
    if (b(3) .ne. 1) call abort
+   b = -1
+   write (line, 9000) maxloc(a, 1)
+   read (line, 9000) b
+   if (b(1) .ne. 3) call abort
+   if (b(2) .ne. 3) call abort
+   if (b(3) .ne. 1) call abort
 
    m = .true.
    m(1, 2) = .false.
@@ -41,12 +72,31 @@ program testmmloc
    if (b(1) .ne. 3) call abort
    if (b(2) .ne. 3) call abort
    if (b(3) .ne. 2) call abort
+   b = -1
+   write (line, 9000) maxloc(a, 1, m)
+   read (line, 9000) b
+   if (b(1) .ne. 3) call abort
+   if (b(2) .ne. 3) call abort
+   if (b(3) .ne. 2) call abort
 
    b(1:2) = maxloc(a)
    if (b(1) .ne. 1) call abort
    if (b(2) .ne. 3) call abort
+   b = -1
+   write (line, 9000) maxloc(a)
+   read (line, 9000) b
+   if (b(1) .ne. 1) call abort
+   if (b(2) .ne. 3) call abort
 
    b(1:2) = maxloc(a, mask=m)
    if (b(1) .ne. 2) call abort
    if (b(2) .ne. 3) call abort
+   b = -1
+   write (line, 9000) maxloc(a, mask=m)
+   read (line, 9000) b
+   if (b(1) .ne. 2) call abort
+   if (b(2) .ne. 3) call abort
+   if (b(3) .ne. 0) call abort
+
+9000 format (3I3)
 end program
index 368c83b..86ec159 100644 (file)
@@ -5,24 +5,35 @@ program testmmval
    integer, dimension (3) :: b
    logical, dimension (3, 3) :: m
    integer i
+   character (len=9) line
 
    a = reshape ((/1, 2, 3, 5, 4, 6, 9, 8, 7/), (/3, 3/));
 
    b = minval (a, 1)
    if (any(b .ne. (/1, 4, 7/))) call abort
+   write (line, 9000) minval (a, 1)
+   if (line .ne. '  1  4  7') call abort
 
    m = .true.
    m(1, 1) = .false.
    m(1, 2) = .false.
    b = minval (a, 1, m)
    if (any(b .ne. (/2, 4, 7/))) call abort
+   write (line, 9000) minval(a, 1, m)
+   if (line .ne. '  2  4  7') call abort
 
    b = maxval (a, 1)
    if (any(b .ne. (/3, 6, 9/))) call abort
+   write (line, 9000) maxval (a, 1)
+   if (line .ne. '  3  6  9') call abort
 
    m = .true.
    m(1, 2) = .false.
    m(1, 3) = .false.
    b = maxval (a, 1, m)
    if (any(b .ne. (/3, 6, 8/))) call abort
+   write (line, 9000) maxval(a, 1, m)
+   if (line .ne. '  3  6  8') call abort
+
+9000 format(3I3)
 end program
index 102832c..2892d54 100644 (file)
@@ -4,6 +4,7 @@ program testproduct
    integer, dimension (3, 3) :: a
    integer, dimension (3) :: b
    logical, dimension (3, 3) :: m
+   character(len=12) line
 
    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/));
 
@@ -11,8 +12,14 @@ program testproduct
 
    if (any(b .ne. (/6, 120, 504/))) call abort
 
+   write (line, 9000) product(a,1)
+   if (line .ne. '   6 120 504') call abort
+
    if (product (a) .ne. 362880) call abort
 
+   write (line, 9010) product(a)
+   if (line .ne. '362880') call abort
+
    m = .true.
    m(1, 1) = .false.
    m(2, 1) = .false.
@@ -20,6 +27,14 @@ program testproduct
 
    if (any(b .ne. (/28, 40, 162/))) call abort
 
+   write (line, 9000) product(a, 2, m)
+   if (line .ne. '  28  40 162') call abort
+
    if (product (a, mask=m) .ne. 181440) call abort
 
+   write (line, 9010) product(a, mask=m)
+   if (line .ne. '181440') call abort
+
+9000 format (3I4)
+9010 format (I6)
 end program
index 43f832e..552f6c6 100644 (file)
@@ -5,22 +5,35 @@ program testforall
    integer, dimension (3) :: b
    logical, dimension (3, 3) :: m
    integer i
+   character(len=9) line
 
    a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/));
 
    if (sum(a) .ne. 45) call abort
+   write (line, 9000) sum(a)
+   if (line .ne. ' 45      ') call abort
    b = sum (a, 1)
    if (b(1) .ne. 6) call abort
    if (b(2) .ne. 15) call abort
    if (b(3) .ne. 24) call abort
+   write (line, 9000) sum (a, 1)
+   if (line .ne. '  6 15 24') call abort
 
    m = .true.
    m(1, 1) = .false.
    m(2, 1) = .false.
 
    if (sum (a, mask=m) .ne. 42) call abort
+
+   write(line, 9000) sum (a, mask=m)
+   if (line .ne. ' 42      ') call abort
+
    b = sum (a, 2, m)
    if (b(1) .ne. 11) call abort
    if (b(2) .ne. 13) call abort
    if (b(3) .ne. 18) call abort
+   write (line, 9000) sum (a, 2, m)
+   if (line .ne. ' 11 13 18') call abort
+
+9000 format(3I3)
 end program
index 2f31127..ba0257d 100644 (file)
@@ -1,3 +1,79 @@
+2005-04-09  Thomas Koenig  <Thomas.Koenig@online.de>
+
+       PR libfortran/19106
+       PR libfortran/19014
+       * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): ditto.
+       If retarray->data is NULL (i.e. the front end does not
+       know the rank and dimenson of the array), fill in its
+       properties and allocate memory.
+       Change the assertions about rank and dimension of retarray into
+       runtime errors and only check them for retarray->data != NULL.
+       Do the same for correcting the stride from 0 to 1 in retarray.
+       (`m'name`'rtype_qual`_'atype_code): Likewise.
+       * m4/iforeach.m4 (name`'rtype_qual`_'atype_code): Likewise.
+       Change assertion about rank of array to runtime error.
+       (`m'name`'rtype_qual`_'atype_code): Likewise.
+       * generated/all_l4.c: Regenerated.
+       * generated/all_l8.c: Regenerated.
+       * generated/any_l4.c: Regenerated.
+       * generated/any_l8.c: Regenerated.
+       * generated/count_4_l4.c: Regenerated.
+       * generated/count_4_l8.c: Regenerated.
+       * generated/count_8_l4.c: Regenerated.
+       * generated/count_8_l8.c: Regenerated.
+       * generated/maxloc0_4_i4.c: Regenerated.
+       * generated/maxloc0_4_i8.c: Regenerated.
+       * generated/maxloc0_4_r4.c: Regenerated.
+       * generated/maxloc0_4_r8.c: Regenerated.
+       * generated/maxloc0_8_i4.c: Regenerated.
+       * generated/maxloc0_8_i8.c: Regenerated.
+       * generated/maxloc0_8_r4.c: Regenerated.
+       * generated/maxloc0_8_r8.c: Regenerated.
+       * generated/maxloc1_4_i4.c: Regenerated.
+       * generated/maxloc1_4_i8.c: Regenerated.
+       * generated/maxloc1_4_r4.c: Regenerated.
+       * generated/maxloc1_4_r8.c: Regenerated.
+       * generated/maxloc1_8_i4.c: Regenerated.
+       * generated/maxloc1_8_i8.c: Regenerated.
+       * generated/maxloc1_8_r4.c: Regenerated.
+       * generated/maxloc1_8_r8.c: Regenerated.
+       * generated/maxval_i4.c: Regenerated.
+       * generated/maxval_i8.c: Regenerated.
+       * generated/maxval_r4.c: Regenerated.
+       * generated/maxval_r8.c: Regenerated.
+       * generated/minloc0_4_i4.c: Regenerated.
+       * generated/minloc0_4_i8.c: Regenerated.
+       * generated/minloc0_4_r4.c: Regenerated.
+       * generated/minloc0_4_r8.c: Regenerated.
+       * generated/minloc0_8_i4.c: Regenerated.
+       * generated/minloc0_8_i8.c: Regenerated.
+       * generated/minloc0_8_r4.c: Regenerated.
+       * generated/minloc0_8_r8.c: Regenerated.
+       * generated/minloc1_4_i4.c: Regenerated.
+       * generated/minloc1_4_i8.c: Regenerated.
+       * generated/minloc1_4_r4.c: Regenerated.
+       * generated/minloc1_4_r8.c: Regenerated.
+       * generated/minloc1_8_i4.c: Regenerated.
+       * generated/minloc1_8_i8.c: Regenerated.
+       * generated/minloc1_8_r4.c: Regenerated.
+       * generated/minloc1_8_r8.c: Regenerated.
+       * generated/minval_i4.c: Regenerated.
+       * generated/minval_i8.c: Regenerated.
+       * generated/minval_r4.c: Regenerated.
+       * generated/minval_r8.c: Regenerated.
+       * generated/product_c4.c: Regenerated.
+       * generated/product_c8.c: Regenerated.
+       * generated/product_i4.c: Regenerated.
+       * generated/product_i8.c: Regenerated.
+       * generated/product_r4.c: Regenerated.
+       * generated/product_r8.c: Regenerated.
+       * generated/sum_c4.c: Regenerated.
+       * generated/sum_c8.c: Regenerated.
+       * generated/sum_i4.c: Regenerated.
+       * generated/sum_i8.c: Regenerated.
+       * generated/sum_r4.c: Regenerated.
+       * generated/sum_r8.c: Regenerated.
+
 2005-04-09  Thomas Koenig <Thomas.Koenig@online.de>
 
        PR libfortran/20163
index 09315e9..ddf9be1 100644 (file)
@@ -55,11 +55,8 @@ all_l4 (gfc_array_l4 *retarray, gfc_array_l4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -93,8 +90,17 @@ all_l4 (gfc_array_l4 *retarray, gfc_array_l4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 6ba3816..3978f31 100644 (file)
@@ -55,11 +55,8 @@ all_l8 (gfc_array_l8 *retarray, gfc_array_l8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -93,8 +90,17 @@ all_l8 (gfc_array_l8 *retarray, gfc_array_l8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 8b9fac0..7db73dd 100644 (file)
@@ -55,11 +55,8 @@ any_l4 (gfc_array_l4 *retarray, gfc_array_l4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -93,8 +90,17 @@ any_l4 (gfc_array_l4 *retarray, gfc_array_l4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 4e853c4..7814797 100644 (file)
@@ -55,11 +55,8 @@ any_l8 (gfc_array_l8 *retarray, gfc_array_l8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -93,8 +90,17 @@ any_l8 (gfc_array_l8 *retarray, gfc_array_l8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 5cf35a4..389c375 100644 (file)
@@ -55,11 +55,8 @@ count_4_l4 (gfc_array_i4 *retarray, gfc_array_l4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -93,8 +90,17 @@ count_4_l4 (gfc_array_i4 *retarray, gfc_array_l4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 359e13d..44e75eb 100644 (file)
@@ -55,11 +55,8 @@ count_4_l8 (gfc_array_i4 *retarray, gfc_array_l8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -93,8 +90,17 @@ count_4_l8 (gfc_array_i4 *retarray, gfc_array_l8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 21b0752..33fba4c 100644 (file)
@@ -55,11 +55,8 @@ count_8_l4 (gfc_array_i8 *retarray, gfc_array_l4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -93,8 +90,17 @@ count_8_l4 (gfc_array_i8 *retarray, gfc_array_l4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index e3f493f..a867922 100644 (file)
@@ -55,11 +55,8 @@ count_8_l8 (gfc_array_i8 *retarray, gfc_array_l8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -93,8 +90,17 @@ count_8_l8 (gfc_array_i8 *retarray, gfc_array_l8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 5063644..a483c43 100644 (file)
@@ -53,13 +53,31 @@ maxloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array)
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
@@ -150,17 +168,32 @@ mmaxloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array,
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
-  assert (GFC_DESCRIPTOR_RANK (mask) == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
 
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
index 333ffc7..ced6d6a 100644 (file)
@@ -53,13 +53,31 @@ maxloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array)
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
@@ -150,17 +168,32 @@ mmaxloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array,
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
-  assert (GFC_DESCRIPTOR_RANK (mask) == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
 
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
index a2d0a50..06eb04c 100644 (file)
@@ -53,13 +53,31 @@ maxloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array)
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
@@ -150,17 +168,32 @@ mmaxloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array,
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
-  assert (GFC_DESCRIPTOR_RANK (mask) == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
 
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
index 43aca18..7913218 100644 (file)
@@ -53,13 +53,31 @@ maxloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array)
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
@@ -150,17 +168,32 @@ mmaxloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array,
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
-  assert (GFC_DESCRIPTOR_RANK (mask) == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
 
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
index 0af2b9a..49d370d 100644 (file)
@@ -53,13 +53,31 @@ maxloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array)
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
@@ -150,17 +168,32 @@ mmaxloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array,
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
-  assert (GFC_DESCRIPTOR_RANK (mask) == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
 
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
index 15b3b92..100c011 100644 (file)
@@ -53,13 +53,31 @@ maxloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array)
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
@@ -150,17 +168,32 @@ mmaxloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array,
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
-  assert (GFC_DESCRIPTOR_RANK (mask) == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
 
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
index 7f41920..4cf8364 100644 (file)
@@ -53,13 +53,31 @@ maxloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array)
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
@@ -150,17 +168,32 @@ mmaxloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array,
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
-  assert (GFC_DESCRIPTOR_RANK (mask) == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
 
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
index e539cb3..1a0ccee 100644 (file)
@@ -53,13 +53,31 @@ maxloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array)
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
@@ -150,17 +168,32 @@ mmaxloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array,
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
-  assert (GFC_DESCRIPTOR_RANK (mask) == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
 
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
index 633dc64..38c6836 100644 (file)
@@ -57,11 +57,8 @@ maxloc1_4_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -95,8 +92,17 @@ maxloc1_4_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -191,11 +197,8 @@ mmaxloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -217,6 +220,34 @@ mmaxloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 76a7314..9c6c732 100644 (file)
@@ -57,11 +57,8 @@ maxloc1_4_i8 (gfc_array_i4 *retarray, gfc_array_i8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -95,8 +92,17 @@ maxloc1_4_i8 (gfc_array_i4 *retarray, gfc_array_i8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -191,11 +197,8 @@ mmaxloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -217,6 +220,34 @@ mmaxloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 93c625b..4048d2b 100644 (file)
@@ -57,11 +57,8 @@ maxloc1_4_r4 (gfc_array_i4 *retarray, gfc_array_r4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -95,8 +92,17 @@ maxloc1_4_r4 (gfc_array_i4 *retarray, gfc_array_r4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -191,11 +197,8 @@ mmaxloc1_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -217,6 +220,34 @@ mmaxloc1_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 4114023..f27a1df 100644 (file)
@@ -57,11 +57,8 @@ maxloc1_4_r8 (gfc_array_i4 *retarray, gfc_array_r8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -95,8 +92,17 @@ maxloc1_4_r8 (gfc_array_i4 *retarray, gfc_array_r8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -191,11 +197,8 @@ mmaxloc1_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -217,6 +220,34 @@ mmaxloc1_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 3ad74db..448c9f9 100644 (file)
@@ -57,11 +57,8 @@ maxloc1_8_i4 (gfc_array_i8 *retarray, gfc_array_i4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -95,8 +92,17 @@ maxloc1_8_i4 (gfc_array_i8 *retarray, gfc_array_i4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -191,11 +197,8 @@ mmaxloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -217,6 +220,34 @@ mmaxloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index f52e0c5..fb91a6a 100644 (file)
@@ -57,11 +57,8 @@ maxloc1_8_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -95,8 +92,17 @@ maxloc1_8_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -191,11 +197,8 @@ mmaxloc1_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -217,6 +220,34 @@ mmaxloc1_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index d8079e5..33159fb 100644 (file)
@@ -57,11 +57,8 @@ maxloc1_8_r4 (gfc_array_i8 *retarray, gfc_array_r4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -95,8 +92,17 @@ maxloc1_8_r4 (gfc_array_i8 *retarray, gfc_array_r4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -191,11 +197,8 @@ mmaxloc1_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -217,6 +220,34 @@ mmaxloc1_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 107cbee..b1f7805 100644 (file)
@@ -57,11 +57,8 @@ maxloc1_8_r8 (gfc_array_i8 *retarray, gfc_array_r8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -95,8 +92,17 @@ maxloc1_8_r8 (gfc_array_i8 *retarray, gfc_array_r8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -191,11 +197,8 @@ mmaxloc1_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -217,6 +220,34 @@ mmaxloc1_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 9cb359c..e992327 100644 (file)
@@ -56,11 +56,8 @@ maxval_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -94,8 +91,17 @@ maxval_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -185,11 +191,8 @@ mmaxval_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -211,6 +214,34 @@ mmaxval_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 3c52d71..3e60377 100644 (file)
@@ -56,11 +56,8 @@ maxval_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -94,8 +91,17 @@ maxval_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -185,11 +191,8 @@ mmaxval_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -211,6 +214,34 @@ mmaxval_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 5ed4e16..8e94efb 100644 (file)
@@ -56,11 +56,8 @@ maxval_r4 (gfc_array_r4 *retarray, gfc_array_r4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -94,8 +91,17 @@ maxval_r4 (gfc_array_r4 *retarray, gfc_array_r4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -185,11 +191,8 @@ mmaxval_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -211,6 +214,34 @@ mmaxval_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 7311c38..40a3575 100644 (file)
@@ -56,11 +56,8 @@ maxval_r8 (gfc_array_r8 *retarray, gfc_array_r8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -94,8 +91,17 @@ maxval_r8 (gfc_array_r8 *retarray, gfc_array_r8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -185,11 +191,8 @@ mmaxval_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -211,6 +214,34 @@ mmaxval_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index defdc85..178bf5a 100644 (file)
@@ -53,13 +53,31 @@ minloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array)
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
@@ -150,17 +168,32 @@ mminloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array,
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
-  assert (GFC_DESCRIPTOR_RANK (mask) == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
 
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
index 0625e40..d87a444 100644 (file)
@@ -53,13 +53,31 @@ minloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array)
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
@@ -150,17 +168,32 @@ mminloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array,
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
-  assert (GFC_DESCRIPTOR_RANK (mask) == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
 
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
index ff69166..21c9edf 100644 (file)
@@ -53,13 +53,31 @@ minloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array)
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
@@ -150,17 +168,32 @@ mminloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array,
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
-  assert (GFC_DESCRIPTOR_RANK (mask) == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
 
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
index 6010bd1..a00d013 100644 (file)
@@ -53,13 +53,31 @@ minloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array)
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
@@ -150,17 +168,32 @@ mminloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array,
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
-  assert (GFC_DESCRIPTOR_RANK (mask) == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
 
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
index 2b40114..340c54d 100644 (file)
@@ -53,13 +53,31 @@ minloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array)
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
@@ -150,17 +168,32 @@ mminloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array,
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
-  assert (GFC_DESCRIPTOR_RANK (mask) == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
 
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
index 0398268..5941eb4 100644 (file)
@@ -53,13 +53,31 @@ minloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array)
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
@@ -150,17 +168,32 @@ mminloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array,
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
-  assert (GFC_DESCRIPTOR_RANK (mask) == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
 
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
index 80cd6e1..9900bc9 100644 (file)
@@ -53,13 +53,31 @@ minloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array)
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
@@ -150,17 +168,32 @@ mminloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array,
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
-  assert (GFC_DESCRIPTOR_RANK (mask) == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
 
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
index 9d94963..d1caf2a 100644 (file)
@@ -53,13 +53,31 @@ minloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array)
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
@@ -150,17 +168,32 @@ mminloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array,
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
-  assert (GFC_DESCRIPTOR_RANK (mask) == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
 
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
index 6744b4a..76f082b 100644 (file)
@@ -57,11 +57,8 @@ minloc1_4_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -95,8 +92,17 @@ minloc1_4_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -191,11 +197,8 @@ mminloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -217,6 +220,34 @@ mminloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index c9dad80..358b4fa 100644 (file)
@@ -57,11 +57,8 @@ minloc1_4_i8 (gfc_array_i4 *retarray, gfc_array_i8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -95,8 +92,17 @@ minloc1_4_i8 (gfc_array_i4 *retarray, gfc_array_i8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -191,11 +197,8 @@ mminloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -217,6 +220,34 @@ mminloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index f8d4c14..b61e6b5 100644 (file)
@@ -57,11 +57,8 @@ minloc1_4_r4 (gfc_array_i4 *retarray, gfc_array_r4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -95,8 +92,17 @@ minloc1_4_r4 (gfc_array_i4 *retarray, gfc_array_r4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -191,11 +197,8 @@ mminloc1_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -217,6 +220,34 @@ mminloc1_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 43a38c4..65c1fac 100644 (file)
@@ -57,11 +57,8 @@ minloc1_4_r8 (gfc_array_i4 *retarray, gfc_array_r8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -95,8 +92,17 @@ minloc1_4_r8 (gfc_array_i4 *retarray, gfc_array_r8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -191,11 +197,8 @@ mminloc1_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -217,6 +220,34 @@ mminloc1_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 0928a69..a428c91 100644 (file)
@@ -57,11 +57,8 @@ minloc1_8_i4 (gfc_array_i8 *retarray, gfc_array_i4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -95,8 +92,17 @@ minloc1_8_i4 (gfc_array_i8 *retarray, gfc_array_i4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -191,11 +197,8 @@ mminloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -217,6 +220,34 @@ mminloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 02545f5..fd7f8d6 100644 (file)
@@ -57,11 +57,8 @@ minloc1_8_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -95,8 +92,17 @@ minloc1_8_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -191,11 +197,8 @@ mminloc1_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -217,6 +220,34 @@ mminloc1_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 1192722..0f15fc4 100644 (file)
@@ -57,11 +57,8 @@ minloc1_8_r4 (gfc_array_i8 *retarray, gfc_array_r4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -95,8 +92,17 @@ minloc1_8_r4 (gfc_array_i8 *retarray, gfc_array_r4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -191,11 +197,8 @@ mminloc1_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -217,6 +220,34 @@ mminloc1_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index ca1c977..edd9a71 100644 (file)
@@ -57,11 +57,8 @@ minloc1_8_r8 (gfc_array_i8 *retarray, gfc_array_r8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -95,8 +92,17 @@ minloc1_8_r8 (gfc_array_i8 *retarray, gfc_array_r8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -191,11 +197,8 @@ mminloc1_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -217,6 +220,34 @@ mminloc1_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 8808eba..6933011 100644 (file)
@@ -56,11 +56,8 @@ minval_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -94,8 +91,17 @@ minval_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -185,11 +191,8 @@ mminval_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -211,6 +214,34 @@ mminval_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index bd55c10..579e5f9 100644 (file)
@@ -56,11 +56,8 @@ minval_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -94,8 +91,17 @@ minval_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -185,11 +191,8 @@ mminval_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -211,6 +214,34 @@ mminval_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 1e1568c..d936e2c 100644 (file)
@@ -56,11 +56,8 @@ minval_r4 (gfc_array_r4 *retarray, gfc_array_r4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -94,8 +91,17 @@ minval_r4 (gfc_array_r4 *retarray, gfc_array_r4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -185,11 +191,8 @@ mminval_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -211,6 +214,34 @@ mminval_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 68310d2..a85e29e 100644 (file)
@@ -56,11 +56,8 @@ minval_r8 (gfc_array_r8 *retarray, gfc_array_r8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -94,8 +91,17 @@ minval_r8 (gfc_array_r8 *retarray, gfc_array_r8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -185,11 +191,8 @@ mminval_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -211,6 +214,34 @@ mminval_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 6c03615..2960470 100644 (file)
@@ -55,11 +55,8 @@ product_c4 (gfc_array_c4 *retarray, gfc_array_c4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -93,8 +90,17 @@ product_c4 (gfc_array_c4 *retarray, gfc_array_c4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -183,11 +189,8 @@ mproduct_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -209,6 +212,34 @@ mproduct_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_COMPLEX_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index dbc6cb7..fc3eccb 100644 (file)
@@ -55,11 +55,8 @@ product_c8 (gfc_array_c8 *retarray, gfc_array_c8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -93,8 +90,17 @@ product_c8 (gfc_array_c8 *retarray, gfc_array_c8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -183,11 +189,8 @@ mproduct_c8 (gfc_array_c8 * retarray, gfc_array_c8 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -209,6 +212,34 @@ mproduct_c8 (gfc_array_c8 * retarray, gfc_array_c8 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_COMPLEX_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index f7481f6..d349b66 100644 (file)
@@ -55,11 +55,8 @@ product_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -93,8 +90,17 @@ product_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -183,11 +189,8 @@ mproduct_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -209,6 +212,34 @@ mproduct_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index b3237b2..1fe0745 100644 (file)
@@ -55,11 +55,8 @@ product_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -93,8 +90,17 @@ product_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -183,11 +189,8 @@ mproduct_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -209,6 +212,34 @@ mproduct_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 03844af..592210d 100644 (file)
@@ -55,11 +55,8 @@ product_r4 (gfc_array_r4 *retarray, gfc_array_r4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -93,8 +90,17 @@ product_r4 (gfc_array_r4 *retarray, gfc_array_r4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -183,11 +189,8 @@ mproduct_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -209,6 +212,34 @@ mproduct_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index daf4a9c..922bcbe 100644 (file)
@@ -55,11 +55,8 @@ product_r8 (gfc_array_r8 *retarray, gfc_array_r8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -93,8 +90,17 @@ product_r8 (gfc_array_r8 *retarray, gfc_array_r8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -183,11 +189,8 @@ mproduct_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -209,6 +212,34 @@ mproduct_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 37fd93c..74efd07 100644 (file)
@@ -55,11 +55,8 @@ sum_c4 (gfc_array_c4 *retarray, gfc_array_c4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -93,8 +90,17 @@ sum_c4 (gfc_array_c4 *retarray, gfc_array_c4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -183,11 +189,8 @@ msum_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -209,6 +212,34 @@ msum_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_COMPLEX_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index ec040cb..7d68810 100644 (file)
@@ -55,11 +55,8 @@ sum_c8 (gfc_array_c8 *retarray, gfc_array_c8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -93,8 +90,17 @@ sum_c8 (gfc_array_c8 *retarray, gfc_array_c8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -183,11 +189,8 @@ msum_c8 (gfc_array_c8 * retarray, gfc_array_c8 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -209,6 +212,34 @@ msum_c8 (gfc_array_c8 * retarray, gfc_array_c8 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_COMPLEX_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 371241c..01b4112 100644 (file)
@@ -55,11 +55,8 @@ sum_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -93,8 +90,17 @@ sum_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -183,11 +189,8 @@ msum_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -209,6 +212,34 @@ msum_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 10e3e99..df882c8 100644 (file)
@@ -55,11 +55,8 @@ sum_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -93,8 +90,17 @@ sum_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -183,11 +189,8 @@ msum_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -209,6 +212,34 @@ msum_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index aa993f3..d88384d 100644 (file)
@@ -55,11 +55,8 @@ sum_r4 (gfc_array_r4 *retarray, gfc_array_r4 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -93,8 +90,17 @@ sum_r4 (gfc_array_r4 *retarray, gfc_array_r4 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -183,11 +189,8 @@ msum_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -209,6 +212,34 @@ msum_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index a3540d8..6658de7 100644 (file)
@@ -55,11 +55,8 @@ sum_r8 (gfc_array_r8 *retarray, gfc_array_r8 *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -93,8 +90,17 @@ sum_r8 (gfc_array_r8 *retarray, gfc_array_r8 *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -183,11 +189,8 @@ msum_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array,
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -209,6 +212,34 @@ msum_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array,
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
index 105ca97..616caf9 100644 (file)
@@ -20,13 +20,31 @@ name`'rtype_qual`_'atype_code (rtype * retarray, atype *array)
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
@@ -109,17 +127,32 @@ void
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
-  assert (GFC_DESCRIPTOR_RANK (mask) == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 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;
+    }
 
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
index 6c4dfbe..b377677 100644 (file)
@@ -40,11 +40,8 @@ name`'rtype_qual`_'atype_code (rtype *retarray, atype *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -78,8 +75,17 @@ name`'rtype_qual`_'atype_code (rtype *retarray, atype *array, index_type *pdim)
                                 * retarray->dim[rank-1].stride
                                 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -168,11 +174,8 @@ void
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -194,6 +197,34 @@ void
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (rtype_name)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;