blob: 85e5dab607d60736b925226f5ffbe48f2174792b [file] [log] [blame]
! { dg-do run }
! Check that eoshift works for three-dimensional arrays.
module x
implicit none
contains
subroutine eoshift_2 (array, shift, boundary, dim, res)
real, dimension(:,:,:), intent(in) :: array
real, dimension(:,:,:), intent(out) :: res
integer, value :: shift
real, optional, dimension(:,:), intent(in) :: boundary
integer, optional, intent(in) :: dim
integer :: s1, s2, s3
integer :: n1, n2, n3
real :: b
integer :: d
if (present(dim)) then
d = dim
else
d = 1
end if
n1 = size(array,1)
n2 = size(array,2)
n3 = size(array,3)
select case(dim)
case(1)
if (shift > 0) then
shift = min(shift, n1)
do s3=1,n3
do s2=1,n2
b = boundary(s2,s3)
do s1= 1, n1 - shift
res(s1,s2,s3) = array(s1+shift,s2,s3)
end do
do s1 = n1 - shift + 1,n1
res(s1,s2,s3) = b
end do
end do
end do
else
shift = max(shift, -n1)
do s3=1,n3
do s2=1,n2
b = boundary(s2,s3)
do s1=1,-shift
res(s1,s2,s3) = b
end do
do s1= 1-shift,n1
res(s1,s2,s3) = array(s1+shift,s2,s3)
end do
end do
end do
end if
case(2)
if (shift > 0) then
shift = min(shift, n2)
do s3=1,n3
do s2=1, n2 - shift
do s1=1,n1
res(s1,s2,s3) = array(s1,s2+shift,s3)
end do
end do
do s2=n2 - shift + 1, n2
do s1=1,n1
b = boundary(s1,s3)
res(s1,s2,s3) = b
end do
end do
end do
else
shift = max(shift, -n2)
do s3=1,n3
do s2=1,-shift
do s1=1,n1
b = boundary(s1,s3)
res(s1,s2,s3) = b
end do
end do
do s2=1-shift,n2
do s1=1,n1
res(s1,s2,s3) = array(s1,s2+shift,s3)
end do
end do
end do
end if
case(3)
if (shift > 0) then
shift = min(shift, n3)
do s3=1,n3 - shift
do s2=1, n2
do s1=1,n1
res(s1,s2,s3) = array(s1,s2,s3+shift)
end do
end do
end do
do s3=n3 - shift + 1, n3
do s2=1, n2
do s1=1,n1
b = boundary(s1,s2)
res(s1,s2,s3) = b
end do
end do
end do
else
shift = max(shift, -n3)
do s3=1,-shift
do s2=1,n2
do s1=1,n1
b = boundary(s1,s2)
res(s1,s2,s3) = b
end do
end do
end do
do s3=1-shift,n3
do s2=1,n2
do s1=1,n1
res(s1,s2,s3) = array(s1,s2,s3+shift)
end do
end do
end do
end if
case default
stop "Illegal dim"
end select
end subroutine eoshift_2
end module x
program main
use x
implicit none
integer, parameter :: n1=20,n2=30,n3=40
real, dimension(n1,n2,n3) :: a,b,c
real, dimension(2*n1,n2,n3) :: a2,c2
integer :: dim, shift, shift_lim
real, dimension(n2,n3), target :: b1
real, dimension(n1,n3), target :: b2
real, dimension(n1,n2), target :: b3
real, dimension(:,:), pointer :: bp
call random_number(a)
call random_number (b1)
call random_number (b2)
call random_number (b3)
do dim=1,3
if (dim == 1) then
shift_lim = n1 + 1
bp => b1
else if (dim == 2) then
shift_lim = n2 + 1
bp => b2
else
shift_lim = n3 + 1
bp => b3
end if
do shift=-shift_lim, shift_lim
b = eoshift(a,shift,dim=dim, boundary=bp)
call eoshift_2 (a, shift=shift, dim=dim, boundary=bp, res=c)
if (any (b /= c)) then
print *,"dim = ", dim, "shift = ", shift
print *,b
print *,c
STOP 1
end if
a2 = 42.
a2(1:2*n1:2,:,:) = a
b = eoshift(a2(1:2*n1:2,:,:), shift, dim=dim, boundary=bp)
if (any (b /= c)) then
STOP 2
end if
c2 = 43.
c2(1:2*n1:2,:,:) = eoshift(a,shift,dim=dim, boundary=bp)
if (any(c2(1:2*n1:2,:,:) /= c)) then
STOP 3
end if
if (any(c2(2:2*n1:2,:,:) /= 43)) then
STOP 4
end if
end do
end do
end program main