Mercurial > hg > CbC > CbC_gcc

comparison libgomp/testsuite/libgomp.fortran/vla3.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 84e7813d76e9
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
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 !$omp parallel default (none) shared (c, d, e, f, g, h, i, j, k) &
39 !$omp & shared (s, t, u, v) reduction (.or.:l) num_threads (6) &
40 !$omp private (p, q, r, w, x, y)
41 l = l .or. c .ne. 'abcdefghijkl'
42 l = l .or. d .ne. 'ABCDEFG'
43 l = l .or. s .ne. 'PQRSTUV'
44 do 100, p = 1, 2
45 do 100, q = 3, 7
46 do 100, r = 1, 7
47 if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r
48 l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r
49 if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB'
50 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY'
51 if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456'
52 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543'
53 if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r
54 l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r
55 if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_'
56 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!'
57 100 continue
58 do 101, p = 3, 5
59 do 101, q = 2, 6
60 do 101, r = 1, 7
61 l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r
62 l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r
63 101 continue
64 do 102, p = 1, 5
65 do 102, q = 4, 6
66 l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q
67 102 continue
68 do 110 z = 0, omp_get_num_threads () - 1
69 !$omp barrier
70 x = omp_get_thread_num ()
71 w = ''
72 if (z .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
73 if (z .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
74 if (z .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
75 if (z .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
76 if (z .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
77 if (z .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
78 if (x .eq. z) then
79 c = w(8:19)
80 d = w(1:7)
81 forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
82 forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
83 forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
84 forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
85 forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
86 forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
87 forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
88 forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
89 forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
90 s = w(20:26)
91 forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
92 forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
93 forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
94 forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
95 end if
96 !$omp barrier
97 x = z
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 110 continue
137 call check (size (e, 1), 2, l)
138 call check (size (e, 2), 3, l)
139 call check (size (e, 3), 7, l)
140 call check (size (e), 42, l)
141 call check (size (f, 1), 2, l)
142 call check (size (f, 2), 5, l)
143 call check (size (f, 3), 7, l)
144 call check (size (f), 70, l)
145 call check (size (g, 1), 5, l)
146 call check (size (g, 2), 5, l)
147 call check (size (g), 25, l)
148 call check (size (h, 1), 5, l)
149 call check (size (h, 2), 5, l)
150 call check (size (h), 25, l)
151 call check (size (i, 1), 3, l)
152 call check (size (i, 2), 5, l)
153 call check (size (i, 3), 7, l)
154 call check (size (i), 105, l)
155 call check (size (j, 1), 4, l)
156 call check (size (j, 2), 5, l)
157 call check (size (j, 3), 7, l)
158 call check (size (j), 140, l)
159 call check (size (k, 1), 5, l)
160 call check (size (k, 2), 1, l)
161 call check (size (k, 3), 3, l)
162 call check (size (k), 15, l)
163 !$omp end parallel
164 if (l) call abort
165 end subroutine foo
166
167 subroutine test
168 character (len = 12) :: c
169 character (len = 7) :: d
170 integer, dimension (2, 3:5, 7) :: e
171 integer, dimension (2, 3:7, 7) :: f
172 character (len = 12), dimension (5, 3:7) :: g
173 character (len = 7), dimension (5, 3:7) :: h
174 real, dimension (3:5, 2:6, 1:7) :: i
175 double precision, dimension (3:6, 2:6, 1:7) :: j
176 integer, dimension (1:5, 7:7, 4:6) :: k
177 integer :: p, q, r
178 c = 'abcdefghijkl'
179 d = 'ABCDEFG'
180 forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r
181 forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r
182 forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB'
183 forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY'
184 forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456'
185 forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543'
186 forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r
187 forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r
188 forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r
189 call foo (c, d, e, f, g, h, i, j, k, 7)
190 end subroutine test
191 end