|
0
|
1 ! { dg-do run }
|
|
131
|
2 ! { dg-options "-std=legacy" }
|
|
0
|
3 ! { dg-require-effective-target tls_runtime }
|
|
|
4 use omp_lib
|
|
|
5 common /tlsblock/ x, y
|
|
|
6 integer :: x, y, z
|
|
|
7 save z
|
|
|
8 !$omp threadprivate (/tlsblock/, z)
|
|
|
9
|
|
|
10 call test_flush
|
|
|
11 call test_ordered
|
|
|
12 call test_threadprivate
|
|
|
13
|
|
|
14 contains
|
|
|
15 subroutine test_flush
|
|
|
16 integer :: i, j
|
|
|
17 i = 0
|
|
|
18 j = 0
|
|
|
19 !$omp parallel num_threads (4)
|
|
|
20 if (omp_get_thread_num () .eq. 0) i = omp_get_num_threads ()
|
|
|
21 if (omp_get_thread_num () .eq. 0) j = j + 1
|
|
|
22 !$omp flush (i, j)
|
|
|
23 !$omp barrier
|
|
|
24 if (omp_get_thread_num () .eq. 1) j = j + 2
|
|
|
25 !$omp flush
|
|
|
26 !$omp barrier
|
|
|
27 if (omp_get_thread_num () .eq. 2) j = j + 3
|
|
|
28 !$omp flush (i)
|
|
|
29 !$omp flush (j)
|
|
|
30 !$omp barrier
|
|
|
31 if (omp_get_thread_num () .eq. 3) j = j + 4
|
|
|
32 !$omp end parallel
|
|
|
33 end subroutine test_flush
|
|
|
34
|
|
|
35 subroutine test_ordered
|
|
|
36 integer :: i, j
|
|
|
37 integer, dimension (100) :: d
|
|
|
38 d(:) = -1
|
|
|
39 !$omp parallel do ordered schedule (dynamic) num_threads (4)
|
|
|
40 do i = 1, 100, 5
|
|
|
41 !$omp ordered
|
|
|
42 d(i) = i
|
|
|
43 !$omp end ordered
|
|
|
44 end do
|
|
|
45 j = 1
|
|
|
46 do 100 i = 1, 100
|
|
|
47 if (i .eq. j) then
|
|
145
|
48 if (d(i) .ne. i) stop 1
|
|
0
|
49 j = i + 5
|
|
|
50 else
|
|
145
|
51 if (d(i) .ne. -1) stop 2
|
|
0
|
52 end if
|
|
|
53 100 d(i) = -1
|
|
|
54 end subroutine test_ordered
|
|
|
55
|
|
|
56 subroutine test_threadprivate
|
|
|
57 common /tlsblock/ x, y
|
|
|
58 !$omp threadprivate (/tlsblock/)
|
|
|
59 integer :: i, j, x, y
|
|
|
60 logical :: m, n
|
|
|
61 call omp_set_num_threads (4)
|
|
|
62 call omp_set_dynamic (.false.)
|
|
|
63 i = -1
|
|
|
64 x = 6
|
|
|
65 y = 7
|
|
|
66 z = 8
|
|
|
67 n = .false.
|
|
|
68 m = .false.
|
|
|
69 !$omp parallel copyin (/tlsblock/, z) reduction (.or.:m) &
|
|
|
70 !$omp& num_threads (4)
|
|
|
71 if (omp_get_thread_num () .eq. 0) i = omp_get_num_threads ()
|
|
145
|
72 if (x .ne. 6 .or. y .ne. 7 .or. z .ne. 8) stop 3
|
|
0
|
73 x = omp_get_thread_num ()
|
|
|
74 y = omp_get_thread_num () + 1024
|
|
|
75 z = omp_get_thread_num () + 4096
|
|
|
76 !$omp end parallel
|
|
145
|
77 if (x .ne. 0 .or. y .ne. 1024 .or. z .ne. 4096) stop 4
|
|
0
|
78 !$omp parallel num_threads (4), private (j) reduction (.or.:n)
|
|
|
79 if (omp_get_num_threads () .eq. i) then
|
|
|
80 j = omp_get_thread_num ()
|
|
|
81 if (x .ne. j .or. y .ne. j + 1024 .or. z .ne. j + 4096) &
|
|
145
|
82 & stop 5
|
|
0
|
83 end if
|
|
|
84 !$omp end parallel
|
|
|
85 m = m .or. n
|
|
|
86 n = .false.
|
|
|
87 !$omp parallel num_threads (4), copyin (z) reduction (.or. : n) &
|
|
|
88 !$omp&private (j)
|
|
|
89 if (z .ne. 4096) n = .true.
|
|
|
90 if (omp_get_num_threads () .eq. i) then
|
|
|
91 j = omp_get_thread_num ()
|
|
145
|
92 if (x .ne. j .or. y .ne. j + 1024) stop 6
|
|
0
|
93 end if
|
|
|
94 !$omp end parallel
|
|
145
|
95 if (m .or. n) stop 7
|
|
0
|
96 end subroutine test_threadprivate
|
|
|
97 end
|
