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 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) 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 end parallel 126 if (l) call abort 127 end subroutine foo 128 129 subroutine test 130 character (len = 12) :: c 131 character (len = 7) :: d 132 integer, dimension (2, 3:5, 7) :: e 133 integer, dimension (2, 3:7, 7) :: f 134 character (len = 12), dimension (5, 3:7) :: g 135 character (len = 7), dimension (5, 3:7) :: h 136 real, dimension (3:5, 2:6, 1:7) :: i 137 double precision, dimension (3:6, 2:6, 1:7) :: j 138 integer, dimension (1:5, 7:7, 4:6) :: k 139 integer :: p, q, r 140 call foo (c, d, e, f, g, h, i, j, k, 7) 141 end subroutine test 142end 143