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