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