145
|
1 ! { dg-do run }
|
131
|
2 ! { dg-options "-std=legacy" }
|
|
3
|
0
|
4 integer :: err
|
|
5 err = 0
|
|
6 !$omp parallel num_threads (4) default (none) shared (err)
|
|
7 !$omp single
|
|
8 call test
|
|
9 !$omp end single
|
|
10 !$omp end parallel
|
145
|
11 if (err.ne.0) stop 1
|
0
|
12 contains
|
|
13 subroutine check (x, y, l)
|
|
14 integer :: x, y
|
|
15 logical :: l
|
|
16 l = l .or. x .ne. y
|
|
17 end subroutine check
|
|
18
|
|
19 subroutine foo (c, d, e, f, g, h, i, j, k, n)
|
|
20 use omp_lib
|
|
21 integer :: n
|
|
22 character (len = *) :: c
|
|
23 character (len = n) :: d
|
|
24 integer, dimension (2, 3:5, n) :: e
|
|
25 integer, dimension (2, 3:n, n) :: f
|
|
26 character (len = *), dimension (5, 3:n) :: g
|
|
27 character (len = n), dimension (5, 3:n) :: h
|
|
28 real, dimension (:, :, :) :: i
|
|
29 double precision, dimension (3:, 5:, 7:) :: j
|
|
30 integer, dimension (:, :, :) :: k
|
|
31 logical :: l
|
|
32 integer :: p, q, r
|
|
33 character (len = n) :: s
|
|
34 integer, dimension (2, 3:5, n) :: t
|
|
35 integer, dimension (2, 3:n, n) :: u
|
|
36 character (len = n), dimension (5, 3:n) :: v
|
|
37 character (len = 2 * n + 24) :: w
|
|
38 integer :: x, z
|
|
39 character (len = 1) :: y
|
|
40 s = 'PQRSTUV'
|
|
41 forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r
|
|
42 forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r
|
|
43 forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_'
|
|
44 forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!'
|
|
45 !$omp task default (none) firstprivate (c, d, e, f, g, h, i, j, k) &
|
|
46 !$omp & firstprivate (s, t, u, v) private (l, p, q, r, w, x, y) shared (err)
|
|
47 l = .false.
|
|
48 l = l .or. c .ne. 'abcdefghijkl'
|
|
49 l = l .or. d .ne. 'ABCDEFG'
|
|
50 l = l .or. s .ne. 'PQRSTUV'
|
|
51 do 100, p = 1, 2
|
|
52 do 100, q = 3, 7
|
|
53 do 100, r = 1, 7
|
|
54 if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r
|
|
55 l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r
|
|
56 if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB'
|
|
57 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY'
|
|
58 if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456'
|
|
59 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543'
|
|
60 if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r
|
|
61 l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r
|
|
62 if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_'
|
|
63 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!'
|
|
64 100 continue
|
|
65 do 101, p = 3, 5
|
|
66 do 101, q = 2, 6
|
|
67 do 101, r = 1, 7
|
|
68 l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r
|
|
69 l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r
|
|
70 101 continue
|
|
71 do 102, p = 1, 5
|
|
72 do 102, q = 4, 6
|
|
73 l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q
|
|
74 102 continue
|
|
75 call check (size (e, 1), 2, l)
|
|
76 call check (size (e, 2), 3, l)
|
|
77 call check (size (e, 3), 7, l)
|
|
78 call check (size (e), 42, l)
|
|
79 call check (size (f, 1), 2, l)
|
|
80 call check (size (f, 2), 5, l)
|
|
81 call check (size (f, 3), 7, l)
|
|
82 call check (size (f), 70, l)
|
|
83 call check (size (g, 1), 5, l)
|
|
84 call check (size (g, 2), 5, l)
|
|
85 call check (size (g), 25, l)
|
|
86 call check (size (h, 1), 5, l)
|
|
87 call check (size (h, 2), 5, l)
|
|
88 call check (size (h), 25, l)
|
|
89 call check (size (i, 1), 3, l)
|
|
90 call check (size (i, 2), 5, l)
|
|
91 call check (size (i, 3), 7, l)
|
|
92 call check (size (i), 105, l)
|
|
93 call check (size (j, 1), 4, l)
|
|
94 call check (size (j, 2), 5, l)
|
|
95 call check (size (j, 3), 7, l)
|
|
96 call check (size (j), 140, l)
|
|
97 call check (size (k, 1), 5, l)
|
|
98 call check (size (k, 2), 1, l)
|
|
99 call check (size (k, 3), 3, l)
|
|
100 call check (size (k), 15, l)
|
|
101 if (l) then
|
|
102 !$omp atomic
|
|
103 err = err + 1
|
|
104 end if
|
|
105 !$omp end task
|
|
106 c = ''
|
|
107 d = ''
|
|
108 e(:, :, :) = 199
|
|
109 f(:, :, :) = 198
|
|
110 g(:, :) = ''
|
|
111 h(:, :) = ''
|
|
112 i(:, :, :) = 7.0
|
|
113 j(:, :, :) = 8.0
|
|
114 k(:, :, :) = 9
|
|
115 s = ''
|
|
116 t(:, :, :) = 10
|
|
117 u(:, :, :) = 11
|
|
118 v(:, :) = ''
|
|
119 end subroutine foo
|
|
120
|
|
121 subroutine test
|
|
122 character (len = 12) :: c
|
|
123 character (len = 7) :: d
|
|
124 integer, dimension (2, 3:5, 7) :: e
|
|
125 integer, dimension (2, 3:7, 7) :: f
|
|
126 character (len = 12), dimension (5, 3:7) :: g
|
|
127 character (len = 7), dimension (5, 3:7) :: h
|
|
128 real, dimension (3:5, 2:6, 1:7) :: i
|
|
129 double precision, dimension (3:6, 2:6, 1:7) :: j
|
|
130 integer, dimension (1:5, 7:7, 4:6) :: k
|
|
131 integer :: p, q, r
|
|
132 c = 'abcdefghijkl'
|
|
133 d = 'ABCDEFG'
|
|
134 forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r
|
|
135 forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r
|
|
136 forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB'
|
|
137 forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY'
|
|
138 forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456'
|
|
139 forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543'
|
|
140 forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r
|
|
141 forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r
|
|
142 forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r
|
|
143 call foo (c, d, e, f, g, h, i, j, k, 7)
|
|
144 end subroutine test
|
|
145 end
|