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