libgomp/testsuite/libgomp.fortran/non-rectangular-loop-6.f90

   1 ! { dg-do run }
   2 ! { dg-additional-options "-msse2" { target sse2_runtime } }
   3 ! { dg-additional-options "-mavx" { target avx_runtime } }
   4
   5 ! PR fortran/107424
   6
   7 ! Nonrectangular loop nests checks
   8 ! This testcase uses negative step sizes
   9
  10 module m
  11   implicit none (type, external)
  12 contains
  13
  14 ! The 'k' loop uses i or j as start value
  15 ! but a constant end value such that 'lastprivate'
  16 ! should be well-defined
  17 subroutine lastprivate_check_simd_1
  18   integer :: n,m,p, i,j,k, one
  19
  20   n = 11
  21   m = 23
  22   p = 27
  23   one = 1
  24
  25   ! Use 'i' or 'j', unit step on 'i' or on 'j' -> 4 loops
  26   ! Then same, except use non-unit step for 'k'
  27
  28   !$omp simd collapse(3) lastprivate(k)
  29   do i = n, one, -1
  30     do j = m, one, -2
  31       do k = p + j, p - 41, -1
  32         if (k < p - 41 .or. k > p+m) error stop
  33       end do
  34     end do
  35   end do
  36   if (k /= p - 41 - 1) error stop
  37
  38   !$omp simd collapse(3) lastprivate(k)
  39   do i = n, 1, -2
  40     do j = m, 1, -1
  41       do k = p, i - 41, -1
  42         if (k < 1 - 41 .or. k > p) error stop
  43       end do
  44     end do
  45   end do
  46   if (k /= -41) error stop
  47
  48   !$omp simd collapse(3) lastprivate(k)
  49   do i = n, one, -2
  50     do j = m, one, -1
  51       do k = p, j - 41, -1
  52         if (k < 1 - 41 .or. k > p) then
  53           ! print *, i, j, k,p, " -> i, j, k, p   (k < 1 - 41 .or. k > p)"
  54           error stop
  55         end if
  56       end do
  57     end do
  58   end do
  59   if (k /= -41) error stop
  60
  61   k = -43
  62   m = 0
  63   !$omp simd collapse(3) lastprivate(k)
  64   do i = m, one, -2
  65     do j = m, one, -1
  66       do k = p, j - 41, -1
  67         if (k < 1 - 41 .or. k > p) then
  68           ! print *, i, j, k,p, " -> i, j, k, p   (k < 1 - 41 .or. k > p)"
  69           error stop
  70         end if
  71       end do
  72     end do
  73   end do
  74   if (k /= -43) error stop
  75
  76   m = 23
  77
  78   !$omp simd collapse(3) lastprivate(k)
  79   do i = n, one, -1
  80     do j = m, one, -2
  81       do k = p, i - 41, -1
  82         if (k < 1 - 41 .or. k > p) error stop
  83       end do
  84     end do
  85   end do
  86   if (k /= -41) error stop
  87
  88   n = -5
  89   k = - 70
  90   !$omp simd collapse(3) lastprivate(k)
  91   do i = n, one, -1
  92     do j = m, one, -2
  93       do k = p, i - 41, -1
  94         if (k < 1 - 41 .or. k > p) error stop
  95       end do
  96     end do
  97   end do
  98   if (k /= -70) error stop
  99
 100   n = 11
 101
 102   ! Same but 'private' for all (i,j) vars
 103
 104   !$omp simd collapse(3) lastprivate(k) private(i,j)
 105   do i = n, one, -1
 106     do j = m, one, -2
 107       do k = p, j - 41, -1
 108         if (k < 1 - 41 .or. k > p) error stop
 109       end do
 110     end do
 111   end do
 112   if (k /= -41) error stop
 113
 114   !$omp simd collapse(3) lastprivate(k) private(i,j)
 115   do i = n, one, -2
 116     do j = m, one, -1
 117       do k = p, i - 41, -1
 118         if (k < 1 - 41 .or. k > p) error stop
 119       end do
 120     end do
 121   end do
 122   if (k /= -41) error stop
 123
 124   !$omp simd collapse(3) lastprivate(k) private(i,j)
 125   do i = n, one, -2
 126     do j = m, one, -1
 127       do k = p, j - 41, -1
 128         if (k < 1 - 41 .or. k > p) error stop
 129       end do
 130     end do
 131   end do
 132   if (k /= -41) error stop
 133
 134   !$omp simd collapse(3) lastprivate(k) private(i,j)
 135   do i = n, one, -1
 136     do j = m, one, -2
 137       do k = p, i - 41, -1
 138         if (k < 1 - 41 .or. k > p) error stop
 139       end do
 140     end do
 141   end do
 142   if (k /= -41) error stop
 143
 144   ! Same - but with lastprivate(i,j)
 145
 146   !$omp simd collapse(3) lastprivate(k) lastprivate(i,j)
 147   do i = n, one, -1
 148     do j = m, one, -2
 149       do k = p, j - 41, -1
 150         if (k < 1 - 41 .or. k > p) error stop
 151       end do
 152     end do
 153   end do
 154   if (k /= -41) error stop
 155   if (i /= 0 .or. j /= -1) error stop
 156
 157   !$omp simd collapse(3) lastprivate(k) lastprivate(i,j)
 158   do i = n, 1, -2
 159     do j = m, one, -1
 160       do k = p, i - 41, -1
 161         if (k < 1 - 41 .or. k > p) error stop
 162       end do
 163     end do
 164   end do
 165   if (k /= -41) error stop
 166   if (i /= -1 .or. j /= 0) error stop
 167
 168   !$omp simd collapse(3) lastprivate(k) lastprivate(i,j)
 169   do i = n, 1, -2
 170     do j = m, 1, -1
 171       do k = p, j - 41, -1
 172         if (k < 1 - 41 .or. k > p) error stop
 173       end do
 174     end do
 175   end do
 176   if (k /= -41) error stop
 177   if (i /= -1 .or. j /= 0) error stop
 178
 179   !$omp simd collapse(3) lastprivate(k) lastprivate(i,j)
 180   do i = n, one, -1
 181     do j = m, one, -2
 182       do k = p, i - 41, -1
 183         if (k < 1 - 41 .or. k > p) error stop
 184       end do
 185     end do
 186   end do
 187   if (k /= -41) error stop
 188   if (i /= 0 .or. j /= -1) error stop
 189 end subroutine lastprivate_check_simd_1
 190 end module m
 191
 192 program main
 193   use m
 194   implicit none (type, external)
 195   call lastprivate_check_simd_1
 196 end