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 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) firstprivate (c, d, e, f, g, h, i, j, k) & 39!$omp & firstprivate (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 x = omp_get_thread_num () 69 w = '' 70 if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0' 71 if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1' 72 if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2' 73 if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3' 74 if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4' 75 if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5' 76 c = w(8:19) 77 d = w(1:7) 78 forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r 79 forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r 80 forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19) 81 forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38) 82 forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7) 83 forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26) 84 forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r 85 forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r 86 forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r 87 s = w(20:26) 88 forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r 89 forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r 90 forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7) 91 forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26) 92!$omp barrier 93 y = '' 94 if (x .eq. 0) y = '0' 95 if (x .eq. 1) y = '1' 96 if (x .eq. 2) y = '2' 97 if (x .eq. 3) y = '3' 98 if (x .eq. 4) y = '4' 99 if (x .eq. 5) y = '5' 100 l = l .or. w(7:7) .ne. y 101 l = l .or. w(19:19) .ne. y 102 l = l .or. w(26:26) .ne. y 103 l = l .or. w(38:38) .ne. y 104 l = l .or. c .ne. w(8:19) 105 l = l .or. d .ne. w(1:7) 106 l = l .or. s .ne. w(20:26) 107 do 103, p = 1, 2 108 do 103, q = 3, 7 109 do 103, r = 1, 7 110 if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r 111 l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r 112 if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19) 113 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38) 114 if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7) 115 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26) 116 if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r 117 l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r 118 if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7) 119 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26) 120103 continue 121 do 104, p = 3, 5 122 do 104, q = 2, 6 123 do 104, r = 1, 7 124 l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r 125 l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r 126104 continue 127 do 105, p = 1, 5 128 do 105, q = 4, 6 129 l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q 130105 continue 131 call check (size (e, 1), 2, l) 132 call check (size (e, 2), 3, l) 133 call check (size (e, 3), 7, l) 134 call check (size (e), 42, l) 135 call check (size (f, 1), 2, l) 136 call check (size (f, 2), 5, l) 137 call check (size (f, 3), 7, l) 138 call check (size (f), 70, l) 139 call check (size (g, 1), 5, l) 140 call check (size (g, 2), 5, l) 141 call check (size (g), 25, l) 142 call check (size (h, 1), 5, l) 143 call check (size (h, 2), 5, l) 144 call check (size (h), 25, l) 145 call check (size (i, 1), 3, l) 146 call check (size (i, 2), 5, l) 147 call check (size (i, 3), 7, l) 148 call check (size (i), 105, l) 149 call check (size (j, 1), 4, l) 150 call check (size (j, 2), 5, l) 151 call check (size (j, 3), 7, l) 152 call check (size (j), 140, l) 153 call check (size (k, 1), 5, l) 154 call check (size (k, 2), 1, l) 155 call check (size (k, 3), 3, l) 156 call check (size (k), 15, l) 157!$omp end parallel 158 if (l) call abort 159 end subroutine foo 160 161 subroutine test 162 character (len = 12) :: c 163 character (len = 7) :: d 164 integer, dimension (2, 3:5, 7) :: e 165 integer, dimension (2, 3:7, 7) :: f 166 character (len = 12), dimension (5, 3:7) :: g 167 character (len = 7), dimension (5, 3:7) :: h 168 real, dimension (3:5, 2:6, 1:7) :: i 169 double precision, dimension (3:6, 2:6, 1:7) :: j 170 integer, dimension (1:5, 7:7, 4:6) :: k 171 integer :: p, q, r 172 c = 'abcdefghijkl' 173 d = 'ABCDEFG' 174 forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r 175 forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r 176 forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB' 177 forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY' 178 forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456' 179 forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543' 180 forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r 181 forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r 182 forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r 183 call foo (c, d, e, f, g, h, i, j, k, 7) 184 end subroutine test 185end 186