|
0
|
1 ! { dg-do run }
|
|
|
2 use omp_lib
|
|
|
3 call test_parallel
|
|
|
4 call test_do
|
|
|
5 call test_sections
|
|
|
6 call test_single
|
|
|
7
|
|
|
8 contains
|
|
|
9 subroutine test_parallel
|
|
|
10 integer :: a, b, c, e, f, g, i, j
|
|
|
11 integer, dimension (20) :: d
|
|
|
12 logical :: h
|
|
|
13 a = 6
|
|
|
14 b = 8
|
|
|
15 c = 11
|
|
|
16 d(:) = -1
|
|
|
17 e = 13
|
|
|
18 f = 24
|
|
|
19 g = 27
|
|
|
20 h = .false.
|
|
|
21 i = 1
|
|
|
22 j = 16
|
|
|
23 !$omp para&
|
|
|
24 !$omp&llel &
|
|
|
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) &
|
|
|
28 !$omp reduction(*:i)
|
|
|
29 if (i .ne. 1) h = .true.
|
|
|
30 i = 2
|
|
|
31 if (f .ne. 24) h = .true.
|
|
|
32 if (g .ne. 27) h = .true.
|
|
|
33 e = 7
|
|
|
34 b = omp_get_thread_num ()
|
|
|
35 if (b .eq. 0) j = 24
|
|
|
36 f = b
|
|
|
37 g = f
|
|
|
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.
|
|
|
41 d(b + 1) = c
|
|
|
42 if (f .ne. g .or. f .ne. b) h = .true.
|
|
|
43 !$omp endparallel
|
|
|
44 if (h) call abort
|
|
|
45 if (a .ne. 6) call abort
|
|
|
46 if (j .ne. 24) call abort
|
|
|
47 if (d(1) .eq. -1) call abort
|
|
|
48 e = 1
|
|
|
49 do g = 1, d(1)
|
|
|
50 if (d(g) .ne. d(1)) call abort
|
|
|
51 e = e * 2
|
|
|
52 end do
|
|
|
53 if (e .ne. i) call abort
|
|
|
54 end subroutine test_parallel
|
|
|
55
|
|
|
56 subroutine test_do_orphan
|
|
|
57 integer :: k, l
|
|
|
58 !$omp parallel do private (l)
|
|
|
59 do 600 k = 1, 16, 2
|
|
|
60 600 l = k
|
|
|
61 end subroutine test_do_orphan
|
|
|
62
|
|
|
63 subroutine test_do
|
|
|
64 integer :: i, j, k, l, n
|
|
|
65 integer, dimension (64) :: d
|
|
|
66 logical :: m
|
|
|
67
|
|
|
68 j = 16
|
|
|
69 d(:) = -1
|
|
|
70 m = .true.
|
|
|
71 n = 24
|
|
|
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 ()
|
|
|
76 end if
|
|
|
77 call test_do_orphan
|
|
|
78 !$omp do schedule (static) firstprivate (n)
|
|
|
79 do 200 i = 1, j
|
|
|
80 if (i .eq. 1 .and. n .ne. 24) call abort
|
|
|
81 n = i
|
|
|
82 200 d(n) = omp_get_thread_num ()
|
|
|
83 !$omp enddo nowait
|
|
|
84
|
|
|
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
|
|
|
89
|
|
|
90 if (i .ne. 33) m = .false.
|
|
|
91
|
|
|
92 !$omp do private (j) schedule (dynamic)
|
|
|
93 do i = 33, 48
|
|
|
94 d(i) = omp_get_thread_num () + 2048
|
|
|
95 end do
|
|
|
96 !$omp end do nowait
|
|
|
97
|
|
|
98 !$omp do schedule (runtime)
|
|
|
99 do i = 49, 4 * j
|
|
|
100 d(i) = omp_get_thread_num () + 4096
|
|
|
101 end do
|
|
|
102 ! Implied omp end do here
|
|
|
103 !$omp end parallel
|
|
|
104 if (.not. m) call abort
|
|
|
105
|
|
|
106 j = 0
|
|
|
107 do i = 1, 64
|
|
|
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
|
|
|
112 end do
|
|
|
113 end subroutine test_do
|
|
|
114
|
|
|
115 subroutine test_sections
|
|
|
116 integer :: i, j, k, l, m, n
|
|
|
117 i = 9
|
|
|
118 j = 10
|
|
|
119 k = 11
|
|
|
120 l = 0
|
|
|
121 m = 0
|
|
|
122 n = 30
|
|
|
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)
|
|
|
128 !$omp section
|
|
|
129 i = 24
|
|
|
130 if (j .ne. 10 .or. k .ne. 11 .or. m .ne. 0) l = 1
|
|
|
131 m = m + 4
|
|
|
132 !$omp section
|
|
|
133 i = 25
|
|
|
134 if (j .ne. 10 .or. k .ne. 11) l = 1
|
|
|
135 m = m + 6
|
|
|
136 !$omp section
|
|
|
137 i = 26
|
|
|
138 if (j .ne. 10 .or. k .ne. 11) l = 1
|
|
|
139 m = m + 8
|
|
|
140 !$omp section
|
|
|
141 i = 27
|
|
|
142 if (j .ne. 10 .or. k .ne. 11) l = 1
|
|
|
143 m = m + 10
|
|
|
144 j = 271
|
|
|
145 !$omp end sections nowait
|
|
|
146 !$omp sections lastprivate (n)
|
|
|
147 !$omp section
|
|
|
148 n = 6
|
|
|
149 !$omp section
|
|
|
150 n = 7
|
|
|
151 !$omp endsections
|
|
|
152 !$omp end parallel
|
|
|
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
|
|
|
157
|
|
|
158 subroutine test_single
|
|
|
159 integer :: i, j, k, l
|
|
|
160 logical :: m
|
|
|
161 i = 200
|
|
|
162 j = 300
|
|
|
163 k = 400
|
|
|
164 l = 500
|
|
|
165 m = .false.
|
|
|
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)
|
|
|
170 k = 64
|
|
|
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
|
|
|
174 j = -1
|
|
|
175 else
|
|
|
176 j = -2
|
|
|
177 end if
|
|
|
178 if (l .ne. 500) j = -1
|
|
|
179 l = 265
|
|
|
180 !$omp end single copyprivate (j)
|
|
|
181 if (i .ne. omp_get_thread_num () .or. j .ne. -2) m = .true.
|
|
|
182 !$omp endparallel
|
|
|
183 if (m) call abort
|
|
|
184 end subroutine test_single
|
|
|
185 end
|
