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