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 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) 88103 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 94104 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 98105 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) 163113 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 169114 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 173115 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 191end 192