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