libgomp/testsuite/libgomp.fortran/vla4.f90

   1 ! { dg-do run }
   2
   3   call test
   4 contains
   5   subroutine check (x, y, l)
   6     integer :: x, y
   7     logical :: l
   8     l = l .or. x .ne. y
   9   end subroutine check
  10
  11   subroutine foo (c, d, e, f, g, h, i, j, k, n)
  12     use omp_lib
  13     interface
  14       subroutine GOMP_barrier () bind(c, name="GOMP_barrier")
  15       end subroutine
  16     end interface
  17     integer :: n
  18     character (len = *) :: c
  19     character (len = n) :: d
  20     integer, dimension (2, 3:5, n) :: e
  21     integer, dimension (2, 3:n, n) :: f
  22     character (len = *), dimension (5, 3:n) :: g
  23     character (len = n), dimension (5, 3:n) :: h
  24     real, dimension (:, :, :) :: i
  25     double precision, dimension (3:, 5:, 7:) :: j
  26     integer, dimension (:, :, :) :: k
  27     logical :: l
  28     integer :: p, q, r
  29     character (len = n) :: s
  30     integer, dimension (2, 3:5, n) :: t
  31     integer, dimension (2, 3:n, n) :: u
  32     character (len = n), dimension (5, 3:n) :: v
  33     character (len = 2 * n + 24) :: w
  34     integer :: x, z, z2
  35     character (len = 1) :: y
  36     s = 'PQRSTUV'
  37     forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r
  38     forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r
  39     forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_'
  40     forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!'
  41     l = .false.
  42     call omp_set_dynamic (.false.)
  43     call omp_set_num_threads (6)
  44 !$omp parallel do default (none) firstprivate (c, d, e, f, g, h, i, j, k) &
  45 !$omp & firstprivate (s, t, u, v) reduction (.or.:l) num_threads (6) &
  46 !$omp private (p, q, r, w, x, y) schedule (static) shared (z2) &
  47 !$omp lastprivate (c, d, e, f, g, h, i, j, k, s, t, u, v)
  48     do 110 z = 0, omp_get_num_threads () - 1
  49     if (omp_get_thread_num () .eq. 0) z2 = omp_get_num_threads ()
  50     l = l .or. c .ne. 'abcdefghijkl'
  51     l = l .or. d .ne. 'ABCDEFG'
  52     l = l .or. s .ne. 'PQRSTUV'
  53     do 100, p = 1, 2
  54       do 100, q = 3, 7
  55         do 100, r = 1, 7
  56           if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r
  57           l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r
  58           if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB'
  59           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY'
  60           if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456'
  61           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543'
  62           if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r
  63           l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r
  64           if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_'
  65           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!'
  66 100 continue
  67     do 101, p = 3, 5
  68       do 101, q = 2, 6
  69         do 101, r = 1, 7
  70           l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r
  71           l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r
  72 101 continue
  73     do 102, p = 1, 5
  74       do 102, q = 4, 6
  75         l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q
  76 102 continue
  77     x = omp_get_thread_num ()
  78     w = ''
  79     if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
  80     if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
  81     if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
  82     if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
  83     if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
  84     if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
  85     c = w(8:19)
  86     d = w(1:7)
  87     forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
  88     forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
  89     forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
  90     forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
  91     forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
  92     forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
  93     forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
  94     forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
  95     forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
  96     s = w(20:26)
  97     forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
  98     forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
  99     forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
 100     forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
 101     call GOMP_barrier
 102     y = ''
 103     if (x .eq. 0) y = '0'
 104     if (x .eq. 1) y = '1'
 105     if (x .eq. 2) y = '2'
 106     if (x .eq. 3) y = '3'
 107     if (x .eq. 4) y = '4'
 108     if (x .eq. 5) y = '5'
 109     l = l .or. w(7:7) .ne. y
 110     l = l .or. w(19:19) .ne. y
 111     l = l .or. w(26:26) .ne. y
 112     l = l .or. w(38:38) .ne. y
 113     l = l .or. c .ne. w(8:19)
 114     l = l .or. d .ne. w(1:7)
 115     l = l .or. s .ne. w(20:26)
 116     do 103, p = 1, 2
 117       do 103, q = 3, 7
 118         do 103, r = 1, 7
 119           if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
 120           l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
 121           if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
 122           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
 123           if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
 124           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
 125           if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
 126           l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
 127           if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
 128           if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
 129 103 continue
 130     do 104, p = 3, 5
 131       do 104, q = 2, 6
 132         do 104, r = 1, 7
 133           l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
 134           l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
 135 104 continue
 136     do 105, p = 1, 5
 137       do 105, q = 4, 6
 138         l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
 139 105 continue
 140     call check (size (e, 1), 2, l)
 141     call check (size (e, 2), 3, l)
 142     call check (size (e, 3), 7, l)
 143     call check (size (e), 42, l)
 144     call check (size (f, 1), 2, l)
 145     call check (size (f, 2), 5, l)
 146     call check (size (f, 3), 7, l)
 147     call check (size (f), 70, l)
 148     call check (size (g, 1), 5, l)
 149     call check (size (g, 2), 5, l)
 150     call check (size (g), 25, l)
 151     call check (size (h, 1), 5, l)
 152     call check (size (h, 2), 5, l)
 153     call check (size (h), 25, l)
 154     call check (size (i, 1), 3, l)
 155     call check (size (i, 2), 5, l)
 156     call check (size (i, 3), 7, l)
 157     call check (size (i), 105, l)
 158     call check (size (j, 1), 4, l)
 159     call check (size (j, 2), 5, l)
 160     call check (size (j, 3), 7, l)
 161     call check (size (j), 140, l)
 162     call check (size (k, 1), 5, l)
 163     call check (size (k, 2), 1, l)
 164     call check (size (k, 3), 3, l)
 165     call check (size (k), 15, l)
 166 110 continue
 167 !$omp end parallel do
 168     if (l) call abort
 169     if (z2 == 6) then
 170       x = 5
 171       w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
 172       y = '5'
 173       l = l .or. w(7:7) .ne. y
 174       l = l .or. w(19:19) .ne. y
 175       l = l .or. w(26:26) .ne. y
 176       l = l .or. w(38:38) .ne. y
 177       l = l .or. c .ne. w(8:19)
 178       l = l .or. d .ne. w(1:7)
 179       l = l .or. s .ne. w(20:26)
 180       do 113, p = 1, 2
 181         do 113, q = 3, 7
 182           do 113, r = 1, 7
 183             if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
 184             l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
 185             if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
 186             if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
 187             if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
 188             if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
 189             if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
 190             l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
 191             if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
 192             if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
 193 113   continue
 194       do 114, p = 3, 5
 195         do 114, q = 2, 6
 196           do 114, r = 1, 7
 197             l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
 198             l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
 199 114   continue
 200       do 115, p = 1, 5
 201         do 115, q = 4, 6
 202           l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
 203 115   continue
 204       if (l) call abort
 205     end if
 206   end subroutine foo
 207
 208   subroutine test
 209     character (len = 12) :: c
 210     character (len = 7) :: d
 211     integer, dimension (2, 3:5, 7) :: e
 212     integer, dimension (2, 3:7, 7) :: f
 213     character (len = 12), dimension (5, 3:7) :: g
 214     character (len = 7), dimension (5, 3:7) :: h
 215     real, dimension (3:5, 2:6, 1:7) :: i
 216     double precision, dimension (3:6, 2:6, 1:7) :: j
 217     integer, dimension (1:5, 7:7, 4:6) :: k
 218     integer :: p, q, r
 219     c = 'abcdefghijkl'
 220     d = 'ABCDEFG'
 221     forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r
 222     forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r
 223     forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB'
 224     forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY'
 225     forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456'
 226     forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543'
 227     forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r
 228     forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r
 229     forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r
 230     call foo (c, d, e, f, g, h, i, j, k, 7)
 231   end subroutine test
 232 end