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