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