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