libgomp/testsuite/libgomp.fortran/vla4.f90

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