Mercurial > hg > CbC > CbC_gcc

comparison libgomp/testsuite/libgomp.fortran/vla4.f90 @ 0:a06113de4d67

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
first commit
author kent <kent@cr.ie.u-ryukyu.ac.jp>
date Fri, 17 Jul 2009 14:47:48 +0900
parents
children 04ced10e8804
comparison
equal deleted inserted replaced
-1:000000000000 0:a06113de4d67
1 ! { dg-do run }
2
3 call test
4 contains
5 subroutine check (x, y, l)
6 integer :: x, y
7 logical :: l
8 l = l .or. x .ne. y
9 end subroutine check
10
11 subroutine foo (c, d, e, f, g, h, i, j, k, n)
12 use omp_lib
13 integer :: n
14 character (len = *) :: c
15 character (len = n) :: d
16 integer, dimension (2, 3:5, n) :: e
17 integer, dimension (2, 3:n, n) :: f
18 character (len = *), dimension (5, 3:n) :: g
19 character (len = n), dimension (5, 3:n) :: h
20 real, dimension (:, :, :) :: i
21 double precision, dimension (3:, 5:, 7:) :: j
22 integer, dimension (:, :, :) :: k
23 logical :: l
24 integer :: p, q, r
25 character (len = n) :: s
26 integer, dimension (2, 3:5, n) :: t
27 integer, dimension (2, 3:n, n) :: u
28 character (len = n), dimension (5, 3:n) :: v
29 character (len = 2 * n + 24) :: w
30 integer :: x, z, z2
31 character (len = 1) :: y
32 s = 'PQRSTUV'
33 forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r
34 forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r
35 forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_'
36 forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!'
37 l = .false.
38 call omp_set_dynamic (.false.)
39 call omp_set_num_threads (6)
40 !$omp parallel do default (none) firstprivate (c, d, e, f, g, h, i, j, k) &
41 !$omp & firstprivate (s, t, u, v) reduction (.or.:l) num_threads (6) &
42 !$omp private (p, q, r, w, x, y) schedule (static) shared (z2) &
43 !$omp lastprivate (c, d, e, f, g, h, i, j, k, s, t, u, v)
44 do 110 z = 0, omp_get_num_threads () - 1
45 if (omp_get_thread_num () .eq. 0) z2 = omp_get_num_threads ()
46 l = l .or. c .ne. 'abcdefghijkl'
47 l = l .or. d .ne. 'ABCDEFG'
48 l = l .or. s .ne. 'PQRSTUV'
49 do 100, p = 1, 2
50 do 100, q = 3, 7
51 do 100, r = 1, 7
52 if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r
53 l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r
54 if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB'
55 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY'
56 if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456'
57 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543'
58 if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r
59 l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r
60 if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_'
61 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!'
62 100 continue
63 do 101, p = 3, 5
64 do 101, q = 2, 6
65 do 101, r = 1, 7
66 l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r
67 l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r
68 101 continue
69 do 102, p = 1, 5
70 do 102, q = 4, 6
71 l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q
72 102 continue
73 x = omp_get_thread_num ()
74 w = ''
75 if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
76 if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
77 if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
78 if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
79 if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
80 if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
81 c = w(8:19)
82 d = w(1:7)
83 forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
84 forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
85 forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
86 forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
87 forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
88 forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
89 forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
90 forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
91 forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
92 s = w(20:26)
93 forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
94 forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
95 forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
96 forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
97 !$omp barrier ! { dg-warning "may not be closely nested" }
98 y = ''
99 if (x .eq. 0) y = '0'
100 if (x .eq. 1) y = '1'
101 if (x .eq. 2) y = '2'
102 if (x .eq. 3) y = '3'
103 if (x .eq. 4) y = '4'
104 if (x .eq. 5) y = '5'
105 l = l .or. w(7:7) .ne. y
106 l = l .or. w(19:19) .ne. y
107 l = l .or. w(26:26) .ne. y
108 l = l .or. w(38:38) .ne. y
109 l = l .or. c .ne. w(8:19)
110 l = l .or. d .ne. w(1:7)
111 l = l .or. s .ne. w(20:26)
112 do 103, p = 1, 2
113 do 103, q = 3, 7
114 do 103, r = 1, 7
115 if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
116 l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
117 if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
118 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
119 if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
120 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
121 if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
122 l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
123 if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
124 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
125 103 continue
126 do 104, p = 3, 5
127 do 104, q = 2, 6
128 do 104, r = 1, 7
129 l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
130 l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
131 104 continue
132 do 105, p = 1, 5
133 do 105, q = 4, 6
134 l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
135 105 continue
136 call check (size (e, 1), 2, l)
137 call check (size (e, 2), 3, l)
138 call check (size (e, 3), 7, l)
139 call check (size (e), 42, l)
140 call check (size (f, 1), 2, l)
141 call check (size (f, 2), 5, l)
142 call check (size (f, 3), 7, l)
143 call check (size (f), 70, l)
144 call check (size (g, 1), 5, l)
145 call check (size (g, 2), 5, l)
146 call check (size (g), 25, l)
147 call check (size (h, 1), 5, l)
148 call check (size (h, 2), 5, l)
149 call check (size (h), 25, l)
150 call check (size (i, 1), 3, l)
151 call check (size (i, 2), 5, l)
152 call check (size (i, 3), 7, l)
153 call check (size (i), 105, l)
154 call check (size (j, 1), 4, l)
155 call check (size (j, 2), 5, l)
156 call check (size (j, 3), 7, l)
157 call check (size (j), 140, l)
158 call check (size (k, 1), 5, l)
159 call check (size (k, 2), 1, l)
160 call check (size (k, 3), 3, l)
161 call check (size (k), 15, l)
162 110 continue
163 !$omp end parallel do
164 if (l) call abort
165 if (z2 == 6) then
166 x = 5
167 w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
168 y = '5'
169 l = l .or. w(7:7) .ne. y
170 l = l .or. w(19:19) .ne. y
171 l = l .or. w(26:26) .ne. y
172 l = l .or. w(38:38) .ne. y
173 l = l .or. c .ne. w(8:19)
174 l = l .or. d .ne. w(1:7)
175 l = l .or. s .ne. w(20:26)
176 do 113, p = 1, 2
177 do 113, q = 3, 7
178 do 113, r = 1, 7
179 if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
180 l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
181 if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
182 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
183 if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
184 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
185 if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
186 l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
187 if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
188 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
189 113 continue
190 do 114, p = 3, 5
191 do 114, q = 2, 6
192 do 114, r = 1, 7
193 l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
194 l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
195 114 continue
196 do 115, p = 1, 5
197 do 115, q = 4, 6
198 l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
199 115 continue
200 if (l) call abort
201 end if
202 end subroutine foo
203
204 subroutine test
205 character (len = 12) :: c
206 character (len = 7) :: d
207 integer, dimension (2, 3:5, 7) :: e
208 integer, dimension (2, 3:7, 7) :: f
209 character (len = 12), dimension (5, 3:7) :: g
210 character (len = 7), dimension (5, 3:7) :: h
211 real, dimension (3:5, 2:6, 1:7) :: i
212 double precision, dimension (3:6, 2:6, 1:7) :: j
213 integer, dimension (1:5, 7:7, 4:6) :: k
214 integer :: p, q, r
215 c = 'abcdefghijkl'
216 d = 'ABCDEFG'
217 forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r
218 forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r
219 forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB'
220 forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY'
221 forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456'
222 forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543'
223 forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r
224 forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r
225 forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r
226 call foo (c, d, e, f, g, h, i, j, k, 7)
227 end subroutine test
228 end