1! { dg-do run }
2! { dg-options "-std=legacy" }
3
4use omp_lib
5  call test_parallel
6  call test_do
7  call test_sections
8  call test_single
9
10contains
11  subroutine test_parallel
12    integer :: a, b, c, e, f, g, i, j
13    integer, dimension (20) :: d
14    logical :: h
15    a = 6
16    b = 8
17    c = 11
18    d(:) = -1
19    e = 13
20    f = 24
21    g = 27
22    h = .false.
23    i = 1
24    j = 16
25!$omp para&
26!$omp&llel &
27!$omp if (a .eq. 6) private (b, c) shared (d) private (e) &
28  !$omp firstprivate(f) num_threads (a - 1) first&
29!$ompprivate(g)default (shared) reduction (.or. : h) &
30!$omp reduction(*:i)
31    if (i .ne. 1) h = .true.
32    i = 2
33    if (f .ne. 24) h = .true.
34    if (g .ne. 27) h = .true.
35    e = 7
36    b = omp_get_thread_num ()
37    if (b .eq. 0) j = 24
38    f = b
39    g = f
40    c = omp_get_num_threads ()
41    if (c .gt. a - 1 .or. c .le. 0) h = .true.
42    if (b .ge. c) h = .true.
43    d(b + 1) = c
44    if (f .ne. g .or. f .ne. b) h = .true.
45!$omp endparallel
46    if (h) stop 1
47    if (a .ne. 6) stop 2
48    if (j .ne. 24) stop 3
49    if (d(1) .eq. -1) stop 4
50    e = 1
51    do g = 1, d(1)
52      if (d(g) .ne. d(1)) stop 5
53      e = e * 2
54    end do
55    if (e .ne. i) stop 6
56  end subroutine test_parallel
57
58  subroutine test_do_orphan
59    integer :: k, l
60!$omp parallel do private (l)
61    do 600 k = 1, 16, 2
62600   l = k
63  end subroutine test_do_orphan
64
65  subroutine test_do
66    integer :: i, j, k, l, n
67    integer, dimension (64) :: d
68    logical :: m
69
70    j = 16
71    d(:) = -1
72    m = .true.
73    n = 24
74!$omp parallel num_threads (4) shared (i, k, d) private (l) &
75!$omp&reduction (.and. : m)
76    if (omp_get_thread_num () .eq. 0) then
77      k = omp_get_num_threads ()
78    end if
79    call test_do_orphan
80!$omp do schedule (static) firstprivate (n)
81    do 200 i = 1, j
82      if (i .eq. 1 .and. n .ne. 24) stop 7
83      n = i
84200   d(n) = omp_get_thread_num ()
85!$omp enddo nowait
86
87!$omp do lastprivate (i) schedule (static, 5)
88    do 201 i = j + 1, 2 * j
89201   d(i) = omp_get_thread_num () + 1024
90    ! Implied omp end do here
91
92    if (i .ne. 33) m = .false.
93
94!$omp do private (j) schedule (dynamic)
95    do i = 33, 48
96      d(i) = omp_get_thread_num () + 2048
97    end do
98!$omp end do nowait
99
100!$omp do schedule (runtime)
101    do i = 49, 4 * j
102      d(i) = omp_get_thread_num () + 4096
103    end do
104    ! Implied omp end do here
105!$omp end parallel
106    if (.not. m) stop 8
107
108    j = 0
109    do i = 1, 64
110      if (d(i) .lt. j .or. d(i) .ge. j + k) stop 9
111      if (i .eq. 16) j = 1024
112      if (i .eq. 32) j = 2048
113      if (i .eq. 48) j = 4096
114    end do
115  end subroutine test_do
116
117  subroutine test_sections
118    integer :: i, j, k, l, m, n
119    i = 9
120    j = 10
121    k = 11
122    l = 0
123    m = 0
124    n = 30
125    call omp_set_dynamic (.false.)
126    call omp_set_num_threads (4)
127!$omp parallel num_threads (4)
128!$omp sections private (i) firstprivate (j, k) lastprivate (j) &
129!$omp& reduction (+ : l, m)
130!$omp section
131    i = 24
132    if (j .ne. 10 .or. k .ne. 11 .or. m .ne. 0) l = 1
133    m = m + 4
134!$omp section
135    i = 25
136    if (j .ne. 10 .or. k .ne. 11) l = 1
137    m = m + 6
138!$omp section
139    i = 26
140    if (j .ne. 10 .or. k .ne. 11) l = 1
141    m = m + 8
142!$omp section
143    i = 27
144    if (j .ne. 10 .or. k .ne. 11) l = 1
145    m = m + 10
146    j = 271
147!$omp end sections nowait
148!$omp sections lastprivate (n)
149!$omp section
150    n = 6
151!$omp section
152    n = 7
153!$omp endsections
154!$omp end parallel
155    if (j .ne. 271 .or. l .ne. 0) stop 10
156    if (m .ne. 4 + 6 + 8 + 10) stop 11
157    if (n .ne. 7) stop 12
158  end subroutine test_sections
159
160  subroutine test_single
161    integer :: i, j, k, l
162    logical :: m
163    i = 200
164    j = 300
165    k = 400
166    l = 500
167    m = .false.
168!$omp parallel num_threads (4), private (i, j), reduction (.or. : m)
169    i = omp_get_thread_num ()
170    j = omp_get_thread_num ()
171!$omp single private (k)
172    k = 64
173!$omp end single nowait
174!$omp single private (k) firstprivate (l)
175    if (i .ne. omp_get_thread_num () .or. i .ne. j) then
176      j = -1
177    else
178      j = -2
179    end if
180    if (l .ne. 500) j = -1
181    l = 265
182!$omp end single copyprivate (j)
183    if (i .ne. omp_get_thread_num () .or. j .ne. -2) m = .true.
184!$omp endparallel
185    if (m) stop 13
186  end subroutine test_single
187end
188