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