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