+2017-06-18 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ PR fortran/52473
+ * gfortran.dg/cshift_1.f90: New test.
+
2017-06-17 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
Remove dg-skip-if, dg-xfail-if, dg-xfail-run-if default args.
--- /dev/null
+! { dg-do run }
+! Take cshift through its paces to make sure no boundary
+! cases are wrong.
+
+module kinds
+ integer, parameter :: sp = selected_real_kind(6) ! Single precision
+end module kinds
+
+module replacements
+ use kinds
+contains
+ subroutine cshift_sp_3_v1 (array, shift, dim, res)
+ integer, parameter :: wp = sp
+ real(kind=wp), dimension(:,:,:), intent(in) :: array
+ integer, intent(in) :: shift, dim
+ real(kind=wp), dimension(:,:,:), intent(out) :: res
+ integer :: i,j,k
+ integer :: sh, rsh
+ integer :: n
+ integer :: n2, n3
+ res = 0
+ n3 = size(array,3)
+ n2 = size(array,2)
+ n1 = size(array,1)
+ if (dim == 1) then
+ n = n1
+ sh = modulo(shift, n)
+ rsh = n - sh
+ do k=1, n3
+ do j=1, n2
+ do i=1, rsh
+ res(i,j,k) = array(i+sh,j,k)
+ end do
+ do i=rsh+1,n
+ res(i,j,k) = array(i-rsh,j,k)
+ end do
+ end do
+ end do
+ else if (dim == 2) then
+ n = n2
+ sh = modulo(shift,n)
+ rsh = n - sh
+ do k=1, n3
+ do j=1, rsh
+ do i=1, n1
+ res(i,j,k) = array(i,j+sh, k)
+ end do
+ end do
+ do j=rsh+1, n
+ do i=1, n1
+ res(i,j,k) = array(i,j-rsh, k)
+ end do
+ end do
+ end do
+ else if (dim == 3) then
+ n = n3
+ sh = modulo(shift, n)
+ rsh = n - sh
+ do k=1, rsh
+ do j=1, n2
+ do i=1, n1
+ res(i,j,k) = array(i, j, k+sh)
+ end do
+ end do
+ end do
+ do k=rsh+1, n
+ do j=1, n2
+ do i=1, n1
+ res(i,j, k) = array(i, j, k-rsh)
+ end do
+ end do
+ end do
+ else
+ stop "Wrong argument to dim"
+ end if
+ end subroutine cshift_sp_3_v1
+end module replacements
+
+program testme
+ use kinds
+ use replacements
+ implicit none
+ integer, parameter :: wp = sp ! Working precision
+ INTEGER, PARAMETER :: n = 7
+ real(kind=wp), dimension(:,:,:), allocatable :: a,b,c
+ integer i, j, k
+ real:: t1, t2
+ integer, parameter :: nrep = 20
+
+ allocate (a(n,n,n), b(n,n,n),c(n,n,n))
+ call random_number(a)
+ do k = 1,3
+ do i=-3,3,2
+ call cshift_sp_3_v1 (a, i, k, b)
+ c = cshift(a,i,k)
+ if (any (c /= b)) call abort
+ end do
+ end do
+ deallocate (b,c)
+ allocate (b(n-1,n-1,n-1),c(n-1,n-1,n-1))
+ do k=1,3
+ do i=-3,3,2
+ call cshift_sp_3_v1 (a(1:n-1,1:n-1,1:n-1), i, k, b)
+ c = cshift(a(1:n-1,1:n-1,1:n-1), i, k)
+ if (any (c /= b)) call abort
+ end do
+ end do
+end program testme
+2017-06-18 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ PR fortran/52473
+ * m4/cshift0.m4: For arrays that are contiguous up to
+ shift, implement blocked algorighm for cshift.
+ * generated/cshift0_c10.c: Regenerated.
+ * generated/cshift0_c16.c: Regenerated.
+ * generated/cshift0_c4.c: Regenerated.
+ * generated/cshift0_c8.c: Regenerated.
+ * generated/cshift0_i1.c: Regenerated.
+ * generated/cshift0_i16.c: Regenerated.
+ * generated/cshift0_i2.c: Regenerated.
+ * generated/cshift0_i4.c: Regenerated.
+ * generated/cshift0_i8.c: Regenerated.
+ * generated/cshift0_r10.c: Regenerated.
+ * generated/cshift0_r16.c: Regenerated.
+ * generated/cshift0_r4.c: Regenerated.
+ * generated/cshift0_r8.c: Regenerated.
+
2017-06-06 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/80975
index_type len;
index_type n;
+ bool do_blocked;
+ index_type r_ex, a_ex;
+
which = which - 1;
sstride[0] = 0;
rstride[0] = 0;
soffset = 1;
len = 0;
- for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ r_ex = 1;
+ a_ex = 1;
+
+ if (which > 0)
{
- if (dim == which)
- {
- roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
- if (roffset == 0)
- roffset = 1;
- soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
- if (soffset == 0)
- soffset = 1;
- len = GFC_DESCRIPTOR_EXTENT(array,dim);
- }
- else
- {
- count[n] = 0;
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
- rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
- sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
- n++;
- }
+ /* Test if both ret and array are contiguous. */
+ do_blocked = true;
+ dim = GFC_DESCRIPTOR_RANK (array);
+ for (n = 0; n < dim; n ++)
+ {
+ index_type rs, as;
+ rs = GFC_DESCRIPTOR_STRIDE (ret, n);
+ if (rs != r_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ as = GFC_DESCRIPTOR_STRIDE (array, n);
+ if (as != a_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n);
+ a_ex *= GFC_DESCRIPTOR_EXTENT (array, n);
+ }
+ }
+ else
+ do_blocked = false;
+
+ n = 0;
+
+ if (do_blocked)
+ {
+ /* For contiguous arrays, use the relationship that
+
+ dimension(n1,n2,n3) :: a, b
+ b = cshift(a,sh,3)
+
+ can be dealt with as if
+
+ dimension(n1*n2*n3) :: an, bn
+ bn = cshift(a,sh*n1*n2,1)
+
+ we can used a more blocked algorithm for dim>1. */
+ sstride[0] = 1;
+ rstride[0] = 1;
+ roffset = 1;
+ soffset = 1;
+ len = GFC_DESCRIPTOR_STRIDE(array, which)
+ * GFC_DESCRIPTOR_EXTENT(array, which);
+ shift *= GFC_DESCRIPTOR_STRIDE(array, which);
+ for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ dim = GFC_DESCRIPTOR_RANK (array) - which;
+ }
+ else
+ {
+ for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ if (dim == which)
+ {
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ if (roffset == 0)
+ roffset = 1;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
+ if (soffset == 0)
+ soffset = 1;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ }
+ else
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ }
+ if (sstride[0] == 0)
+ sstride[0] = 1;
+ if (rstride[0] == 0)
+ rstride[0] = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (array);
}
- if (sstride[0] == 0)
- sstride[0] = 1;
- if (rstride[0] == 0)
- rstride[0] = 1;
- dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;
index_type len;
index_type n;
+ bool do_blocked;
+ index_type r_ex, a_ex;
+
which = which - 1;
sstride[0] = 0;
rstride[0] = 0;
soffset = 1;
len = 0;
- for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ r_ex = 1;
+ a_ex = 1;
+
+ if (which > 0)
{
- if (dim == which)
- {
- roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
- if (roffset == 0)
- roffset = 1;
- soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
- if (soffset == 0)
- soffset = 1;
- len = GFC_DESCRIPTOR_EXTENT(array,dim);
- }
- else
- {
- count[n] = 0;
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
- rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
- sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
- n++;
- }
+ /* Test if both ret and array are contiguous. */
+ do_blocked = true;
+ dim = GFC_DESCRIPTOR_RANK (array);
+ for (n = 0; n < dim; n ++)
+ {
+ index_type rs, as;
+ rs = GFC_DESCRIPTOR_STRIDE (ret, n);
+ if (rs != r_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ as = GFC_DESCRIPTOR_STRIDE (array, n);
+ if (as != a_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n);
+ a_ex *= GFC_DESCRIPTOR_EXTENT (array, n);
+ }
+ }
+ else
+ do_blocked = false;
+
+ n = 0;
+
+ if (do_blocked)
+ {
+ /* For contiguous arrays, use the relationship that
+
+ dimension(n1,n2,n3) :: a, b
+ b = cshift(a,sh,3)
+
+ can be dealt with as if
+
+ dimension(n1*n2*n3) :: an, bn
+ bn = cshift(a,sh*n1*n2,1)
+
+ we can used a more blocked algorithm for dim>1. */
+ sstride[0] = 1;
+ rstride[0] = 1;
+ roffset = 1;
+ soffset = 1;
+ len = GFC_DESCRIPTOR_STRIDE(array, which)
+ * GFC_DESCRIPTOR_EXTENT(array, which);
+ shift *= GFC_DESCRIPTOR_STRIDE(array, which);
+ for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ dim = GFC_DESCRIPTOR_RANK (array) - which;
+ }
+ else
+ {
+ for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ if (dim == which)
+ {
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ if (roffset == 0)
+ roffset = 1;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
+ if (soffset == 0)
+ soffset = 1;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ }
+ else
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ }
+ if (sstride[0] == 0)
+ sstride[0] = 1;
+ if (rstride[0] == 0)
+ rstride[0] = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (array);
}
- if (sstride[0] == 0)
- sstride[0] = 1;
- if (rstride[0] == 0)
- rstride[0] = 1;
- dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;
index_type len;
index_type n;
+ bool do_blocked;
+ index_type r_ex, a_ex;
+
which = which - 1;
sstride[0] = 0;
rstride[0] = 0;
soffset = 1;
len = 0;
- for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ r_ex = 1;
+ a_ex = 1;
+
+ if (which > 0)
{
- if (dim == which)
- {
- roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
- if (roffset == 0)
- roffset = 1;
- soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
- if (soffset == 0)
- soffset = 1;
- len = GFC_DESCRIPTOR_EXTENT(array,dim);
- }
- else
- {
- count[n] = 0;
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
- rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
- sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
- n++;
- }
+ /* Test if both ret and array are contiguous. */
+ do_blocked = true;
+ dim = GFC_DESCRIPTOR_RANK (array);
+ for (n = 0; n < dim; n ++)
+ {
+ index_type rs, as;
+ rs = GFC_DESCRIPTOR_STRIDE (ret, n);
+ if (rs != r_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ as = GFC_DESCRIPTOR_STRIDE (array, n);
+ if (as != a_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n);
+ a_ex *= GFC_DESCRIPTOR_EXTENT (array, n);
+ }
+ }
+ else
+ do_blocked = false;
+
+ n = 0;
+
+ if (do_blocked)
+ {
+ /* For contiguous arrays, use the relationship that
+
+ dimension(n1,n2,n3) :: a, b
+ b = cshift(a,sh,3)
+
+ can be dealt with as if
+
+ dimension(n1*n2*n3) :: an, bn
+ bn = cshift(a,sh*n1*n2,1)
+
+ we can used a more blocked algorithm for dim>1. */
+ sstride[0] = 1;
+ rstride[0] = 1;
+ roffset = 1;
+ soffset = 1;
+ len = GFC_DESCRIPTOR_STRIDE(array, which)
+ * GFC_DESCRIPTOR_EXTENT(array, which);
+ shift *= GFC_DESCRIPTOR_STRIDE(array, which);
+ for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ dim = GFC_DESCRIPTOR_RANK (array) - which;
+ }
+ else
+ {
+ for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ if (dim == which)
+ {
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ if (roffset == 0)
+ roffset = 1;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
+ if (soffset == 0)
+ soffset = 1;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ }
+ else
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ }
+ if (sstride[0] == 0)
+ sstride[0] = 1;
+ if (rstride[0] == 0)
+ rstride[0] = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (array);
}
- if (sstride[0] == 0)
- sstride[0] = 1;
- if (rstride[0] == 0)
- rstride[0] = 1;
- dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;
index_type len;
index_type n;
+ bool do_blocked;
+ index_type r_ex, a_ex;
+
which = which - 1;
sstride[0] = 0;
rstride[0] = 0;
soffset = 1;
len = 0;
- for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ r_ex = 1;
+ a_ex = 1;
+
+ if (which > 0)
{
- if (dim == which)
- {
- roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
- if (roffset == 0)
- roffset = 1;
- soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
- if (soffset == 0)
- soffset = 1;
- len = GFC_DESCRIPTOR_EXTENT(array,dim);
- }
- else
- {
- count[n] = 0;
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
- rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
- sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
- n++;
- }
+ /* Test if both ret and array are contiguous. */
+ do_blocked = true;
+ dim = GFC_DESCRIPTOR_RANK (array);
+ for (n = 0; n < dim; n ++)
+ {
+ index_type rs, as;
+ rs = GFC_DESCRIPTOR_STRIDE (ret, n);
+ if (rs != r_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ as = GFC_DESCRIPTOR_STRIDE (array, n);
+ if (as != a_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n);
+ a_ex *= GFC_DESCRIPTOR_EXTENT (array, n);
+ }
+ }
+ else
+ do_blocked = false;
+
+ n = 0;
+
+ if (do_blocked)
+ {
+ /* For contiguous arrays, use the relationship that
+
+ dimension(n1,n2,n3) :: a, b
+ b = cshift(a,sh,3)
+
+ can be dealt with as if
+
+ dimension(n1*n2*n3) :: an, bn
+ bn = cshift(a,sh*n1*n2,1)
+
+ we can used a more blocked algorithm for dim>1. */
+ sstride[0] = 1;
+ rstride[0] = 1;
+ roffset = 1;
+ soffset = 1;
+ len = GFC_DESCRIPTOR_STRIDE(array, which)
+ * GFC_DESCRIPTOR_EXTENT(array, which);
+ shift *= GFC_DESCRIPTOR_STRIDE(array, which);
+ for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ dim = GFC_DESCRIPTOR_RANK (array) - which;
+ }
+ else
+ {
+ for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ if (dim == which)
+ {
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ if (roffset == 0)
+ roffset = 1;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
+ if (soffset == 0)
+ soffset = 1;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ }
+ else
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ }
+ if (sstride[0] == 0)
+ sstride[0] = 1;
+ if (rstride[0] == 0)
+ rstride[0] = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (array);
}
- if (sstride[0] == 0)
- sstride[0] = 1;
- if (rstride[0] == 0)
- rstride[0] = 1;
- dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;
index_type len;
index_type n;
+ bool do_blocked;
+ index_type r_ex, a_ex;
+
which = which - 1;
sstride[0] = 0;
rstride[0] = 0;
soffset = 1;
len = 0;
- for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ r_ex = 1;
+ a_ex = 1;
+
+ if (which > 0)
{
- if (dim == which)
- {
- roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
- if (roffset == 0)
- roffset = 1;
- soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
- if (soffset == 0)
- soffset = 1;
- len = GFC_DESCRIPTOR_EXTENT(array,dim);
- }
- else
- {
- count[n] = 0;
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
- rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
- sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
- n++;
- }
+ /* Test if both ret and array are contiguous. */
+ do_blocked = true;
+ dim = GFC_DESCRIPTOR_RANK (array);
+ for (n = 0; n < dim; n ++)
+ {
+ index_type rs, as;
+ rs = GFC_DESCRIPTOR_STRIDE (ret, n);
+ if (rs != r_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ as = GFC_DESCRIPTOR_STRIDE (array, n);
+ if (as != a_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n);
+ a_ex *= GFC_DESCRIPTOR_EXTENT (array, n);
+ }
+ }
+ else
+ do_blocked = false;
+
+ n = 0;
+
+ if (do_blocked)
+ {
+ /* For contiguous arrays, use the relationship that
+
+ dimension(n1,n2,n3) :: a, b
+ b = cshift(a,sh,3)
+
+ can be dealt with as if
+
+ dimension(n1*n2*n3) :: an, bn
+ bn = cshift(a,sh*n1*n2,1)
+
+ we can used a more blocked algorithm for dim>1. */
+ sstride[0] = 1;
+ rstride[0] = 1;
+ roffset = 1;
+ soffset = 1;
+ len = GFC_DESCRIPTOR_STRIDE(array, which)
+ * GFC_DESCRIPTOR_EXTENT(array, which);
+ shift *= GFC_DESCRIPTOR_STRIDE(array, which);
+ for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ dim = GFC_DESCRIPTOR_RANK (array) - which;
+ }
+ else
+ {
+ for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ if (dim == which)
+ {
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ if (roffset == 0)
+ roffset = 1;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
+ if (soffset == 0)
+ soffset = 1;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ }
+ else
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ }
+ if (sstride[0] == 0)
+ sstride[0] = 1;
+ if (rstride[0] == 0)
+ rstride[0] = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (array);
}
- if (sstride[0] == 0)
- sstride[0] = 1;
- if (rstride[0] == 0)
- rstride[0] = 1;
- dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;
index_type len;
index_type n;
+ bool do_blocked;
+ index_type r_ex, a_ex;
+
which = which - 1;
sstride[0] = 0;
rstride[0] = 0;
soffset = 1;
len = 0;
- for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ r_ex = 1;
+ a_ex = 1;
+
+ if (which > 0)
{
- if (dim == which)
- {
- roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
- if (roffset == 0)
- roffset = 1;
- soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
- if (soffset == 0)
- soffset = 1;
- len = GFC_DESCRIPTOR_EXTENT(array,dim);
- }
- else
- {
- count[n] = 0;
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
- rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
- sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
- n++;
- }
+ /* Test if both ret and array are contiguous. */
+ do_blocked = true;
+ dim = GFC_DESCRIPTOR_RANK (array);
+ for (n = 0; n < dim; n ++)
+ {
+ index_type rs, as;
+ rs = GFC_DESCRIPTOR_STRIDE (ret, n);
+ if (rs != r_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ as = GFC_DESCRIPTOR_STRIDE (array, n);
+ if (as != a_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n);
+ a_ex *= GFC_DESCRIPTOR_EXTENT (array, n);
+ }
+ }
+ else
+ do_blocked = false;
+
+ n = 0;
+
+ if (do_blocked)
+ {
+ /* For contiguous arrays, use the relationship that
+
+ dimension(n1,n2,n3) :: a, b
+ b = cshift(a,sh,3)
+
+ can be dealt with as if
+
+ dimension(n1*n2*n3) :: an, bn
+ bn = cshift(a,sh*n1*n2,1)
+
+ we can used a more blocked algorithm for dim>1. */
+ sstride[0] = 1;
+ rstride[0] = 1;
+ roffset = 1;
+ soffset = 1;
+ len = GFC_DESCRIPTOR_STRIDE(array, which)
+ * GFC_DESCRIPTOR_EXTENT(array, which);
+ shift *= GFC_DESCRIPTOR_STRIDE(array, which);
+ for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ dim = GFC_DESCRIPTOR_RANK (array) - which;
+ }
+ else
+ {
+ for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ if (dim == which)
+ {
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ if (roffset == 0)
+ roffset = 1;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
+ if (soffset == 0)
+ soffset = 1;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ }
+ else
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ }
+ if (sstride[0] == 0)
+ sstride[0] = 1;
+ if (rstride[0] == 0)
+ rstride[0] = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (array);
}
- if (sstride[0] == 0)
- sstride[0] = 1;
- if (rstride[0] == 0)
- rstride[0] = 1;
- dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;
index_type len;
index_type n;
+ bool do_blocked;
+ index_type r_ex, a_ex;
+
which = which - 1;
sstride[0] = 0;
rstride[0] = 0;
soffset = 1;
len = 0;
- for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ r_ex = 1;
+ a_ex = 1;
+
+ if (which > 0)
{
- if (dim == which)
- {
- roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
- if (roffset == 0)
- roffset = 1;
- soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
- if (soffset == 0)
- soffset = 1;
- len = GFC_DESCRIPTOR_EXTENT(array,dim);
- }
- else
- {
- count[n] = 0;
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
- rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
- sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
- n++;
- }
+ /* Test if both ret and array are contiguous. */
+ do_blocked = true;
+ dim = GFC_DESCRIPTOR_RANK (array);
+ for (n = 0; n < dim; n ++)
+ {
+ index_type rs, as;
+ rs = GFC_DESCRIPTOR_STRIDE (ret, n);
+ if (rs != r_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ as = GFC_DESCRIPTOR_STRIDE (array, n);
+ if (as != a_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n);
+ a_ex *= GFC_DESCRIPTOR_EXTENT (array, n);
+ }
+ }
+ else
+ do_blocked = false;
+
+ n = 0;
+
+ if (do_blocked)
+ {
+ /* For contiguous arrays, use the relationship that
+
+ dimension(n1,n2,n3) :: a, b
+ b = cshift(a,sh,3)
+
+ can be dealt with as if
+
+ dimension(n1*n2*n3) :: an, bn
+ bn = cshift(a,sh*n1*n2,1)
+
+ we can used a more blocked algorithm for dim>1. */
+ sstride[0] = 1;
+ rstride[0] = 1;
+ roffset = 1;
+ soffset = 1;
+ len = GFC_DESCRIPTOR_STRIDE(array, which)
+ * GFC_DESCRIPTOR_EXTENT(array, which);
+ shift *= GFC_DESCRIPTOR_STRIDE(array, which);
+ for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ dim = GFC_DESCRIPTOR_RANK (array) - which;
+ }
+ else
+ {
+ for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ if (dim == which)
+ {
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ if (roffset == 0)
+ roffset = 1;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
+ if (soffset == 0)
+ soffset = 1;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ }
+ else
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ }
+ if (sstride[0] == 0)
+ sstride[0] = 1;
+ if (rstride[0] == 0)
+ rstride[0] = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (array);
}
- if (sstride[0] == 0)
- sstride[0] = 1;
- if (rstride[0] == 0)
- rstride[0] = 1;
- dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;
index_type len;
index_type n;
+ bool do_blocked;
+ index_type r_ex, a_ex;
+
which = which - 1;
sstride[0] = 0;
rstride[0] = 0;
soffset = 1;
len = 0;
- for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ r_ex = 1;
+ a_ex = 1;
+
+ if (which > 0)
{
- if (dim == which)
- {
- roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
- if (roffset == 0)
- roffset = 1;
- soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
- if (soffset == 0)
- soffset = 1;
- len = GFC_DESCRIPTOR_EXTENT(array,dim);
- }
- else
- {
- count[n] = 0;
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
- rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
- sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
- n++;
- }
+ /* Test if both ret and array are contiguous. */
+ do_blocked = true;
+ dim = GFC_DESCRIPTOR_RANK (array);
+ for (n = 0; n < dim; n ++)
+ {
+ index_type rs, as;
+ rs = GFC_DESCRIPTOR_STRIDE (ret, n);
+ if (rs != r_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ as = GFC_DESCRIPTOR_STRIDE (array, n);
+ if (as != a_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n);
+ a_ex *= GFC_DESCRIPTOR_EXTENT (array, n);
+ }
+ }
+ else
+ do_blocked = false;
+
+ n = 0;
+
+ if (do_blocked)
+ {
+ /* For contiguous arrays, use the relationship that
+
+ dimension(n1,n2,n3) :: a, b
+ b = cshift(a,sh,3)
+
+ can be dealt with as if
+
+ dimension(n1*n2*n3) :: an, bn
+ bn = cshift(a,sh*n1*n2,1)
+
+ we can used a more blocked algorithm for dim>1. */
+ sstride[0] = 1;
+ rstride[0] = 1;
+ roffset = 1;
+ soffset = 1;
+ len = GFC_DESCRIPTOR_STRIDE(array, which)
+ * GFC_DESCRIPTOR_EXTENT(array, which);
+ shift *= GFC_DESCRIPTOR_STRIDE(array, which);
+ for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ dim = GFC_DESCRIPTOR_RANK (array) - which;
+ }
+ else
+ {
+ for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ if (dim == which)
+ {
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ if (roffset == 0)
+ roffset = 1;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
+ if (soffset == 0)
+ soffset = 1;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ }
+ else
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ }
+ if (sstride[0] == 0)
+ sstride[0] = 1;
+ if (rstride[0] == 0)
+ rstride[0] = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (array);
}
- if (sstride[0] == 0)
- sstride[0] = 1;
- if (rstride[0] == 0)
- rstride[0] = 1;
- dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;
index_type len;
index_type n;
+ bool do_blocked;
+ index_type r_ex, a_ex;
+
which = which - 1;
sstride[0] = 0;
rstride[0] = 0;
soffset = 1;
len = 0;
- for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ r_ex = 1;
+ a_ex = 1;
+
+ if (which > 0)
{
- if (dim == which)
- {
- roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
- if (roffset == 0)
- roffset = 1;
- soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
- if (soffset == 0)
- soffset = 1;
- len = GFC_DESCRIPTOR_EXTENT(array,dim);
- }
- else
- {
- count[n] = 0;
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
- rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
- sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
- n++;
- }
+ /* Test if both ret and array are contiguous. */
+ do_blocked = true;
+ dim = GFC_DESCRIPTOR_RANK (array);
+ for (n = 0; n < dim; n ++)
+ {
+ index_type rs, as;
+ rs = GFC_DESCRIPTOR_STRIDE (ret, n);
+ if (rs != r_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ as = GFC_DESCRIPTOR_STRIDE (array, n);
+ if (as != a_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n);
+ a_ex *= GFC_DESCRIPTOR_EXTENT (array, n);
+ }
+ }
+ else
+ do_blocked = false;
+
+ n = 0;
+
+ if (do_blocked)
+ {
+ /* For contiguous arrays, use the relationship that
+
+ dimension(n1,n2,n3) :: a, b
+ b = cshift(a,sh,3)
+
+ can be dealt with as if
+
+ dimension(n1*n2*n3) :: an, bn
+ bn = cshift(a,sh*n1*n2,1)
+
+ we can used a more blocked algorithm for dim>1. */
+ sstride[0] = 1;
+ rstride[0] = 1;
+ roffset = 1;
+ soffset = 1;
+ len = GFC_DESCRIPTOR_STRIDE(array, which)
+ * GFC_DESCRIPTOR_EXTENT(array, which);
+ shift *= GFC_DESCRIPTOR_STRIDE(array, which);
+ for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ dim = GFC_DESCRIPTOR_RANK (array) - which;
+ }
+ else
+ {
+ for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ if (dim == which)
+ {
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ if (roffset == 0)
+ roffset = 1;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
+ if (soffset == 0)
+ soffset = 1;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ }
+ else
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ }
+ if (sstride[0] == 0)
+ sstride[0] = 1;
+ if (rstride[0] == 0)
+ rstride[0] = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (array);
}
- if (sstride[0] == 0)
- sstride[0] = 1;
- if (rstride[0] == 0)
- rstride[0] = 1;
- dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;
index_type len;
index_type n;
+ bool do_blocked;
+ index_type r_ex, a_ex;
+
which = which - 1;
sstride[0] = 0;
rstride[0] = 0;
soffset = 1;
len = 0;
- for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ r_ex = 1;
+ a_ex = 1;
+
+ if (which > 0)
{
- if (dim == which)
- {
- roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
- if (roffset == 0)
- roffset = 1;
- soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
- if (soffset == 0)
- soffset = 1;
- len = GFC_DESCRIPTOR_EXTENT(array,dim);
- }
- else
- {
- count[n] = 0;
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
- rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
- sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
- n++;
- }
+ /* Test if both ret and array are contiguous. */
+ do_blocked = true;
+ dim = GFC_DESCRIPTOR_RANK (array);
+ for (n = 0; n < dim; n ++)
+ {
+ index_type rs, as;
+ rs = GFC_DESCRIPTOR_STRIDE (ret, n);
+ if (rs != r_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ as = GFC_DESCRIPTOR_STRIDE (array, n);
+ if (as != a_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n);
+ a_ex *= GFC_DESCRIPTOR_EXTENT (array, n);
+ }
+ }
+ else
+ do_blocked = false;
+
+ n = 0;
+
+ if (do_blocked)
+ {
+ /* For contiguous arrays, use the relationship that
+
+ dimension(n1,n2,n3) :: a, b
+ b = cshift(a,sh,3)
+
+ can be dealt with as if
+
+ dimension(n1*n2*n3) :: an, bn
+ bn = cshift(a,sh*n1*n2,1)
+
+ we can used a more blocked algorithm for dim>1. */
+ sstride[0] = 1;
+ rstride[0] = 1;
+ roffset = 1;
+ soffset = 1;
+ len = GFC_DESCRIPTOR_STRIDE(array, which)
+ * GFC_DESCRIPTOR_EXTENT(array, which);
+ shift *= GFC_DESCRIPTOR_STRIDE(array, which);
+ for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ dim = GFC_DESCRIPTOR_RANK (array) - which;
+ }
+ else
+ {
+ for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ if (dim == which)
+ {
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ if (roffset == 0)
+ roffset = 1;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
+ if (soffset == 0)
+ soffset = 1;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ }
+ else
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ }
+ if (sstride[0] == 0)
+ sstride[0] = 1;
+ if (rstride[0] == 0)
+ rstride[0] = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (array);
}
- if (sstride[0] == 0)
- sstride[0] = 1;
- if (rstride[0] == 0)
- rstride[0] = 1;
- dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;
index_type len;
index_type n;
+ bool do_blocked;
+ index_type r_ex, a_ex;
+
which = which - 1;
sstride[0] = 0;
rstride[0] = 0;
soffset = 1;
len = 0;
- for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ r_ex = 1;
+ a_ex = 1;
+
+ if (which > 0)
{
- if (dim == which)
- {
- roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
- if (roffset == 0)
- roffset = 1;
- soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
- if (soffset == 0)
- soffset = 1;
- len = GFC_DESCRIPTOR_EXTENT(array,dim);
- }
- else
- {
- count[n] = 0;
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
- rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
- sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
- n++;
- }
+ /* Test if both ret and array are contiguous. */
+ do_blocked = true;
+ dim = GFC_DESCRIPTOR_RANK (array);
+ for (n = 0; n < dim; n ++)
+ {
+ index_type rs, as;
+ rs = GFC_DESCRIPTOR_STRIDE (ret, n);
+ if (rs != r_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ as = GFC_DESCRIPTOR_STRIDE (array, n);
+ if (as != a_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n);
+ a_ex *= GFC_DESCRIPTOR_EXTENT (array, n);
+ }
+ }
+ else
+ do_blocked = false;
+
+ n = 0;
+
+ if (do_blocked)
+ {
+ /* For contiguous arrays, use the relationship that
+
+ dimension(n1,n2,n3) :: a, b
+ b = cshift(a,sh,3)
+
+ can be dealt with as if
+
+ dimension(n1*n2*n3) :: an, bn
+ bn = cshift(a,sh*n1*n2,1)
+
+ we can used a more blocked algorithm for dim>1. */
+ sstride[0] = 1;
+ rstride[0] = 1;
+ roffset = 1;
+ soffset = 1;
+ len = GFC_DESCRIPTOR_STRIDE(array, which)
+ * GFC_DESCRIPTOR_EXTENT(array, which);
+ shift *= GFC_DESCRIPTOR_STRIDE(array, which);
+ for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ dim = GFC_DESCRIPTOR_RANK (array) - which;
+ }
+ else
+ {
+ for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ if (dim == which)
+ {
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ if (roffset == 0)
+ roffset = 1;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
+ if (soffset == 0)
+ soffset = 1;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ }
+ else
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ }
+ if (sstride[0] == 0)
+ sstride[0] = 1;
+ if (rstride[0] == 0)
+ rstride[0] = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (array);
}
- if (sstride[0] == 0)
- sstride[0] = 1;
- if (rstride[0] == 0)
- rstride[0] = 1;
- dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;
index_type len;
index_type n;
+ bool do_blocked;
+ index_type r_ex, a_ex;
+
which = which - 1;
sstride[0] = 0;
rstride[0] = 0;
soffset = 1;
len = 0;
- for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ r_ex = 1;
+ a_ex = 1;
+
+ if (which > 0)
{
- if (dim == which)
- {
- roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
- if (roffset == 0)
- roffset = 1;
- soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
- if (soffset == 0)
- soffset = 1;
- len = GFC_DESCRIPTOR_EXTENT(array,dim);
- }
- else
- {
- count[n] = 0;
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
- rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
- sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
- n++;
- }
+ /* Test if both ret and array are contiguous. */
+ do_blocked = true;
+ dim = GFC_DESCRIPTOR_RANK (array);
+ for (n = 0; n < dim; n ++)
+ {
+ index_type rs, as;
+ rs = GFC_DESCRIPTOR_STRIDE (ret, n);
+ if (rs != r_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ as = GFC_DESCRIPTOR_STRIDE (array, n);
+ if (as != a_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n);
+ a_ex *= GFC_DESCRIPTOR_EXTENT (array, n);
+ }
+ }
+ else
+ do_blocked = false;
+
+ n = 0;
+
+ if (do_blocked)
+ {
+ /* For contiguous arrays, use the relationship that
+
+ dimension(n1,n2,n3) :: a, b
+ b = cshift(a,sh,3)
+
+ can be dealt with as if
+
+ dimension(n1*n2*n3) :: an, bn
+ bn = cshift(a,sh*n1*n2,1)
+
+ we can used a more blocked algorithm for dim>1. */
+ sstride[0] = 1;
+ rstride[0] = 1;
+ roffset = 1;
+ soffset = 1;
+ len = GFC_DESCRIPTOR_STRIDE(array, which)
+ * GFC_DESCRIPTOR_EXTENT(array, which);
+ shift *= GFC_DESCRIPTOR_STRIDE(array, which);
+ for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ dim = GFC_DESCRIPTOR_RANK (array) - which;
+ }
+ else
+ {
+ for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ if (dim == which)
+ {
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ if (roffset == 0)
+ roffset = 1;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
+ if (soffset == 0)
+ soffset = 1;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ }
+ else
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ }
+ if (sstride[0] == 0)
+ sstride[0] = 1;
+ if (rstride[0] == 0)
+ rstride[0] = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (array);
}
- if (sstride[0] == 0)
- sstride[0] = 1;
- if (rstride[0] == 0)
- rstride[0] = 1;
- dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;
index_type len;
index_type n;
+ bool do_blocked;
+ index_type r_ex, a_ex;
+
which = which - 1;
sstride[0] = 0;
rstride[0] = 0;
soffset = 1;
len = 0;
- for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ r_ex = 1;
+ a_ex = 1;
+
+ if (which > 0)
{
- if (dim == which)
- {
- roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
- if (roffset == 0)
- roffset = 1;
- soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
- if (soffset == 0)
- soffset = 1;
- len = GFC_DESCRIPTOR_EXTENT(array,dim);
- }
- else
- {
- count[n] = 0;
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
- rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
- sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
- n++;
- }
+ /* Test if both ret and array are contiguous. */
+ do_blocked = true;
+ dim = GFC_DESCRIPTOR_RANK (array);
+ for (n = 0; n < dim; n ++)
+ {
+ index_type rs, as;
+ rs = GFC_DESCRIPTOR_STRIDE (ret, n);
+ if (rs != r_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ as = GFC_DESCRIPTOR_STRIDE (array, n);
+ if (as != a_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n);
+ a_ex *= GFC_DESCRIPTOR_EXTENT (array, n);
+ }
+ }
+ else
+ do_blocked = false;
+
+ n = 0;
+
+ if (do_blocked)
+ {
+ /* For contiguous arrays, use the relationship that
+
+ dimension(n1,n2,n3) :: a, b
+ b = cshift(a,sh,3)
+
+ can be dealt with as if
+
+ dimension(n1*n2*n3) :: an, bn
+ bn = cshift(a,sh*n1*n2,1)
+
+ we can used a more blocked algorithm for dim>1. */
+ sstride[0] = 1;
+ rstride[0] = 1;
+ roffset = 1;
+ soffset = 1;
+ len = GFC_DESCRIPTOR_STRIDE(array, which)
+ * GFC_DESCRIPTOR_EXTENT(array, which);
+ shift *= GFC_DESCRIPTOR_STRIDE(array, which);
+ for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ dim = GFC_DESCRIPTOR_RANK (array) - which;
+ }
+ else
+ {
+ for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ if (dim == which)
+ {
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ if (roffset == 0)
+ roffset = 1;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
+ if (soffset == 0)
+ soffset = 1;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ }
+ else
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ }
+ if (sstride[0] == 0)
+ sstride[0] = 1;
+ if (rstride[0] == 0)
+ rstride[0] = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (array);
}
- if (sstride[0] == 0)
- sstride[0] = 1;
- if (rstride[0] == 0)
- rstride[0] = 1;
- dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;
index_type len;
index_type n;
+ bool do_blocked;
+ index_type r_ex, a_ex;
+
which = which - 1;
sstride[0] = 0;
rstride[0] = 0;
soffset = 1;
len = 0;
- for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ r_ex = 1;
+ a_ex = 1;
+
+ if (which > 0)
{
- if (dim == which)
- {
- roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
- if (roffset == 0)
- roffset = 1;
- soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
- if (soffset == 0)
- soffset = 1;
- len = GFC_DESCRIPTOR_EXTENT(array,dim);
- }
- else
- {
- count[n] = 0;
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
- rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
- sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
- n++;
- }
+ /* Test if both ret and array are contiguous. */
+ do_blocked = true;
+ dim = GFC_DESCRIPTOR_RANK (array);
+ for (n = 0; n < dim; n ++)
+ {
+ index_type rs, as;
+ rs = GFC_DESCRIPTOR_STRIDE (ret, n);
+ if (rs != r_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ as = GFC_DESCRIPTOR_STRIDE (array, n);
+ if (as != a_ex)
+ {
+ do_blocked = false;
+ break;
+ }
+ r_ex *= GFC_DESCRIPTOR_EXTENT (ret, n);
+ a_ex *= GFC_DESCRIPTOR_EXTENT (array, n);
+ }
+ }
+ else
+ do_blocked = false;
+
+ n = 0;
+
+ if (do_blocked)
+ {
+ /* For contiguous arrays, use the relationship that
+
+ dimension(n1,n2,n3) :: a, b
+ b = cshift(a,sh,3)
+
+ can be dealt with as if
+
+ dimension(n1*n2*n3) :: an, bn
+ bn = cshift(a,sh*n1*n2,1)
+
+ we can used a more blocked algorithm for dim>1. */
+ sstride[0] = 1;
+ rstride[0] = 1;
+ roffset = 1;
+ soffset = 1;
+ len = GFC_DESCRIPTOR_STRIDE(array, which)
+ * GFC_DESCRIPTOR_EXTENT(array, which);
+ shift *= GFC_DESCRIPTOR_STRIDE(array, which);
+ for (dim = which + 1; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ dim = GFC_DESCRIPTOR_RANK (array) - which;
+ }
+ else
+ {
+ for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+ {
+ if (dim == which)
+ {
+ roffset = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ if (roffset == 0)
+ roffset = 1;
+ soffset = GFC_DESCRIPTOR_STRIDE(array,dim);
+ if (soffset == 0)
+ soffset = 1;
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ }
+ else
+ {
+ count[n] = 0;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);
+ rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim);
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim);
+ n++;
+ }
+ }
+ if (sstride[0] == 0)
+ sstride[0] = 1;
+ if (rstride[0] == 0)
+ rstride[0] = 1;
+
+ dim = GFC_DESCRIPTOR_RANK (array);
}
- if (sstride[0] == 0)
- sstride[0] = 1;
- if (rstride[0] == 0)
- rstride[0] = 1;
- dim = GFC_DESCRIPTOR_RANK (array);
rstride0 = rstride[0];
sstride0 = sstride[0];
rptr = ret->base_addr;
projects / thirdparty / gcc.git / commitdiff
