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