| ! { 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 |