Mercurial > hg > CbC > CbC_gcc

comparison libgomp/testsuite/libgomp.fortran/vla1.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
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) firstprivate (c, d, e, f, g, h, i, j, k) &
39 !$omp & firstprivate (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 x = omp_get_thread_num ()
69 w = ''
70 if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
71 if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
72 if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
73 if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
74 if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
75 if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
76 c = w(8:19)
77 d = w(1:7)
78 forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
79 forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
80 forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
81 forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
82 forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
83 forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
84 forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
85 forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
86 forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
87 s = w(20:26)
88 forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
89 forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
90 forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
91 forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
92 !$omp barrier
93 y = ''
94 if (x .eq. 0) y = '0'
95 if (x .eq. 1) y = '1'
96 if (x .eq. 2) y = '2'
97 if (x .eq. 3) y = '3'
98 if (x .eq. 4) y = '4'
99 if (x .eq. 5) y = '5'
100 l = l .or. w(7:7) .ne. y
101 l = l .or. w(19:19) .ne. y
102 l = l .or. w(26:26) .ne. y
103 l = l .or. w(38:38) .ne. y
104 l = l .or. c .ne. w(8:19)
105 l = l .or. d .ne. w(1:7)
106 l = l .or. s .ne. w(20:26)
107 do 103, p = 1, 2
108 do 103, q = 3, 7
109 do 103, r = 1, 7
110 if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
111 l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
112 if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
113 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
114 if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
115 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
116 if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
117 l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
118 if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
119 if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
120 103 continue
121 do 104, p = 3, 5
122 do 104, q = 2, 6
123 do 104, r = 1, 7
124 l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
125 l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
126 104 continue
127 do 105, p = 1, 5
128 do 105, q = 4, 6
129 l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
130 105 continue
131 call check (size (e, 1), 2, l)
132 call check (size (e, 2), 3, l)
133 call check (size (e, 3), 7, l)
134 call check (size (e), 42, l)
135 call check (size (f, 1), 2, l)
136 call check (size (f, 2), 5, l)
137 call check (size (f, 3), 7, l)
138 call check (size (f), 70, l)
139 call check (size (g, 1), 5, l)
140 call check (size (g, 2), 5, l)
141 call check (size (g), 25, l)
142 call check (size (h, 1), 5, l)
143 call check (size (h, 2), 5, l)
144 call check (size (h), 25, l)
145 call check (size (i, 1), 3, l)
146 call check (size (i, 2), 5, l)
147 call check (size (i, 3), 7, l)
148 call check (size (i), 105, l)
149 call check (size (j, 1), 4, l)
150 call check (size (j, 2), 5, l)
151 call check (size (j, 3), 7, l)
152 call check (size (j), 140, l)
153 call check (size (k, 1), 5, l)
154 call check (size (k, 2), 1, l)
155 call check (size (k, 3), 3, l)
156 call check (size (k), 15, l)
157 !$omp end parallel
158 if (l) call abort
159 end subroutine foo
160
161 subroutine test
162 character (len = 12) :: c
163 character (len = 7) :: d
164 integer, dimension (2, 3:5, 7) :: e
165 integer, dimension (2, 3:7, 7) :: f
166 character (len = 12), dimension (5, 3:7) :: g
167 character (len = 7), dimension (5, 3:7) :: h
168 real, dimension (3:5, 2:6, 1:7) :: i
169 double precision, dimension (3:6, 2:6, 1:7) :: j
170 integer, dimension (1:5, 7:7, 4:6) :: k
171 integer :: p, q, r
172 c = 'abcdefghijkl'
173 d = 'ABCDEFG'
174 forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r
175 forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r
176 forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB'
177 forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY'
178 forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456'
179 forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543'
180 forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r
181 forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r
182 forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r
183 call foo (c, d, e, f, g, h, i, j, k, 7)
184 end subroutine test
185 end