Mercurial > hg > CbC > CbC_gcc

comparison libgomp/testsuite/libgomp.fortran/omp_parse1.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 use omp_lib
3 call test_parallel
4 call test_do
5 call test_sections
6 call test_single
7
8 contains
9 subroutine test_parallel
10 integer :: a, b, c, e, f, g, i, j
11 integer, dimension (20) :: d
12 logical :: h
13 a = 6
14 b = 8
15 c = 11
16 d(:) = -1
17 e = 13
18 f = 24
19 g = 27
20 h = .false.
21 i = 1
22 j = 16
23 !$omp para&
24 !$omp&llel &
25 !$omp if (a .eq. 6) private (b, c) shared (d) private (e) &
26 !$omp firstprivate(f) num_threads (a - 1) first&
27 !$ompprivate(g)default (shared) reduction (.or. : h) &
28 !$omp reduction(*:i)
29 if (i .ne. 1) h = .true.
30 i = 2
31 if (f .ne. 24) h = .true.
32 if (g .ne. 27) h = .true.
33 e = 7
34 b = omp_get_thread_num ()
35 if (b .eq. 0) j = 24
36 f = b
37 g = f
38 c = omp_get_num_threads ()
39 if (c .gt. a - 1 .or. c .le. 0) h = .true.
40 if (b .ge. c) h = .true.
41 d(b + 1) = c
42 if (f .ne. g .or. f .ne. b) h = .true.
43 !$omp endparallel
44 if (h) call abort
45 if (a .ne. 6) call abort
46 if (j .ne. 24) call abort
47 if (d(1) .eq. -1) call abort
48 e = 1
49 do g = 1, d(1)
50 if (d(g) .ne. d(1)) call abort
51 e = e * 2
52 end do
53 if (e .ne. i) call abort
54 end subroutine test_parallel
55
56 subroutine test_do_orphan
57 integer :: k, l
58 !$omp parallel do private (l)
59 do 600 k = 1, 16, 2
60 600 l = k
61 end subroutine test_do_orphan
62
63 subroutine test_do
64 integer :: i, j, k, l, n
65 integer, dimension (64) :: d
66 logical :: m
67
68 j = 16
69 d(:) = -1
70 m = .true.
71 n = 24
72 !$omp parallel num_threads (4) shared (i, k, d) private (l) &
73 !$omp&reduction (.and. : m)
74 if (omp_get_thread_num () .eq. 0) then
75 k = omp_get_num_threads ()
76 end if
77 call test_do_orphan
78 !$omp do schedule (static) firstprivate (n)
79 do 200 i = 1, j
80 if (i .eq. 1 .and. n .ne. 24) call abort
81 n = i
82 200 d(n) = omp_get_thread_num ()
83 !$omp enddo nowait
84
85 !$omp do lastprivate (i) schedule (static, 5)
86 do 201 i = j + 1, 2 * j
87 201 d(i) = omp_get_thread_num () + 1024
88 ! Implied omp end do here
89
90 if (i .ne. 33) m = .false.
91
92 !$omp do private (j) schedule (dynamic)
93 do i = 33, 48
94 d(i) = omp_get_thread_num () + 2048
95 end do
96 !$omp end do nowait
97
98 !$omp do schedule (runtime)
99 do i = 49, 4 * j
100 d(i) = omp_get_thread_num () + 4096
101 end do
102 ! Implied omp end do here
103 !$omp end parallel
104 if (.not. m) call abort
105
106 j = 0
107 do i = 1, 64
108 if (d(i) .lt. j .or. d(i) .ge. j + k) call abort
109 if (i .eq. 16) j = 1024
110 if (i .eq. 32) j = 2048
111 if (i .eq. 48) j = 4096
112 end do
113 end subroutine test_do
114
115 subroutine test_sections
116 integer :: i, j, k, l, m, n
117 i = 9
118 j = 10
119 k = 11
120 l = 0
121 m = 0
122 n = 30
123 call omp_set_dynamic (.false.)
124 call omp_set_num_threads (4)
125 !$omp parallel num_threads (4)
126 !$omp sections private (i) firstprivate (j, k) lastprivate (j) &
127 !$omp& reduction (+ : l, m)
128 !$omp section
129 i = 24
130 if (j .ne. 10 .or. k .ne. 11 .or. m .ne. 0) l = 1
131 m = m + 4
132 !$omp section
133 i = 25
134 if (j .ne. 10 .or. k .ne. 11) l = 1
135 m = m + 6
136 !$omp section
137 i = 26
138 if (j .ne. 10 .or. k .ne. 11) l = 1
139 m = m + 8
140 !$omp section
141 i = 27
142 if (j .ne. 10 .or. k .ne. 11) l = 1
143 m = m + 10
144 j = 271
145 !$omp end sections nowait
146 !$omp sections lastprivate (n)
147 !$omp section
148 n = 6
149 !$omp section
150 n = 7
151 !$omp endsections
152 !$omp end parallel
153 if (j .ne. 271 .or. l .ne. 0) call abort
154 if (m .ne. 4 + 6 + 8 + 10) call abort
155 if (n .ne. 7) call abort
156 end subroutine test_sections
157
158 subroutine test_single
159 integer :: i, j, k, l
160 logical :: m
161 i = 200
162 j = 300
163 k = 400
164 l = 500
165 m = .false.
166 !$omp parallel num_threads (4), private (i, j), reduction (.or. : m)
167 i = omp_get_thread_num ()
168 j = omp_get_thread_num ()
169 !$omp single private (k)
170 k = 64
171 !$omp end single nowait
172 !$omp single private (k) firstprivate (l)
173 if (i .ne. omp_get_thread_num () .or. i .ne. j) then
174 j = -1
175 else
176 j = -2
177 end if
178 if (l .ne. 500) j = -1
179 l = 265
180 !$omp end single copyprivate (j)
181 if (i .ne. omp_get_thread_num () .or. j .ne. -2) m = .true.
182 !$omp endparallel
183 if (m) call abort
184 end subroutine test_single
185 end