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