gcc/testsuite/gfortran.dg/eoshift_4.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_2 (array, shift, boundary, dim, res)
   7     real, dimension(:,:,:), intent(in) :: array
   8     real, dimension(:,:,:), intent(out) :: res
   9     integer, value :: shift
  10     real, optional, dimension(:,:), 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
  18     if (present(dim)) then
  19        d = dim
  20     else
  21        d = 1
  22     end if
  23
  24     n1 = size(array,1)
  25     n2 = size(array,2)
  26     n3 = size(array,3)
  27
  28     select case(dim)
  29     case(1)
  30        if (shift > 0) then
  31           shift = min(shift, n1)
  32           do s3=1,n3
  33              do s2=1,n2
  34                 b = boundary(s2,s3)
  35                 do s1= 1, n1 - shift
  36                    res(s1,s2,s3) = array(s1+shift,s2,s3)
  37                 end do
  38                 do s1 = n1 - shift + 1,n1
  39                    res(s1,s2,s3) = b
  40                 end do
  41              end do
  42           end do
  43
  44        else
  45           shift = max(shift, -n1)
  46           do s3=1,n3
  47              do s2=1,n2
  48                 b = boundary(s2,s3)
  49                 do s1=1,-shift
  50                    res(s1,s2,s3) = b
  51                 end do
  52                 do s1= 1-shift,n1
  53                    res(s1,s2,s3) = array(s1+shift,s2,s3)
  54                 end do
  55              end do
  56           end do
  57        end if
  58
  59     case(2)
  60        if (shift > 0) then
  61           shift = min(shift, n2)
  62           do s3=1,n3
  63              do s2=1, n2 - shift
  64                 do s1=1,n1
  65                    res(s1,s2,s3) = array(s1,s2+shift,s3)
  66                 end do
  67              end do
  68              do s2=n2 - shift + 1, n2
  69                 do s1=1,n1
  70                    b = boundary(s1,s3)
  71                    res(s1,s2,s3) = b
  72                 end do
  73              end do
  74           end do
  75        else
  76           shift = max(shift, -n2)
  77           do s3=1,n3
  78              do s2=1,-shift
  79                 do s1=1,n1
  80                    b = boundary(s1,s3)
  81                    res(s1,s2,s3) = b
  82                 end do
  83              end do
  84              do s2=1-shift,n2
  85                 do s1=1,n1
  86                    res(s1,s2,s3) = array(s1,s2+shift,s3)
  87                 end do
  88              end do
  89           end do
  90        end if
  91
  92     case(3)
  93        if (shift > 0) then
  94           shift = min(shift, n3)
  95           do s3=1,n3 - shift
  96              do s2=1, n2
  97                 do s1=1,n1
  98                    res(s1,s2,s3) = array(s1,s2,s3+shift)
  99                 end do
 100              end do
 101           end do
 102           do s3=n3 - shift + 1, n3
 103              do s2=1, n2
 104                 do s1=1,n1
 105                    b = boundary(s1,s2)
 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                    b = boundary(s1,s2)
 116                    res(s1,s2,s3) = b
 117                 end do
 118              end do
 119           end do
 120           do s3=1-shift,n3
 121              do s2=1,n2
 122                 do s1=1,n1
 123                    res(s1,s2,s3) = array(s1,s2,s3+shift)
 124                 end do
 125              end do
 126           end do
 127        end if
 128
 129     case default
 130        stop "Illegal dim"
 131     end select
 132   end subroutine eoshift_2
 133 end module x
 134
 135 program main
 136   use x
 137   implicit none
 138   integer, parameter :: n1=20,n2=30,n3=40
 139   real, dimension(n1,n2,n3) :: a,b,c
 140   real, dimension(2*n1,n2,n3) :: a2,c2
 141   integer :: dim, shift, shift_lim
 142   real, dimension(n2,n3), target :: b1
 143   real, dimension(n1,n3), target :: b2
 144   real, dimension(n1,n2), target :: b3
 145   real, dimension(:,:), pointer :: bp
 146
 147   call random_number(a)
 148   call random_number (b1)
 149   call random_number (b2)
 150   call random_number (b3)
 151   do dim=1,3
 152      if (dim == 1) then
 153         shift_lim = n1 + 1
 154         bp => b1
 155      else if (dim == 2) then
 156         shift_lim = n2 + 1
 157         bp => b2
 158      else
 159         shift_lim = n3 + 1
 160         bp => b3
 161      end if
 162      do shift=-shift_lim, shift_lim
 163         b = eoshift(a,shift,dim=dim, boundary=bp)
 164         call eoshift_2 (a, shift=shift, dim=dim, boundary=bp, res=c)
 165         if (any (b /= c)) then
 166            print *,"dim = ", dim, "shift = ", shift
 167            print *,b
 168            print *,c
 169            STOP 1
 170         end if
 171         a2 = 42.
 172         a2(1:2*n1:2,:,:) = a
 173         b = eoshift(a2(1:2*n1:2,:,:), shift, dim=dim, boundary=bp)
 174         if (any (b /= c)) then
 175            STOP 2
 176         end if
 177         c2 = 43.
 178         c2(1:2*n1:2,:,:) = eoshift(a,shift,dim=dim, boundary=bp)
 179         if (any(c2(1:2*n1:2,:,:) /= c)) then
 180            STOP 3
 181         end if
 182         if (any(c2(2:2*n1:2,:,:) /= 43)) then
 183            STOP 4
 184         end if
 185      end do
 186   end do
 187 end program main