1! { dg-do run } 2! { dg-options "-std=legacy" } 3 4 call test 5contains 6 subroutine check (x, y, l) 7 integer :: x, y 8 logical :: l 9 l = l .or. x .ne. y 10 end subroutine check 11 12 subroutine foo (c, d, e, f, g, h, i, j, k, n) 13 use omp_lib 14 integer :: n 15 character (len = *) :: c 16 character (len = n) :: d 17 integer, dimension (2, 3:5, n) :: e 18 integer, dimension (2, 3:n, n) :: f 19 character (len = *), dimension (5, 3:n) :: g 20 character (len = n), dimension (5, 3:n) :: h 21 real, dimension (:, :, :) :: i 22 double precision, dimension (3:, 5:, 7:) :: j 23 integer, dimension (:, :, :) :: k 24 logical :: l 25 integer :: p, q, r 26 character (len = n) :: s 27 integer, dimension (2, 3:5, n) :: t 28 integer, dimension (2, 3:n, n) :: u 29 character (len = n), dimension (5, 3:n) :: v 30 character (len = 2 * n + 24) :: w 31 integer :: x 32 character (len = 1) :: y 33 l = .false. 34!$omp parallel default (none) private (c, d, e, f, g, h, i, j, k) & 35!$omp & private (s, t, u, v) reduction (.or.:l) num_threads (6) & 36!$omp private (p, q, r, w, x, y) 37 x = omp_get_thread_num () 38 w = '' 39 if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0' 40 if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1' 41 if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2' 42 if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3' 43 if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4' 44 if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5' 45 c = w(8:19) 46 d = w(1:7) 47 forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r 48 forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r 49 forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19) 50 forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38) 51 forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7) 52 forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26) 53 forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r 54 forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r 55 forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r 56 s = w(20:26) 57 forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r 58 forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r 59 forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7) 60 forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26) 61!$omp barrier 62 y = '' 63 if (x .eq. 0) y = '0' 64 if (x .eq. 1) y = '1' 65 if (x .eq. 2) y = '2' 66 if (x .eq. 3) y = '3' 67 if (x .eq. 4) y = '4' 68 if (x .eq. 5) y = '5' 69 l = l .or. w(7:7) .ne. y 70 l = l .or. w(19:19) .ne. y 71 l = l .or. w(26:26) .ne. y 72 l = l .or. w(38:38) .ne. y 73 l = l .or. c .ne. w(8:19) 74 l = l .or. d .ne. w(1:7) 75 l = l .or. s .ne. w(20:26) 76 do 103, p = 1, 2 77 do 103, q = 3, 7 78 do 103, r = 1, 7 79 if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r 80 l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r 81 if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19) 82 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38) 83 if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7) 84 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26) 85 if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r 86 l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r 87 if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7) 88 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26) 89103 continue 90 do 104, p = 3, 5 91 do 104, q = 2, 6 92 do 104, r = 1, 7 93 l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r 94 l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r 95104 continue 96 do 105, p = 1, 5 97 do 105, q = 4, 6 98 l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q 99105 continue 100 call check (size (e, 1), 2, l) 101 call check (size (e, 2), 3, l) 102 call check (size (e, 3), 7, l) 103 call check (size (e), 42, l) 104 call check (size (f, 1), 2, l) 105 call check (size (f, 2), 5, l) 106 call check (size (f, 3), 7, l) 107 call check (size (f), 70, l) 108 call check (size (g, 1), 5, l) 109 call check (size (g, 2), 5, l) 110 call check (size (g), 25, l) 111 call check (size (h, 1), 5, l) 112 call check (size (h, 2), 5, l) 113 call check (size (h), 25, l) 114 call check (size (i, 1), 3, l) 115 call check (size (i, 2), 5, l) 116 call check (size (i, 3), 7, l) 117 call check (size (i), 105, l) 118 call check (size (j, 1), 4, l) 119 call check (size (j, 2), 5, l) 120 call check (size (j, 3), 7, l) 121 call check (size (j), 140, l) 122 call check (size (k, 1), 5, l) 123 call check (size (k, 2), 1, l) 124 call check (size (k, 3), 3, l) 125 call check (size (k), 15, l) 126!$omp end parallel 127 if (l) stop 1 128 end subroutine foo 129 130 subroutine test 131 character (len = 12) :: c 132 character (len = 7) :: d 133 integer, dimension (2, 3:5, 7) :: e 134 integer, dimension (2, 3:7, 7) :: f 135 character (len = 12), dimension (5, 3:7) :: g 136 character (len = 7), dimension (5, 3:7) :: h 137 real, dimension (3:5, 2:6, 1:7) :: i 138 double precision, dimension (3:6, 2:6, 1:7) :: j 139 integer, dimension (1:5, 7:7, 4:6) :: k 140 integer :: p, q, r 141 call foo (c, d, e, f, g, h, i, j, k, 7) 142 end subroutine test 143end 144