0
|
1 ! { dg-do run }
|
|
2 !$ use omp_lib
|
|
3
|
|
4 character (len = 8) :: h, i
|
|
5 character (len = 4) :: j, k
|
|
6 h = '01234567'
|
|
7 i = 'ABCDEFGH'
|
|
8 j = 'IJKL'
|
|
9 k = 'MN'
|
|
10 call test (h, j)
|
|
11 contains
|
|
12 subroutine test (p, q)
|
|
13 character (len = 8) :: p
|
|
14 character (len = 4) :: q, r
|
|
15 character (len = 16) :: f
|
|
16 character (len = 32) :: g
|
|
17 integer, dimension (18) :: s
|
|
18 logical :: l
|
|
19 integer :: m
|
|
20 f = 'test16'
|
|
21 g = 'abcdefghijklmnopqrstuvwxyz'
|
|
22 r = ''
|
|
23 l = .false.
|
|
24 s = -6
|
|
25 !$omp parallel firstprivate (f, p, s) private (r, m) reduction (.or.:l) &
|
|
26 !$omp & num_threads (4)
|
|
27 m = omp_get_thread_num ()
|
|
28 if (any (s .ne. -6)) l = .true.
|
|
29 l = l .or. f .ne. 'test16' .or. p .ne. '01234567'
|
|
30 l = l .or. g .ne. 'abcdefghijklmnopqrstuvwxyz'
|
|
31 l = l .or. i .ne. 'ABCDEFGH' .or. q .ne. 'IJKL'
|
|
32 l = l .or. k .ne. 'MN'
|
|
33 !$omp barrier
|
|
34 if (m .eq. 0) then
|
|
35 f = 'ffffffff0'
|
|
36 g = 'xyz'
|
|
37 i = '123'
|
|
38 k = '9876'
|
|
39 p = '_abc'
|
|
40 q = '_def'
|
|
41 r = '1_23'
|
|
42 else if (m .eq. 1) then
|
|
43 f = '__'
|
|
44 p = 'xxx'
|
|
45 r = '7575'
|
|
46 else if (m .eq. 2) then
|
|
47 f = 'ZZ'
|
|
48 p = 'm2'
|
|
49 r = 'M2'
|
|
50 else if (m .eq. 3) then
|
|
51 f = 'YY'
|
|
52 p = 'm3'
|
|
53 r = 'M3'
|
|
54 end if
|
|
55 s = m
|
|
56 !$omp barrier
|
|
57 l = l .or. g .ne. 'xyz' .or. i .ne. '123' .or. k .ne. '9876'
|
|
58 l = l .or. q .ne. '_def'
|
|
59 if (any (s .ne. m)) l = .true.
|
|
60 if (m .eq. 0) then
|
|
61 l = l .or. f .ne. 'ffffffff0' .or. p .ne. '_abc' .or. r .ne. '1_23'
|
|
62 else if (m .eq. 1) then
|
|
63 l = l .or. f .ne. '__' .or. p .ne. 'xxx' .or. r .ne. '7575'
|
|
64 else if (m .eq. 2) then
|
|
65 l = l .or. f .ne. 'ZZ' .or. p .ne. 'm2' .or. r .ne. 'M2'
|
|
66 else if (m .eq. 3) then
|
|
67 l = l .or. f .ne. 'YY' .or. p .ne. 'm3' .or. r .ne. 'M3'
|
|
68 end if
|
|
69 !$omp end parallel
|
|
70 if (l) call abort
|
|
71 end subroutine test
|
|
72 end
|