integer :: err err = 0 !$omp parallel num_threads (4) default (none) shared (err) !$omp single call test !$omp end single !$omp end parallel if (err.ne.0) call abort contains subroutine check (x, y, l) integer :: x, y logical :: l l = l .or. x .ne. y end subroutine check subroutine foo (c, d, e, f, g, h, i, j, k, n) use omp_lib integer :: n character (len = *) :: c character (len = n) :: d integer, dimension (2, 3:5, n) :: e integer, dimension (2, 3:n, n) :: f character (len = *), dimension (5, 3:n) :: g character (len = n), dimension (5, 3:n) :: h real, dimension (:, :, :) :: i double precision, dimension (3:, 5:, 7:) :: j integer, dimension (:, :, :) :: k logical :: l integer :: p, q, r character (len = n) :: s integer, dimension (2, 3:5, n) :: t integer, dimension (2, 3:n, n) :: u character (len = n), dimension (5, 3:n) :: v character (len = 2 * n + 24) :: w integer :: x, z character (len = 1) :: y s = 'PQRSTUV' forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_' forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!' !$omp task default (none) firstprivate (c, d, e, f, g, h, i, j, k) & !$omp & firstprivate (s, t, u, v) private (l, p, q, r, w, x, y) shared (err) l = .false. l = l .or. c .ne. 'abcdefghijkl' l = l .or. d .ne. 'ABCDEFG' l = l .or. s .ne. 'PQRSTUV' do 100, p = 1, 2 do 100, q = 3, 7 do 100, r = 1, 7 if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB' if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY' if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456' if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543' if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_' if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!' 100 continue do 101, p = 3, 5 do 101, q = 2, 6 do 101, r = 1, 7 l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r 101 continue do 102, p = 1, 5 do 102, q = 4, 6 l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q 102 continue call check (size (e, 1), 2, l) call check (size (e, 2), 3, l) call check (size (e, 3), 7, l) call check (size (e), 42, l) call check (size (f, 1), 2, l) call check (size (f, 2), 5, l) call check (size (f, 3), 7, l) call check (size (f), 70, l) call check (size (g, 1), 5, l) call check (size (g, 2), 5, l) call check (size (g), 25, l) call check (size (h, 1), 5, l) call check (size (h, 2), 5, l) call check (size (h), 25, l) call check (size (i, 1), 3, l) call check (size (i, 2), 5, l) call check (size (i, 3), 7, l) call check (size (i), 105, l) call check (size (j, 1), 4, l) call check (size (j, 2), 5, l) call check (size (j, 3), 7, l) call check (size (j), 140, l) call check (size (k, 1), 5, l) call check (size (k, 2), 1, l) call check (size (k, 3), 3, l) call check (size (k), 15, l) if (l) then !$omp atomic err = err + 1 end if !$omp end task c = '' d = '' e(:, :, :) = 199 f(:, :, :) = 198 g(:, :) = '' h(:, :) = '' i(:, :, :) = 7.0 j(:, :, :) = 8.0 k(:, :, :) = 9 s = '' t(:, :, :) = 10 u(:, :, :) = 11 v(:, :) = '' end subroutine foo subroutine test character (len = 12) :: c character (len = 7) :: d integer, dimension (2, 3:5, 7) :: e integer, dimension (2, 3:7, 7) :: f character (len = 12), dimension (5, 3:7) :: g character (len = 7), dimension (5, 3:7) :: h real, dimension (3:5, 2:6, 1:7) :: i double precision, dimension (3:6, 2:6, 1:7) :: j integer, dimension (1:5, 7:7, 4:6) :: k integer :: p, q, r c = 'abcdefghijkl' d = 'ABCDEFG' forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB' forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY' forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456' forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543' forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r call foo (c, d, e, f, g, h, i, j, k, 7) end subroutine test end