[multiple changes]

2009-07-19  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/34670
	PR libfortran/36874
	* Makefile.am:  Add bounds.c
	* libgfortran.h (bounds_equal_extents):  Add prototype.
	(bounds_iforeach_return):  Likewise.
	(bounds_ifunction_return):  Likewise.
	(bounds_reduced_extents):  Likewise.
	* runtime/bounds.c:  New file.
	(bounds_iforeach_return):  New function; correct typo in
	error message.
	(bounds_ifunction_return):  New function.
	(bounds_equal_extents):  New function.
	(bounds_reduced_extents):  Likewise.
	* intrinsics/cshift0.c (cshift0):  Use new functions
	for bounds checking.
	* intrinsics/eoshift0.c (eoshift0):  Likewise.
	* intrinsics/eoshift2.c (eoshift2):  Likewise.
	* m4/iforeach.m4:  Likewise.
	* m4/eoshift1.m4:  Likewise.
	* m4/eoshift3.m4:  Likewise.
	* m4/cshift1.m4:  Likewise.
	* m4/ifunction.m4:  Likewise.
	* Makefile.in:  Regenerated.
	* generated/cshift1_16.c: Regenerated.
	* generated/cshift1_4.c: Regenerated.
	* generated/cshift1_8.c: Regenerated.
	* generated/eoshift1_16.c: Regenerated.
	* generated/eoshift1_4.c: Regenerated.
	* generated/eoshift1_8.c: Regenerated.
	* generated/eoshift3_16.c: Regenerated.
	* generated/eoshift3_4.c: Regenerated.
	* generated/eoshift3_8.c: Regenerated.
	* generated/maxloc0_16_i1.c: Regenerated.
	* generated/maxloc0_16_i16.c: Regenerated.
	* generated/maxloc0_16_i2.c: Regenerated.
	* generated/maxloc0_16_i4.c: Regenerated.
	* generated/maxloc0_16_i8.c: Regenerated.
	* generated/maxloc0_16_r10.c: Regenerated.
	* generated/maxloc0_16_r16.c: Regenerated.
	* generated/maxloc0_16_r4.c: Regenerated.
	* generated/maxloc0_16_r8.c: Regenerated.
	* generated/maxloc0_4_i1.c: Regenerated.
	* generated/maxloc0_4_i16.c: Regenerated.
	* generated/maxloc0_4_i2.c: Regenerated.
	* generated/maxloc0_4_i4.c: Regenerated.
	* generated/maxloc0_4_i8.c: Regenerated.
	* generated/maxloc0_4_r10.c: Regenerated.
	* generated/maxloc0_4_r16.c: Regenerated.
	* generated/maxloc0_4_r4.c: Regenerated.
	* generated/maxloc0_4_r8.c: Regenerated.
	* generated/maxloc0_8_i1.c: Regenerated.
	* generated/maxloc0_8_i16.c: Regenerated.
	* generated/maxloc0_8_i2.c: Regenerated.
	* generated/maxloc0_8_i4.c: Regenerated.
	* generated/maxloc0_8_i8.c: Regenerated.
	* generated/maxloc0_8_r10.c: Regenerated.
	* generated/maxloc0_8_r16.c: Regenerated.
	* generated/maxloc0_8_r4.c: Regenerated.
	* generated/maxloc0_8_r8.c: Regenerated.
	* generated/maxloc1_16_i1.c: Regenerated.
	* generated/maxloc1_16_i16.c: Regenerated.
	* generated/maxloc1_16_i2.c: Regenerated.
	* generated/maxloc1_16_i4.c: Regenerated.
	* generated/maxloc1_16_i8.c: Regenerated.
	* generated/maxloc1_16_r10.c: Regenerated.
	* generated/maxloc1_16_r16.c: Regenerated.
	* generated/maxloc1_16_r4.c: Regenerated.
	* generated/maxloc1_16_r8.c: Regenerated.
	* generated/maxloc1_4_i1.c: Regenerated.
	* generated/maxloc1_4_i16.c: Regenerated.
	* generated/maxloc1_4_i2.c: Regenerated.
	* generated/maxloc1_4_i4.c: Regenerated.
	* generated/maxloc1_4_i8.c: Regenerated.
	* generated/maxloc1_4_r10.c: Regenerated.
	* generated/maxloc1_4_r16.c: Regenerated.
	* generated/maxloc1_4_r4.c: Regenerated.
	* generated/maxloc1_4_r8.c: Regenerated.
	* generated/maxloc1_8_i1.c: Regenerated.
	* generated/maxloc1_8_i16.c: Regenerated.
	* generated/maxloc1_8_i2.c: Regenerated.
	* generated/maxloc1_8_i4.c: Regenerated.
	* generated/maxloc1_8_i8.c: Regenerated.
	* generated/maxloc1_8_r10.c: Regenerated.
	* generated/maxloc1_8_r16.c: Regenerated.
	* generated/maxloc1_8_r4.c: Regenerated.
	* generated/maxloc1_8_r8.c: Regenerated.
	* generated/maxval_i1.c: Regenerated.
	* generated/maxval_i16.c: Regenerated.
	* generated/maxval_i2.c: Regenerated.
	* generated/maxval_i4.c: Regenerated.
	* generated/maxval_i8.c: Regenerated.
	* generated/maxval_r10.c: Regenerated.
	* generated/maxval_r16.c: Regenerated.
	* generated/maxval_r4.c: Regenerated.
	* generated/maxval_r8.c: Regenerated.
	* generated/minloc0_16_i1.c: Regenerated.
	* generated/minloc0_16_i16.c: Regenerated.
	* generated/minloc0_16_i2.c: Regenerated.
	* generated/minloc0_16_i4.c: Regenerated.
	* generated/minloc0_16_i8.c: Regenerated.
	* generated/minloc0_16_r10.c: Regenerated.
	* generated/minloc0_16_r16.c: Regenerated.
	* generated/minloc0_16_r4.c: Regenerated.
	* generated/minloc0_16_r8.c: Regenerated.
	* generated/minloc0_4_i1.c: Regenerated.
	* generated/minloc0_4_i16.c: Regenerated.
	* generated/minloc0_4_i2.c: Regenerated.
	* generated/minloc0_4_i4.c: Regenerated.
	* generated/minloc0_4_i8.c: Regenerated.
	* generated/minloc0_4_r10.c: Regenerated.
	* generated/minloc0_4_r16.c: Regenerated.
	* generated/minloc0_4_r4.c: Regenerated.
	* generated/minloc0_4_r8.c: Regenerated.
	* generated/minloc0_8_i1.c: Regenerated.
	* generated/minloc0_8_i16.c: Regenerated.
	* generated/minloc0_8_i2.c: Regenerated.
	* generated/minloc0_8_i4.c: Regenerated.
	* generated/minloc0_8_i8.c: Regenerated.
	* generated/minloc0_8_r10.c: Regenerated.
	* generated/minloc0_8_r16.c: Regenerated.
	* generated/minloc0_8_r4.c: Regenerated.
	* generated/minloc0_8_r8.c: Regenerated.
	* generated/minloc1_16_i1.c: Regenerated.
	* generated/minloc1_16_i16.c: Regenerated.
	* generated/minloc1_16_i2.c: Regenerated.
	* generated/minloc1_16_i4.c: Regenerated.
	* generated/minloc1_16_i8.c: Regenerated.
	* generated/minloc1_16_r10.c: Regenerated.
	* generated/minloc1_16_r16.c: Regenerated.
	* generated/minloc1_16_r4.c: Regenerated.
	* generated/minloc1_16_r8.c: Regenerated.
	* generated/minloc1_4_i1.c: Regenerated.
	* generated/minloc1_4_i16.c: Regenerated.
	* generated/minloc1_4_i2.c: Regenerated.
	* generated/minloc1_4_i4.c: Regenerated.
	* generated/minloc1_4_i8.c: Regenerated.
	* generated/minloc1_4_r10.c: Regenerated.
	* generated/minloc1_4_r16.c: Regenerated.
	* generated/minloc1_4_r4.c: Regenerated.
	* generated/minloc1_4_r8.c: Regenerated.
	* generated/minloc1_8_i1.c: Regenerated.
	* generated/minloc1_8_i16.c: Regenerated.
	* generated/minloc1_8_i2.c: Regenerated.
	* generated/minloc1_8_i4.c: Regenerated.
	* generated/minloc1_8_i8.c: Regenerated.
	* generated/minloc1_8_r10.c: Regenerated.
	* generated/minloc1_8_r16.c: Regenerated.
	* generated/minloc1_8_r4.c: Regenerated.
	* generated/minloc1_8_r8.c: Regenerated.
	* generated/minval_i1.c: Regenerated.
	* generated/minval_i16.c: Regenerated.
	* generated/minval_i2.c: Regenerated.
	* generated/minval_i4.c: Regenerated.
	* generated/minval_i8.c: Regenerated.
	* generated/minval_r10.c: Regenerated.
	* generated/minval_r16.c: Regenerated.
	* generated/minval_r4.c: Regenerated.
	* generated/minval_r8.c: Regenerated.
	* generated/product_c10.c: Regenerated.
	* generated/product_c16.c: Regenerated.
	* generated/product_c4.c: Regenerated.
	* generated/product_c8.c: Regenerated.
	* generated/product_i1.c: Regenerated.
	* generated/product_i16.c: Regenerated.
	* generated/product_i2.c: Regenerated.
	* generated/product_i4.c: Regenerated.
	* generated/product_i8.c: Regenerated.
	* generated/product_r10.c: Regenerated.
	* generated/product_r16.c: Regenerated.
	* generated/product_r4.c: Regenerated.
	* generated/product_r8.c: Regenerated.
	* generated/sum_c10.c: Regenerated.
	* generated/sum_c16.c: Regenerated.
	* generated/sum_c4.c: Regenerated.
	* generated/sum_c8.c: Regenerated.
	* generated/sum_i1.c: Regenerated.
	* generated/sum_i16.c: Regenerated.
	* generated/sum_i2.c: Regenerated.
	* generated/sum_i4.c: Regenerated.
	* generated/sum_i8.c: Regenerated.
	* generated/sum_r10.c: Regenerated.
	* generated/sum_r16.c: Regenerated.
	* generated/sum_r4.c: Regenerated.
	* generated/sum_r8.c: Regenerated.

2009-07-19   Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/34670
	PR libfortran/36874
	* gfortran.dg/cshift_bounds_1.f90:  New test.
	* gfortran.dg/cshift_bounds_2.f90:  New test.
	* gfortran.dg/cshift_bounds_3.f90:  New test.
	* gfortran.dg/cshift_bounds_4.f90:  New test.
	* gfortran.dg/eoshift_bounds_1.f90:  New test.
	* gfortran.dg/maxloc_bounds_4.f90:  Correct typo in error message.
	* gfortran.dg/maxloc_bounds_5.f90:  Correct typo in error message.
	* gfortran.dg/maxloc_bounds_7.f90:  Correct typo in error message.

From-SVN: r149792
This commit is contained in:
Thomas Koenig 2009-07-19 15:07:21 +00:00
parent a915ab0000
commit 16bff92192
183 changed files with 1829 additions and 6975 deletions

View File

@ -1,3 +1,16 @@
2009-07-19 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/34670
PR libfortran/36874
* gfortran.dg/cshift_bounds_1.f90: New test.
* gfortran.dg/cshift_bounds_2.f90: New test.
* gfortran.dg/cshift_bounds_3.f90: New test.
* gfortran.dg/cshift_bounds_4.f90: New test.
* gfortran.dg/eoshift_bounds_1.f90: New test.
* gfortran.dg/maxloc_bounds_4.f90: Correct typo in error message.
* gfortran.dg/maxloc_bounds_5.f90: Correct typo in error message.
* gfortran.dg/maxloc_bounds_7.f90: Correct typo in error message.
2009-07-19 Jan Hubicka <jh@suse.cz>
PR tree-optimization/40676

View File

@ -0,0 +1,24 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
! Check that empty arrays are handled correctly in
! cshift and eoshift
program main
character(len=50) :: line
character(len=3), dimension(2,2) :: a, b
integer :: n1, n2
line = '-1-2'
read (line,'(2I2)') n1, n2
call foo(a, b, n1, n2)
a = 'abc'
write (line,'(4A)') eoshift(a, 3)
write (line,'(4A)') cshift(a, 3)
write (line,'(4A)') cshift(a(:,1:n1), 3)
write (line,'(4A)') eoshift(a(1:n2,:), 3)
end program main
subroutine foo(a, b, n1, n2)
character(len=3), dimension(2, n1) :: a
character(len=3), dimension(n2, 2) :: b
a = cshift(b,1)
a = eoshift(b,1)
end subroutine foo

View File

@ -0,0 +1,11 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "Incorrect extent in return value of CSHIFT intrinsic in dimension 2: is 3, should be 2" }
program main
integer, dimension(:,:), allocatable :: a, b
allocate (a(2,2))
allocate (b(2,3))
a = 1
b = cshift(a,1)
end program main
! { dg-output "Fortran runtime error: Incorrect extent in return value of CSHIFT intrinsic in dimension 2: is 3, should be 2" }

View File

@ -0,0 +1,12 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "Incorrect size in SHIFT argument of CSHIFT intrinsic: should not be zero-sized" }
program main
real, dimension(1,0) :: a, b, c
integer :: sp(3), i
a = 4.0
sp = 1
i = 1
b = cshift (a,sp(1:i)) ! Invalid
end program main
! { dg-output "Fortran runtime error: Incorrect size in SHIFT argument of CSHIFT intrinsic: should not be zero-sized" }

View File

@ -0,0 +1,13 @@
! { dg-do run }
! { dg-shouldfail "Incorrect extent in SHIFT argument of CSHIFT intrinsic in dimension 1: is 3, should be 2" }
! { dg-options "-fbounds-check" }
program main
integer, dimension(:,:), allocatable :: a, b
integer, dimension(:), allocatable :: sh
allocate (a(2,2))
allocate (b(2,2))
allocate (sh(3))
a = 1
b = cshift(a,sh)
end program main
! { dg-output "Fortran runtime error: Incorrect extent in SHIFT argument of CSHIFT intrinsic in dimension 1: is 3, should be 2" }

View File

@ -0,0 +1,12 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "Incorrect size in SHIFT argument of EOSHIFT intrinsic: should not be zero-sized" }
program main
real, dimension(1,0) :: a, b, c
integer :: sp(3), i
a = 4.0
sp = 1
i = 1
b = eoshift (a,sp(1:i)) ! Invalid
end program main
! { dg-output "Fortran runtime error: Incorrect size in SHIFT argument of EOSHIFT intrinsic: should not be zero-sized" }

View File

@ -1,6 +1,6 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrnisic: is 3, should be 2" }
! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
module tst
contains
subroutine foo(res)
@ -18,6 +18,6 @@ program main
integer :: res(3)
call foo(res)
end program main
! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrnisic: is 3, should be 2" }
! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
! { dg-final { cleanup-modules "tst" } }

View File

@ -1,6 +1,6 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrnisic: is 3, should be 2" }
! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
module tst
contains
subroutine foo(res)
@ -18,5 +18,5 @@ program main
integer :: res(3)
call foo(res)
end program main
! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrnisic: is 3, should be 2" }
! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
! { dg-final { cleanup-modules "tst" } }

View File

@ -1,6 +1,6 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrnisic: is 3, should be 2" }
! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
module tst
contains
subroutine foo(res)
@ -18,5 +18,5 @@ program main
integer :: res(3)
call foo(res)
end program main
! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrnisic: is 3, should be 2" }
! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
! { dg-final { cleanup-modules "tst" } }

View File

@ -1,3 +1,190 @@
2009-07-19 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/34670
PR libfortran/36874
* Makefile.am: Add bounds.c
* libgfortran.h (bounds_equal_extents): Add prototype.
(bounds_iforeach_return): Likewise.
(bounds_ifunction_return): Likewise.
(bounds_reduced_extents): Likewise.
* runtime/bounds.c: New file.
(bounds_iforeach_return): New function; correct typo in
error message.
(bounds_ifunction_return): New function.
(bounds_equal_extents): New function.
(bounds_reduced_extents): Likewise.
* intrinsics/cshift0.c (cshift0): Use new functions
for bounds checking.
* intrinsics/eoshift0.c (eoshift0): Likewise.
* intrinsics/eoshift2.c (eoshift2): Likewise.
* m4/iforeach.m4: Likewise.
* m4/eoshift1.m4: Likewise.
* m4/eoshift3.m4: Likewise.
* m4/cshift1.m4: Likewise.
* m4/ifunction.m4: Likewise.
* Makefile.in: Regenerated.
* generated/cshift1_16.c: Regenerated.
* generated/cshift1_4.c: Regenerated.
* generated/cshift1_8.c: Regenerated.
* generated/eoshift1_16.c: Regenerated.
* generated/eoshift1_4.c: Regenerated.
* generated/eoshift1_8.c: Regenerated.
* generated/eoshift3_16.c: Regenerated.
* generated/eoshift3_4.c: Regenerated.
* generated/eoshift3_8.c: Regenerated.
* generated/maxloc0_16_i1.c: Regenerated.
* generated/maxloc0_16_i16.c: Regenerated.
* generated/maxloc0_16_i2.c: Regenerated.
* generated/maxloc0_16_i4.c: Regenerated.
* generated/maxloc0_16_i8.c: Regenerated.
* generated/maxloc0_16_r10.c: Regenerated.
* generated/maxloc0_16_r16.c: Regenerated.
* generated/maxloc0_16_r4.c: Regenerated.
* generated/maxloc0_16_r8.c: Regenerated.
* generated/maxloc0_4_i1.c: Regenerated.
* generated/maxloc0_4_i16.c: Regenerated.
* generated/maxloc0_4_i2.c: Regenerated.
* generated/maxloc0_4_i4.c: Regenerated.
* generated/maxloc0_4_i8.c: Regenerated.
* generated/maxloc0_4_r10.c: Regenerated.
* generated/maxloc0_4_r16.c: Regenerated.
* generated/maxloc0_4_r4.c: Regenerated.
* generated/maxloc0_4_r8.c: Regenerated.
* generated/maxloc0_8_i1.c: Regenerated.
* generated/maxloc0_8_i16.c: Regenerated.
* generated/maxloc0_8_i2.c: Regenerated.
* generated/maxloc0_8_i4.c: Regenerated.
* generated/maxloc0_8_i8.c: Regenerated.
* generated/maxloc0_8_r10.c: Regenerated.
* generated/maxloc0_8_r16.c: Regenerated.
* generated/maxloc0_8_r4.c: Regenerated.
* generated/maxloc0_8_r8.c: Regenerated.
* generated/maxloc1_16_i1.c: Regenerated.
* generated/maxloc1_16_i16.c: Regenerated.
* generated/maxloc1_16_i2.c: Regenerated.
* generated/maxloc1_16_i4.c: Regenerated.
* generated/maxloc1_16_i8.c: Regenerated.
* generated/maxloc1_16_r10.c: Regenerated.
* generated/maxloc1_16_r16.c: Regenerated.
* generated/maxloc1_16_r4.c: Regenerated.
* generated/maxloc1_16_r8.c: Regenerated.
* generated/maxloc1_4_i1.c: Regenerated.
* generated/maxloc1_4_i16.c: Regenerated.
* generated/maxloc1_4_i2.c: Regenerated.
* generated/maxloc1_4_i4.c: Regenerated.
* generated/maxloc1_4_i8.c: Regenerated.
* generated/maxloc1_4_r10.c: Regenerated.
* generated/maxloc1_4_r16.c: Regenerated.
* generated/maxloc1_4_r4.c: Regenerated.
* generated/maxloc1_4_r8.c: Regenerated.
* generated/maxloc1_8_i1.c: Regenerated.
* generated/maxloc1_8_i16.c: Regenerated.
* generated/maxloc1_8_i2.c: Regenerated.
* generated/maxloc1_8_i4.c: Regenerated.
* generated/maxloc1_8_i8.c: Regenerated.
* generated/maxloc1_8_r10.c: Regenerated.
* generated/maxloc1_8_r16.c: Regenerated.
* generated/maxloc1_8_r4.c: Regenerated.
* generated/maxloc1_8_r8.c: Regenerated.
* generated/maxval_i1.c: Regenerated.
* generated/maxval_i16.c: Regenerated.
* generated/maxval_i2.c: Regenerated.
* generated/maxval_i4.c: Regenerated.
* generated/maxval_i8.c: Regenerated.
* generated/maxval_r10.c: Regenerated.
* generated/maxval_r16.c: Regenerated.
* generated/maxval_r4.c: Regenerated.
* generated/maxval_r8.c: Regenerated.
* generated/minloc0_16_i1.c: Regenerated.
* generated/minloc0_16_i16.c: Regenerated.
* generated/minloc0_16_i2.c: Regenerated.
* generated/minloc0_16_i4.c: Regenerated.
* generated/minloc0_16_i8.c: Regenerated.
* generated/minloc0_16_r10.c: Regenerated.
* generated/minloc0_16_r16.c: Regenerated.
* generated/minloc0_16_r4.c: Regenerated.
* generated/minloc0_16_r8.c: Regenerated.
* generated/minloc0_4_i1.c: Regenerated.
* generated/minloc0_4_i16.c: Regenerated.
* generated/minloc0_4_i2.c: Regenerated.
* generated/minloc0_4_i4.c: Regenerated.
* generated/minloc0_4_i8.c: Regenerated.
* generated/minloc0_4_r10.c: Regenerated.
* generated/minloc0_4_r16.c: Regenerated.
* generated/minloc0_4_r4.c: Regenerated.
* generated/minloc0_4_r8.c: Regenerated.
* generated/minloc0_8_i1.c: Regenerated.
* generated/minloc0_8_i16.c: Regenerated.
* generated/minloc0_8_i2.c: Regenerated.
* generated/minloc0_8_i4.c: Regenerated.
* generated/minloc0_8_i8.c: Regenerated.
* generated/minloc0_8_r10.c: Regenerated.
* generated/minloc0_8_r16.c: Regenerated.
* generated/minloc0_8_r4.c: Regenerated.
* generated/minloc0_8_r8.c: Regenerated.
* generated/minloc1_16_i1.c: Regenerated.
* generated/minloc1_16_i16.c: Regenerated.
* generated/minloc1_16_i2.c: Regenerated.
* generated/minloc1_16_i4.c: Regenerated.
* generated/minloc1_16_i8.c: Regenerated.
* generated/minloc1_16_r10.c: Regenerated.
* generated/minloc1_16_r16.c: Regenerated.
* generated/minloc1_16_r4.c: Regenerated.
* generated/minloc1_16_r8.c: Regenerated.
* generated/minloc1_4_i1.c: Regenerated.
* generated/minloc1_4_i16.c: Regenerated.
* generated/minloc1_4_i2.c: Regenerated.
* generated/minloc1_4_i4.c: Regenerated.
* generated/minloc1_4_i8.c: Regenerated.
* generated/minloc1_4_r10.c: Regenerated.
* generated/minloc1_4_r16.c: Regenerated.
* generated/minloc1_4_r4.c: Regenerated.
* generated/minloc1_4_r8.c: Regenerated.
* generated/minloc1_8_i1.c: Regenerated.
* generated/minloc1_8_i16.c: Regenerated.
* generated/minloc1_8_i2.c: Regenerated.
* generated/minloc1_8_i4.c: Regenerated.
* generated/minloc1_8_i8.c: Regenerated.
* generated/minloc1_8_r10.c: Regenerated.
* generated/minloc1_8_r16.c: Regenerated.
* generated/minloc1_8_r4.c: Regenerated.
* generated/minloc1_8_r8.c: Regenerated.
* generated/minval_i1.c: Regenerated.
* generated/minval_i16.c: Regenerated.
* generated/minval_i2.c: Regenerated.
* generated/minval_i4.c: Regenerated.
* generated/minval_i8.c: Regenerated.
* generated/minval_r10.c: Regenerated.
* generated/minval_r16.c: Regenerated.
* generated/minval_r4.c: Regenerated.
* generated/minval_r8.c: Regenerated.
* generated/product_c10.c: Regenerated.
* generated/product_c16.c: Regenerated.
* generated/product_c4.c: Regenerated.
* generated/product_c8.c: Regenerated.
* generated/product_i1.c: Regenerated.
* generated/product_i16.c: Regenerated.
* generated/product_i2.c: Regenerated.
* generated/product_i4.c: Regenerated.
* generated/product_i8.c: Regenerated.
* generated/product_r10.c: Regenerated.
* generated/product_r16.c: Regenerated.
* generated/product_r4.c: Regenerated.
* generated/product_r8.c: Regenerated.
* generated/sum_c10.c: Regenerated.
* generated/sum_c16.c: Regenerated.
* generated/sum_c4.c: Regenerated.
* generated/sum_c8.c: Regenerated.
* generated/sum_i1.c: Regenerated.
* generated/sum_i16.c: Regenerated.
* generated/sum_i2.c: Regenerated.
* generated/sum_i4.c: Regenerated.
* generated/sum_i8.c: Regenerated.
* generated/sum_r10.c: Regenerated.
* generated/sum_r16.c: Regenerated.
* generated/sum_r4.c: Regenerated.
* generated/sum_r8.c: Regenerated.
2009-07-17 Janne Blomqvist <jb@gcc.gnu.org>
Jerry DeLisle <jvdelisle@gcc.gnu.org>

View File

@ -122,6 +122,7 @@ runtime/in_unpack_generic.c
gfor_src= \
runtime/backtrace.c \
runtime/bounds.c \
runtime/compile_options.c \
runtime/convert_char.c \
runtime/environ.c \

View File

@ -78,7 +78,7 @@ myexeclibLTLIBRARIES_INSTALL = $(INSTALL)
toolexeclibLTLIBRARIES_INSTALL = $(INSTALL)
LTLIBRARIES = $(myexeclib_LTLIBRARIES) $(toolexeclib_LTLIBRARIES)
libgfortran_la_LIBADD =
am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c \
am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c runtime/bounds.c \
runtime/compile_options.c runtime/convert_char.c \
runtime/environ.c runtime/error.c runtime/fpu.c runtime/main.c \
runtime/memory.c runtime/pause.c runtime/stop.c \
@ -580,9 +580,9 @@ am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c \
$(srcdir)/generated/misc_specifics.F90 intrinsics/dprod_r8.f90 \
intrinsics/f2c_specifics.F90 libgfortran_c.c $(filter-out \
%.c,$(prereq_SRC))
am__objects_1 = backtrace.lo compile_options.lo convert_char.lo \
environ.lo error.lo fpu.lo main.lo memory.lo pause.lo stop.lo \
string.lo select.lo
am__objects_1 = backtrace.lo bounds.lo compile_options.lo \
convert_char.lo environ.lo error.lo fpu.lo main.lo memory.lo \
pause.lo stop.lo string.lo select.lo
am__objects_2 = all_l1.lo all_l2.lo all_l4.lo all_l8.lo all_l16.lo
am__objects_3 = any_l1.lo any_l2.lo any_l4.lo any_l8.lo any_l16.lo
am__objects_4 = count_1_l.lo count_2_l.lo count_4_l.lo count_8_l.lo \
@ -1050,6 +1050,7 @@ runtime/in_unpack_generic.c
gfor_src = \
runtime/backtrace.c \
runtime/bounds.c \
runtime/compile_options.c \
runtime/convert_char.c \
runtime/environ.c \
@ -1806,6 +1807,7 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/associated.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/backtrace.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/bit_intrinsics.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/bounds.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c99_functions.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/chdir.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/chmod.Plo@am__quote@
@ -2678,6 +2680,13 @@ backtrace.lo: runtime/backtrace.c
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o backtrace.lo `test -f 'runtime/backtrace.c' || echo '$(srcdir)/'`runtime/backtrace.c
bounds.lo: runtime/bounds.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT bounds.lo -MD -MP -MF "$(DEPDIR)/bounds.Tpo" -c -o bounds.lo `test -f 'runtime/bounds.c' || echo '$(srcdir)/'`runtime/bounds.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/bounds.Tpo" "$(DEPDIR)/bounds.Plo"; else rm -f "$(DEPDIR)/bounds.Tpo"; exit 1; fi
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='runtime/bounds.c' object='bounds.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o bounds.lo `test -f 'runtime/bounds.c' || echo '$(srcdir)/'`runtime/bounds.c
compile_options.lo: runtime/compile_options.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT compile_options.lo -MD -MP -MF "$(DEPDIR)/compile_options.Tpo" -c -o compile_options.lo `test -f 'runtime/compile_options.c' || echo '$(srcdir)/'`runtime/compile_options.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/compile_options.Tpo" "$(DEPDIR)/compile_options.Plo"; else rm -f "$(DEPDIR)/compile_options.Tpo"; exit 1; fi

View File

@ -98,6 +98,17 @@ cshift1 (gfc_array_char * const restrict ret,
GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
}
}
else if (unlikely (compile_options.bounds_check))
{
bounds_equal_extents ((array_t *) ret, (array_t *) array,
"return value", "CSHIFT");
}
if (unlikely (compile_options.bounds_check))
{
bounds_reduced_extents ((array_t *) h, (array_t *) array, which,
"SHIFT argument", "CSHIFT");
}
if (arraysize == 0)
return;

View File

@ -98,6 +98,17 @@ cshift1 (gfc_array_char * const restrict ret,
GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
}
}
else if (unlikely (compile_options.bounds_check))
{
bounds_equal_extents ((array_t *) ret, (array_t *) array,
"return value", "CSHIFT");
}
if (unlikely (compile_options.bounds_check))
{
bounds_reduced_extents ((array_t *) h, (array_t *) array, which,
"SHIFT argument", "CSHIFT");
}
if (arraysize == 0)
return;

View File

@ -98,6 +98,17 @@ cshift1 (gfc_array_char * const restrict ret,
GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
}
}
else if (unlikely (compile_options.bounds_check))
{
bounds_equal_extents ((array_t *) ret, (array_t *) array,
"return value", "CSHIFT");
}
if (unlikely (compile_options.bounds_check))
{
bounds_reduced_extents ((array_t *) h, (array_t *) array, which,
"SHIFT argument", "CSHIFT");
}
if (arraysize == 0)
return;

View File

@ -62,6 +62,7 @@ eoshift1 (gfc_array_char * const restrict ret,
index_type len;
index_type n;
index_type size;
index_type arraysize;
int which;
GFC_INTEGER_16 sh;
GFC_INTEGER_16 delta;
@ -82,11 +83,12 @@ eoshift1 (gfc_array_char * const restrict ret,
extent[0] = 1;
count[0] = 0;
arraysize = size0 ((array_t *) array);
if (ret->data == NULL)
{
int i;
ret->data = internal_malloc_size (size * size0 ((array_t *)array));
ret->data = internal_malloc_size (size * arraysize);
ret->offset = 0;
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
@ -104,13 +106,27 @@ eoshift1 (gfc_array_char * const restrict ret,
GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
}
if (arraysize > 0)
ret->data = internal_malloc_size (size * arraysize);
else
ret->data = internal_malloc_size (1);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (size0 ((array_t *) ret) == 0)
return;
bounds_equal_extents ((array_t *) ret, (array_t *) array,
"return value", "EOSHIFT");
}
if (unlikely (compile_options.bounds_check))
{
bounds_reduced_extents ((array_t *) h, (array_t *) array, which,
"SHIFT argument", "EOSHIFT");
}
if (arraysize == 0)
return;
n = 0;
for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
{

View File

@ -62,6 +62,7 @@ eoshift1 (gfc_array_char * const restrict ret,
index_type len;
index_type n;
index_type size;
index_type arraysize;
int which;
GFC_INTEGER_4 sh;
GFC_INTEGER_4 delta;
@ -82,11 +83,12 @@ eoshift1 (gfc_array_char * const restrict ret,
extent[0] = 1;
count[0] = 0;
arraysize = size0 ((array_t *) array);
if (ret->data == NULL)
{
int i;
ret->data = internal_malloc_size (size * size0 ((array_t *)array));
ret->data = internal_malloc_size (size * arraysize);
ret->offset = 0;
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
@ -104,13 +106,27 @@ eoshift1 (gfc_array_char * const restrict ret,
GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
}
if (arraysize > 0)
ret->data = internal_malloc_size (size * arraysize);
else
ret->data = internal_malloc_size (1);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (size0 ((array_t *) ret) == 0)
return;
bounds_equal_extents ((array_t *) ret, (array_t *) array,
"return value", "EOSHIFT");
}
if (unlikely (compile_options.bounds_check))
{
bounds_reduced_extents ((array_t *) h, (array_t *) array, which,
"SHIFT argument", "EOSHIFT");
}
if (arraysize == 0)
return;
n = 0;
for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
{

View File

@ -62,6 +62,7 @@ eoshift1 (gfc_array_char * const restrict ret,
index_type len;
index_type n;
index_type size;
index_type arraysize;
int which;
GFC_INTEGER_8 sh;
GFC_INTEGER_8 delta;
@ -82,11 +83,12 @@ eoshift1 (gfc_array_char * const restrict ret,
extent[0] = 1;
count[0] = 0;
arraysize = size0 ((array_t *) array);
if (ret->data == NULL)
{
int i;
ret->data = internal_malloc_size (size * size0 ((array_t *)array));
ret->data = internal_malloc_size (size * arraysize);
ret->offset = 0;
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
@ -104,13 +106,27 @@ eoshift1 (gfc_array_char * const restrict ret,
GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
}
if (arraysize > 0)
ret->data = internal_malloc_size (size * arraysize);
else
ret->data = internal_malloc_size (1);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (size0 ((array_t *) ret) == 0)
return;
bounds_equal_extents ((array_t *) ret, (array_t *) array,
"return value", "EOSHIFT");
}
if (unlikely (compile_options.bounds_check))
{
bounds_reduced_extents ((array_t *) h, (array_t *) array, which,
"SHIFT argument", "EOSHIFT");
}
if (arraysize == 0)
return;
n = 0;
for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
{

View File

@ -66,6 +66,7 @@ eoshift3 (gfc_array_char * const restrict ret,
index_type len;
index_type n;
index_type size;
index_type arraysize;
int which;
GFC_INTEGER_16 sh;
GFC_INTEGER_16 delta;
@ -76,6 +77,7 @@ eoshift3 (gfc_array_char * const restrict ret,
soffset = 0;
roffset = 0;
arraysize = size0 ((array_t *) array);
size = GFC_DESCRIPTOR_SIZE(array);
if (pwhich)
@ -87,7 +89,7 @@ eoshift3 (gfc_array_char * const restrict ret,
{
int i;
ret->data = internal_malloc_size (size * size0 ((array_t *)array));
ret->data = internal_malloc_size (size * arraysize);
ret->offset = 0;
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
@ -105,13 +107,26 @@ eoshift3 (gfc_array_char * const restrict ret,
GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
}
if (arraysize > 0)
ret->data = internal_malloc_size (size * arraysize);
else
ret->data = internal_malloc_size (1);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (size0 ((array_t *) ret) == 0)
return;
bounds_equal_extents ((array_t *) ret, (array_t *) array,
"return value", "EOSHIFT");
}
if (unlikely (compile_options.bounds_check))
{
bounds_reduced_extents ((array_t *) h, (array_t *) array, which,
"SHIFT argument", "EOSHIFT");
}
if (arraysize == 0)
return;
extent[0] = 1;
count[0] = 0;

View File

@ -66,6 +66,7 @@ eoshift3 (gfc_array_char * const restrict ret,
index_type len;
index_type n;
index_type size;
index_type arraysize;
int which;
GFC_INTEGER_4 sh;
GFC_INTEGER_4 delta;
@ -76,6 +77,7 @@ eoshift3 (gfc_array_char * const restrict ret,
soffset = 0;
roffset = 0;
arraysize = size0 ((array_t *) array);
size = GFC_DESCRIPTOR_SIZE(array);
if (pwhich)
@ -87,7 +89,7 @@ eoshift3 (gfc_array_char * const restrict ret,
{
int i;
ret->data = internal_malloc_size (size * size0 ((array_t *)array));
ret->data = internal_malloc_size (size * arraysize);
ret->offset = 0;
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
@ -105,13 +107,26 @@ eoshift3 (gfc_array_char * const restrict ret,
GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
}
if (arraysize > 0)
ret->data = internal_malloc_size (size * arraysize);
else
ret->data = internal_malloc_size (1);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (size0 ((array_t *) ret) == 0)
return;
bounds_equal_extents ((array_t *) ret, (array_t *) array,
"return value", "EOSHIFT");
}
if (unlikely (compile_options.bounds_check))
{
bounds_reduced_extents ((array_t *) h, (array_t *) array, which,
"SHIFT argument", "EOSHIFT");
}
if (arraysize == 0)
return;
extent[0] = 1;
count[0] = 0;

View File

@ -66,6 +66,7 @@ eoshift3 (gfc_array_char * const restrict ret,
index_type len;
index_type n;
index_type size;
index_type arraysize;
int which;
GFC_INTEGER_8 sh;
GFC_INTEGER_8 delta;
@ -76,6 +77,7 @@ eoshift3 (gfc_array_char * const restrict ret,
soffset = 0;
roffset = 0;
arraysize = size0 ((array_t *) array);
size = GFC_DESCRIPTOR_SIZE(array);
if (pwhich)
@ -87,7 +89,7 @@ eoshift3 (gfc_array_char * const restrict ret,
{
int i;
ret->data = internal_malloc_size (size * size0 ((array_t *)array));
ret->data = internal_malloc_size (size * arraysize);
ret->offset = 0;
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
@ -105,13 +107,26 @@ eoshift3 (gfc_array_char * const restrict ret,
GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
}
if (arraysize > 0)
ret->data = internal_malloc_size (size * arraysize);
else
ret->data = internal_malloc_size (1);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (size0 ((array_t *) ret) == 0)
return;
bounds_equal_extents ((array_t *) ret, (array_t *) array,
"return value", "EOSHIFT");
}
if (unlikely (compile_options.bounds_check))
{
bounds_reduced_extents ((array_t *) h, (array_t *) array, which,
"SHIFT argument", "EOSHIFT");
}
if (arraysize == 0)
return;
extent[0] = 1;
count[0] = 0;

View File

@ -63,21 +63,8 @@ maxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_8_i2 (gfc_array_i8 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_8_i2 (gfc_array_i8 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_8_i2 (gfc_array_i8 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_8_i4 (gfc_array_i8 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_8_i4 (gfc_array_i8 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_8_i4 (gfc_array_i8 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_8_i8 (gfc_array_i8 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_8_i8 (gfc_array_i8 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_8_i8 (gfc_array_i8 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_8_r10 (gfc_array_i8 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_8_r10 (gfc_array_i8 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_8_r16 (gfc_array_i8 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_8_r16 (gfc_array_i8 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_8_r16 (gfc_array_i8 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_8_r4 (gfc_array_i8 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_8_r4 (gfc_array_i8 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_8_r4 (gfc_array_i8 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ maxloc0_8_r8 (gfc_array_i8 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mmaxloc0_8_r8 (gfc_array_i8 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MAXLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}
@ -340,22 +300,10 @@ smaxloc0_8_r8 (gfc_array_i8 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MAXLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MAXLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -120,19 +120,8 @@ maxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -120,19 +120,8 @@ maxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
}
for (n = 0; n < rank; n++)
@ -313,29 +302,10 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXLOC");
}
}

View File

@ -119,19 +119,8 @@ maxval_i1 (gfc_array_i1 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXVAL");
}
for (n = 0; n < rank; n++)
@ -307,29 +296,10 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXVAL");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXVAL");
}
}

View File

@ -119,19 +119,8 @@ maxval_i16 (gfc_array_i16 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXVAL");
}
for (n = 0; n < rank; n++)
@ -307,29 +296,10 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXVAL");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXVAL");
}
}

View File

@ -119,19 +119,8 @@ maxval_i2 (gfc_array_i2 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXVAL");
}
for (n = 0; n < rank; n++)
@ -307,29 +296,10 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXVAL");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXVAL");
}
}

View File

@ -119,19 +119,8 @@ maxval_i4 (gfc_array_i4 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXVAL");
}
for (n = 0; n < rank; n++)
@ -307,29 +296,10 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXVAL");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXVAL");
}
}

View File

@ -119,19 +119,8 @@ maxval_i8 (gfc_array_i8 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXVAL");
}
for (n = 0; n < rank; n++)
@ -307,29 +296,10 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXVAL");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXVAL");
}
}

View File

@ -119,19 +119,8 @@ maxval_r10 (gfc_array_r10 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXVAL");
}
for (n = 0; n < rank; n++)
@ -307,29 +296,10 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXVAL");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXVAL");
}
}

View File

@ -119,19 +119,8 @@ maxval_r16 (gfc_array_r16 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXVAL");
}
for (n = 0; n < rank; n++)
@ -307,29 +296,10 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXVAL");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXVAL");
}
}

View File

@ -119,19 +119,8 @@ maxval_r4 (gfc_array_r4 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXVAL");
}
for (n = 0; n < rank; n++)
@ -307,29 +296,10 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXVAL");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXVAL");
}
}

View File

@ -119,19 +119,8 @@ maxval_r8 (gfc_array_r8 * const restrict retarray,
(long int) rank);
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXVAL");
}
for (n = 0; n < rank; n++)
@ -307,29 +296,10 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray,
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
for (n=0; n<= rank; n++)
{
index_type mask_extent, array_extent;
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MAXVAL intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_ifunction_return ((array_t *) retarray, extent,
"return value", "MAXVAL");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MAXVAL");
}
}

View File

@ -63,21 +63,8 @@ minloc0_16_i1 (gfc_array_i16 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mminloc0_16_i1 (gfc_array_i16 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MINLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
@ -340,22 +300,10 @@ sminloc0_16_i1 (gfc_array_i16 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ minloc0_16_i16 (gfc_array_i16 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mminloc0_16_i16 (gfc_array_i16 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MINLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
@ -340,22 +300,10 @@ sminloc0_16_i16 (gfc_array_i16 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ minloc0_16_i2 (gfc_array_i16 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mminloc0_16_i2 (gfc_array_i16 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MINLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
@ -340,22 +300,10 @@ sminloc0_16_i2 (gfc_array_i16 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ minloc0_16_i4 (gfc_array_i16 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mminloc0_16_i4 (gfc_array_i16 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MINLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
@ -340,22 +300,10 @@ sminloc0_16_i4 (gfc_array_i16 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ minloc0_16_i8 (gfc_array_i16 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mminloc0_16_i8 (gfc_array_i16 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MINLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
@ -340,22 +300,10 @@ sminloc0_16_i8 (gfc_array_i16 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ minloc0_16_r10 (gfc_array_i16 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mminloc0_16_r10 (gfc_array_i16 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MINLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
@ -340,22 +300,10 @@ sminloc0_16_r10 (gfc_array_i16 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ minloc0_16_r16 (gfc_array_i16 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mminloc0_16_r16 (gfc_array_i16 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MINLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
@ -340,22 +300,10 @@ sminloc0_16_r16 (gfc_array_i16 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ minloc0_16_r4 (gfc_array_i16 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mminloc0_16_r4 (gfc_array_i16 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MINLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
@ -340,22 +300,10 @@ sminloc0_16_r4 (gfc_array_i16 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ minloc0_16_r8 (gfc_array_i16 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mminloc0_16_r8 (gfc_array_i16 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MINLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
@ -340,22 +300,10 @@ sminloc0_16_r8 (gfc_array_i16 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ minloc0_4_i1 (gfc_array_i4 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mminloc0_4_i1 (gfc_array_i4 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MINLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
@ -340,22 +300,10 @@ sminloc0_4_i1 (gfc_array_i4 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ minloc0_4_i16 (gfc_array_i4 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mminloc0_4_i16 (gfc_array_i4 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MINLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
@ -340,22 +300,10 @@ sminloc0_4_i16 (gfc_array_i4 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ minloc0_4_i2 (gfc_array_i4 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mminloc0_4_i2 (gfc_array_i4 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MINLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
@ -340,22 +300,10 @@ sminloc0_4_i2 (gfc_array_i4 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ minloc0_4_i4 (gfc_array_i4 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mminloc0_4_i4 (gfc_array_i4 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MINLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
@ -340,22 +300,10 @@ sminloc0_4_i4 (gfc_array_i4 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ minloc0_4_i8 (gfc_array_i4 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mminloc0_4_i8 (gfc_array_i4 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MINLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
@ -340,22 +300,10 @@ sminloc0_4_i8 (gfc_array_i4 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ minloc0_4_r10 (gfc_array_i4 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mminloc0_4_r10 (gfc_array_i4 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MINLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
@ -340,22 +300,10 @@ sminloc0_4_r10 (gfc_array_i4 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

View File

@ -63,21 +63,8 @@ minloc0_4_r16 (gfc_array_i4 * const restrict retarray,
else
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@ -186,38 +173,11 @@ mminloc0_4_r16 (gfc_array_i4 * const restrict retarray,
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank, mask_rank;
index_type ret_extent;
int n;
index_type array_extent, mask_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("Incorrect extent in return value of"
" MINLOC intrnisic: is %ld, should be %ld",
(long int) ret_extent, (long int) rank);
mask_rank = GFC_DESCRIPTOR_RANK (mask);
if (rank != mask_rank)
runtime_error ("rank of MASK argument in MINLOC intrnisic"
"should be %ld, is %ld", (long int) rank,
(long int) mask_rank);
for (n=0; n<rank; n++)
{
array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
if (array_extent != mask_extent)
runtime_error ("Incorrect extent in MASK argument of"
" MINLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) mask_extent, (long int) array_extent);
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
bounds_equal_extents ((array_t *) mask, (array_t *) array,
"MASK argument", "MINLOC");
}
}
@ -340,22 +300,10 @@ sminloc0_4_r16 (gfc_array_i4 * const restrict retarray,
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
else
else if (unlikely (compile_options.bounds_check))
{
if (unlikely (compile_options.bounds_check))
{
int ret_rank;
index_type ret_extent;
ret_rank = GFC_DESCRIPTOR_RANK (retarray);
if (ret_rank != 1)
runtime_error ("rank of return array in MINLOC intrinsic"
" should be 1, is %ld", (long int) ret_rank);
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
if (ret_extent != rank)
runtime_error ("dimension of return array incorrect");
}
bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
"MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);

Some files were not shown because too many files have changed in this diff Show More