gcc/testsuite/gfortran.dg/eoshift_3.f90

   1 ! { dg-do  run }
   2 ! Check that eoshift works for three-dimensional arrays.
   3 module x
   4   implicit none
   5 contains
   6   subroutine eoshift_0 (array, shift, boundary, dim, res)
   7     real, dimension(:,:,:), intent(in) :: array
   8     real, dimension(:,:,:), intent(out) :: res
   9     integer, value :: shift
  10     real, optional, intent(in) :: boundary
  11     integer, optional, intent(in) :: dim
  12     integer :: s1, s2, s3
  13     integer :: n1, n2, n3
  14
  15     real :: b
  16     integer :: d
  17     if (present(boundary)) then
  18        b = boundary
  19     else
  20        b = 0.0
  21     end if
  22
  23     if (present(dim)) then
  24        d = dim
  25     else
  26        d = 1
  27     end if
  28
  29     n1 = size(array,1)
  30     n2 = size(array,2)
  31     n3 = size(array,3)
  32
  33     select case(dim)
  34     case(1)
  35        if (shift > 0) then
  36           shift = min(shift, n1)
  37           do s3=1,n3
  38              do s2=1,n2
  39                 do s1= 1, n1 - shift
  40                    res(s1,s2,s3) = array(s1+shift,s2,s3)
  41                 end do
  42                 do s1 = n1 - shift + 1,n1
  43                    res(s1,s2,s3) = b
  44                 end do
  45              end do
  46           end do
  47
  48        else
  49           shift = max(shift, -n1)
  50           do s3=1,n3
  51              do s2=1,n2
  52                 do s1=1,-shift
  53                    res(s1,s2,s3) = b
  54                 end do
  55                 do s1= 1-shift,n1
  56                    res(s1,s2,s3) = array(s1+shift,s2,s3)
  57                 end do
  58              end do
  59           end do
  60        end if
  61
  62     case(2)
  63        if (shift > 0) then
  64           shift = min(shift, n2)
  65           do s3=1,n3
  66              do s2=1, n2 - shift
  67                 do s1=1,n1
  68                    res(s1,s2,s3) = array(s1,s2+shift,s3)
  69                 end do
  70              end do
  71              do s2=n2 - shift + 1, n2
  72                 do s1=1,n1
  73                    res(s1,s2,s3) = b
  74                 end do
  75              end do
  76           end do
  77        else
  78           shift = max(shift, -n2)
  79           do s3=1,n3
  80              do s2=1,-shift
  81                 do s1=1,n1
  82                    res(s1,s2,s3) = b
  83                 end do
  84              end do
  85              do s2=1-shift,n2
  86                 do s1=1,n1
  87                    res(s1,s2,s3) = array(s1,s2+shift,s3)
  88                 end do
  89              end do
  90           end do
  91        end if
  92
  93     case(3)
  94        if (shift > 0) then
  95           shift = min(shift, n3)
  96           do s3=1,n3 - shift
  97              do s2=1, n2
  98                 do s1=1,n1
  99                    res(s1,s2,s3) = array(s1,s2,s3+shift)
 100                 end do
 101              end do
 102           end do
 103           do s3=n3 - shift + 1, n3
 104              do s2=1, n2
 105                 do s1=1,n1
 106                    res(s1,s2,s3) = b
 107                 end do
 108              end do
 109           end do
 110        else
 111           shift = max(shift, -n3)
 112           do s3=1,-shift
 113              do s2=1,n2
 114                 do s1=1,n1
 115                    res(s1,s2,s3) = b
 116                 end do
 117              end do
 118           end do
 119           do s3=1-shift,n3
 120              do s2=1,n2
 121                 do s1=1,n1
 122                    res(s1,s2,s3) = array(s1,s2,s3+shift)
 123                 end do
 124              end do
 125           end do
 126        end if
 127
 128     case default
 129        stop "Illegal dim"
 130     end select
 131   end subroutine eoshift_0
 132 end module x
 133
 134 program main
 135   use x
 136   implicit none
 137   integer, parameter :: n1=2,n2=4,n3=2
 138   real, dimension(n1,n2,n3) :: a,b,c
 139   integer :: dim, shift, shift_lim
 140   call random_number(a)
 141
 142   do dim=1,3
 143      if (dim == 1) then
 144         shift_lim = n1 + 1
 145      else if (dim == 2) then
 146         shift_lim = n2 + 1
 147      else
 148         shift_lim = n3 + 1
 149      end if
 150      do shift=-shift_lim, shift_lim
 151         b = eoshift(a,shift,dim=dim)
 152         call eoshift_0 (a, shift=shift, dim=dim, res=c)
 153         if (any (b /= c)) then
 154                 print *,"dim = ", dim, "shift = ", shift
 155                 call abort
 156         end if
 157      end do
 158   end do
 159   call random_number(b)
 160   c = b
 161
 162   do dim=1,3
 163      if (dim == 1) then
 164         shift_lim = n1/2 + 1
 165      else if (dim == 2) then
 166         shift_lim = n2/2 + 1
 167      else
 168         shift_lim = n3/2 + 1
 169      end if
 170
 171      do shift=-shift_lim, shift_lim
 172         b(1:n1:2,:,:) = eoshift(a(1:n1/2,:,:),shift,dim=dim)
 173         call eoshift_0 (a(1:n1/2,:,:), shift=shift, dim=dim, res=c(1:n1:2,:,:))
 174         if (any (b /= c)) call abort
 175      end do
 176   end do
 177
 178 end program main