diff options
Diffstat (limited to 'gcc/testsuite/gfortran.dg/cshift_1.f90')
-rw-r--r-- | gcc/testsuite/gfortran.dg/cshift_1.f90 | 108 |
1 files changed, 108 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/cshift_1.f90 b/gcc/testsuite/gfortran.dg/cshift_1.f90 new file mode 100644 index 00000000000..e2024ea99dd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/cshift_1.f90 @@ -0,0 +1,108 @@ +! { 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 |