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, 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 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) 97103 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 103104 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 107105 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) 134110 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) 161113 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 167114 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 171115 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 200end 201