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