Mercurial > hg > CbC > CbC_gcc

comparison libgomp/testsuite/libgomp.fortran/character1.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
4 character (len = 8) :: h, i
5 character (len = 4) :: j, k
6 h = '01234567'
7 i = 'ABCDEFGH'
8 j = 'IJKL'
9 k = 'MN'
10 call test (h, j)
11 contains
12 subroutine test (p, q)
13 character (len = 8) :: p
14 character (len = 4) :: q, r
15 character (len = 16) :: f
16 character (len = 32) :: g
17 integer, dimension (18) :: s
18 logical :: l
19 integer :: m
20 f = 'test16'
21 g = 'abcdefghijklmnopqrstuvwxyz'
22 r = ''
23 l = .false.
24 s = -6
25 !$omp parallel firstprivate (f, p, s) private (r, m) reduction (.or.:l) &
26 !$omp & num_threads (4)
27 m = omp_get_thread_num ()
28 if (any (s .ne. -6)) l = .true.
29 l = l .or. f .ne. 'test16' .or. p .ne. '01234567'
30 l = l .or. g .ne. 'abcdefghijklmnopqrstuvwxyz'
31 l = l .or. i .ne. 'ABCDEFGH' .or. q .ne. 'IJKL'
32 l = l .or. k .ne. 'MN'
33 !$omp barrier
34 if (m .eq. 0) then
35 f = 'ffffffff0'
36 g = 'xyz'
37 i = '123'
38 k = '9876'
39 p = '_abc'
40 q = '_def'
41 r = '1_23'
42 else if (m .eq. 1) then
43 f = '__'
44 p = 'xxx'
45 r = '7575'
46 else if (m .eq. 2) then
47 f = 'ZZ'
48 p = 'm2'
49 r = 'M2'
50 else if (m .eq. 3) then
51 f = 'YY'
52 p = 'm3'
53 r = 'M3'
54 end if
55 s = m
56 !$omp barrier
57 l = l .or. g .ne. 'xyz' .or. i .ne. '123' .or. k .ne. '9876'
58 l = l .or. q .ne. '_def'
59 if (any (s .ne. m)) l = .true.
60 if (m .eq. 0) then
61 l = l .or. f .ne. 'ffffffff0' .or. p .ne. '_abc' .or. r .ne. '1_23'
62 else if (m .eq. 1) then
63 l = l .or. f .ne. '__' .or. p .ne. 'xxx' .or. r .ne. '7575'
64 else if (m .eq. 2) then
65 l = l .or. f .ne. 'ZZ' .or. p .ne. 'm2' .or. r .ne. 'M2'
66 else if (m .eq. 3) then
67 l = l .or. f .ne. 'YY' .or. p .ne. 'm3' .or. r .ne. 'M3'
68 end if
69 !$omp end parallel
70 if (l) call abort
71 end subroutine test
72 end