179 lines
4.2 KiB
Fortran
179 lines
4.2 KiB
Fortran
! { dg-do run }
|
|
! Check that eoshift works for three-dimensional arrays.
|
|
module x
|
|
implicit none
|
|
contains
|
|
subroutine eoshift_0 (array, shift, boundary, dim, res)
|
|
real, dimension(:,:,:), intent(in) :: array
|
|
real, dimension(:,:,:), intent(out) :: res
|
|
integer, value :: shift
|
|
real, optional, intent(in) :: boundary
|
|
integer, optional, intent(in) :: dim
|
|
integer :: s1, s2, s3
|
|
integer :: n1, n2, n3
|
|
|
|
real :: b
|
|
integer :: d
|
|
if (present(boundary)) then
|
|
b = boundary
|
|
else
|
|
b = 0.0
|
|
end if
|
|
|
|
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
|
|
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
|
|
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
|
|
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
|
|
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
|
|
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
|
|
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_0
|
|
end module x
|
|
|
|
program main
|
|
use x
|
|
implicit none
|
|
integer, parameter :: n1=2,n2=4,n3=2
|
|
real, dimension(n1,n2,n3) :: a,b,c
|
|
integer :: dim, shift, shift_lim
|
|
call random_number(a)
|
|
|
|
do dim=1,3
|
|
if (dim == 1) then
|
|
shift_lim = n1 + 1
|
|
else if (dim == 2) then
|
|
shift_lim = n2 + 1
|
|
else
|
|
shift_lim = n3 + 1
|
|
end if
|
|
do shift=-shift_lim, shift_lim
|
|
b = eoshift(a,shift,dim=dim)
|
|
call eoshift_0 (a, shift=shift, dim=dim, res=c)
|
|
if (any (b /= c)) then
|
|
print *,"dim = ", dim, "shift = ", shift
|
|
STOP 1
|
|
end if
|
|
end do
|
|
end do
|
|
call random_number(b)
|
|
c = b
|
|
|
|
do dim=1,3
|
|
if (dim == 1) then
|
|
shift_lim = n1/2 + 1
|
|
else if (dim == 2) then
|
|
shift_lim = n2/2 + 1
|
|
else
|
|
shift_lim = n3/2 + 1
|
|
end if
|
|
|
|
do shift=-shift_lim, shift_lim
|
|
b(1:n1:2,:,:) = eoshift(a(1:n1/2,:,:),shift,dim=dim)
|
|
call eoshift_0 (a(1:n1/2,:,:), shift=shift, dim=dim, res=c(1:n1:2,:,:))
|
|
if (any (b /= c)) STOP 2
|
|
end do
|
|
end do
|
|
|
|
end program main
|