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
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
! { dg-do run }
! { dg-options "-w" }
character (6) :: c, f2
character (6) :: d(2)
c = f1 (6)
if (c .ne. 'opqrst') call abort
c = f2 (6)
if (c .ne. '_/!!/_') call abort
d = f3 (6)
if (d(1) .ne. 'opqrst' .or. d(2) .ne. 'a') call abort
d = f4 (6)
if (d(1) .ne. 'Opqrst' .or. d(2) .ne. 'A') call abort
contains
function f1 (n)
use omp_lib
character (n) :: f1
logical :: l
f1 = 'abcdef'
l = .false.
!$omp parallel firstprivate (f1) reduction (.or.:l) num_threads (2)
l = f1 .ne. 'abcdef'
if (omp_get_thread_num () .eq. 0) f1 = 'ijklmn'
if (omp_get_thread_num () .eq. 1) f1 = 'IJKLMN'
!$omp barrier
l = l .or. (omp_get_thread_num () .eq. 0 .and. f1 .ne. 'ijklmn')
l = l .or. (omp_get_thread_num () .eq. 1 .and. f1 .ne. 'IJKLMN')
!$omp end parallel
f1 = 'zZzz_z'
!$omp parallel shared (f1) reduction (.or.:l) num_threads (2)
l = l .or. f1 .ne. 'zZzz_z'
!$omp barrier
!$omp master
f1 = 'abc'
!$omp end master
!$omp barrier
l = l .or. f1 .ne. 'abc'
!$omp barrier
if (omp_get_thread_num () .eq. 1) f1 = 'def'
!$omp barrier
l = l .or. f1 .ne. 'def'
!$omp end parallel
if (l) call abort
f1 = 'opqrst'
end function f1
function f3 (n)
use omp_lib
character (n), dimension (2) :: f3
logical :: l
f3 = 'abcdef'
l = .false.
!$omp parallel firstprivate (f3) reduction (.or.:l) num_threads (2)
l = any (f3 .ne. 'abcdef')
if (omp_get_thread_num () .eq. 0) f3 = 'ijklmn'
if (omp_get_thread_num () .eq. 1) f3 = 'IJKLMN'
!$omp barrier
l = l .or. (omp_get_thread_num () .eq. 0 .and. any (f3 .ne. 'ijklmn'))
l = l .or. (omp_get_thread_num () .eq. 1 .and. any (f3 .ne. 'IJKLMN'))
!$omp end parallel
f3 = 'zZzz_z'
!$omp parallel shared (f3) reduction (.or.:l) num_threads (2)
l = l .or. any (f3 .ne. 'zZzz_z')
!$omp barrier
!$omp master
f3 = 'abc'
!$omp end master
!$omp barrier
l = l .or. any (f3 .ne. 'abc')
!$omp barrier
if (omp_get_thread_num () .eq. 1) f3 = 'def'
!$omp barrier
l = l .or. any (f3 .ne. 'def')
!$omp end parallel
if (l) call abort
f3(1) = 'opqrst'
f3(2) = 'a'
end function f3
function f4 (n)
use omp_lib
character (n), dimension (n - 4) :: f4
logical :: l
f4 = 'abcdef'
l = .false.
!$omp parallel firstprivate (f4) reduction (.or.:l) num_threads (2)
l = any (f4 .ne. 'abcdef')
if (omp_get_thread_num () .eq. 0) f4 = 'ijklmn'
if (omp_get_thread_num () .eq. 1) f4 = 'IJKLMN'
!$omp barrier
l = l .or. (omp_get_thread_num () .eq. 0 .and. any (f4 .ne. 'ijklmn'))
l = l .or. (omp_get_thread_num () .eq. 1 .and. any (f4 .ne. 'IJKLMN'))
l = l .or. size (f4) .ne. 2
!$omp end parallel
f4 = 'zZzz_z'
!$omp parallel shared (f4) reduction (.or.:l) num_threads (2)
l = l .or. any (f4 .ne. 'zZzz_z')
!$omp barrier
!$omp master
f4 = 'abc'
!$omp end master
!$omp barrier
l = l .or. any (f4 .ne. 'abc')
!$omp barrier
if (omp_get_thread_num () .eq. 1) f4 = 'def'
!$omp barrier
l = l .or. any (f4 .ne. 'def')
l = l .or. size (f4) .ne. 2
!$omp end parallel
if (l) call abort
f4(1) = 'Opqrst'
f4(2) = 'A'
end function f4
end
function f2 (n)
use omp_lib
character (*) :: f2
logical :: l
f2 = 'abcdef'
l = .false.
!$omp parallel firstprivate (f2) reduction (.or.:l) num_threads (2)
l = f2 .ne. 'abcdef'
if (omp_get_thread_num () .eq. 0) f2 = 'ijklmn'
if (omp_get_thread_num () .eq. 1) f2 = 'IJKLMN'
!$omp barrier
l = l .or. (omp_get_thread_num () .eq. 0 .and. f2 .ne. 'ijklmn')
l = l .or. (omp_get_thread_num () .eq. 1 .and. f2 .ne. 'IJKLMN')
!$omp end parallel
f2 = 'zZzz_z'
!$omp parallel shared (f2) reduction (.or.:l) num_threads (2)
l = l .or. f2 .ne. 'zZzz_z'
!$omp barrier
!$omp master
f2 = 'abc'
!$omp end master
!$omp barrier
l = l .or. f2 .ne. 'abc'
!$omp barrier
if (omp_get_thread_num () .eq. 1) f2 = 'def'
!$omp barrier
l = l .or. f2 .ne. 'def'
!$omp end parallel
if (l) call abort
f2 = '_/!!/_'
end function f2
|
