9 subroutine test_parallel
10 integer :: a
, b
, c
, e
, f
, g
, i
, j
11 integer, dimension (20) :: d
25 !$omp if (a .eq. 6) private (b, c) shared (d) private (e) &
26 !$omp firstprivate(f) num_threads (a - 1) first&
27 !$ompprivate(g)default (shared) reduction (.or. : h) &
29 if (i
.ne
. 1) h
= .true
.
31 if (f
.ne
. 24) h
= .true
.
32 if (g
.ne
. 27) h
= .true
.
34 b
= omp_get_thread_num ()
38 c
= omp_get_num_threads ()
39 if (c
.gt
. a
- 1 .or
. c
.le
. 0) h
= .true
.
40 if (b
.ge
. c
) h
= .true
.
42 if (f
.ne
. g
.or
. f
.ne
. b
) h
= .true
.
45 if (a
.ne
. 6) call abort
46 if (j
.ne
. 24) call abort
47 if (d(1) .eq
. -1) call abort
50 if (d(g
) .ne
. d(1)) call abort
53 if (e
.ne
. i
) call abort
54 end subroutine test_parallel
56 subroutine test_do_orphan
58 !$omp parallel do private (l)
61 end subroutine test_do_orphan
64 integer :: i
, j
, k
, l
, n
65 integer, dimension (64) :: d
72 !$omp parallel num_threads (4) shared (i, k, d) private (l) &
73 !$omp&reduction (.and. : m)
74 if (omp_get_thread_num () .eq
. 0) then
75 k
= omp_get_num_threads ()
78 !$omp do schedule (static) firstprivate (n)
80 if (i
.eq
. 1 .and
. n
.ne
. 24) call abort
82 200 d(n
) = omp_get_thread_num ()
85 !$omp do lastprivate (i) schedule (static, 5)
86 do 201 i
= j
+ 1, 2 * j
87 201 d(i
) = omp_get_thread_num () + 1024
88 ! Implied omp end do here
90 if (i
.ne
. 33) m
= .false
.
92 !$omp do private (j) schedule (dynamic)
94 d(i
) = omp_get_thread_num () + 2048
98 !$omp do schedule (runtime)
100 d(i
) = omp_get_thread_num () + 4096
102 ! Implied omp end do here
104 if (.not
. m
) call abort
108 if (d(i
) .lt
. j
.or
. d(i
) .ge
. j
+ k
) call abort
109 if (i
.eq
. 16) j
= 1024
110 if (i
.eq
. 32) j
= 2048
111 if (i
.eq
. 48) j
= 4096
113 end subroutine test_do
115 subroutine test_sections
116 integer :: i
, j
, k
, l
, m
, n
123 call omp_set_dynamic (.false
.)
124 call omp_set_num_threads (4)
125 !$omp parallel num_threads (4)
126 !$omp sections private (i) firstprivate (j, k) lastprivate (j) &
127 !$omp& reduction (+ : l, m)
130 if (j
.ne
. 10 .or
. k
.ne
. 11 .or
. m
.ne
. 0) l
= 1
134 if (j
.ne
. 10 .or
. k
.ne
. 11) l
= 1
138 if (j
.ne
. 10 .or
. k
.ne
. 11) l
= 1
142 if (j
.ne
. 10 .or
. k
.ne
. 11) l
= 1
145 !$omp end sections nowait
146 !$omp sections lastprivate (n)
153 if (j
.ne
. 271 .or
. l
.ne
. 0) call abort
154 if (m
.ne
. 4 + 6 + 8 + 10) call abort
155 if (n
.ne
. 7) call abort
156 end subroutine test_sections
158 subroutine test_single
159 integer :: i
, j
, k
, l
166 !$omp parallel num_threads (4), private (i, j), reduction (.or. : m)
167 i
= omp_get_thread_num ()
168 j
= omp_get_thread_num ()
169 !$omp single private (k)
171 !$omp end single nowait
172 !$omp single private (k) firstprivate (l)
173 if (i
.ne
. omp_get_thread_num () .or
. i
.ne
. j
) then
178 if (l
.ne
. 500) j
= -1
180 !$omp end single copyprivate (j)
181 if (i
.ne
. omp_get_thread_num () .or
. j
.ne
. -2) m
= .true
.
184 end subroutine test_single