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