| 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 |
