annotate libgomp/testsuite/libgomp.fortran/vla7.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
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
1 ! { dg-do run }
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
2 ! { dg-options "-w" }
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
3
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
4 character (6) :: c, f2
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
5 character (6) :: d(2)
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
6 c = f1 (6)
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
7 if (c .ne. 'opqrst') call abort
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
8 c = f2 (6)
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
9 if (c .ne. '_/!!/_') call abort
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
10 d = f3 (6)
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
11 if (d(1) .ne. 'opqrst' .or. d(2) .ne. 'a') call abort
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
12 d = f4 (6)
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
13 if (d(1) .ne. 'Opqrst' .or. d(2) .ne. 'A') call abort
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
14 contains
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
15 function f1 (n)
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
16 use omp_lib
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
17 character (n) :: f1
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
18 logical :: l
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
19 f1 = 'abcdef'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
20 l = .false.
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
21 !$omp parallel firstprivate (f1) reduction (.or.:l) num_threads (2)
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
22 l = f1 .ne. 'abcdef'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
23 if (omp_get_thread_num () .eq. 0) f1 = 'ijklmn'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
24 if (omp_get_thread_num () .eq. 1) f1 = 'IJKLMN'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
25 !$omp barrier
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
26 l = l .or. (omp_get_thread_num () .eq. 0 .and. f1 .ne. 'ijklmn')
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
27 l = l .or. (omp_get_thread_num () .eq. 1 .and. f1 .ne. 'IJKLMN')
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
28 !$omp end parallel
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
29 f1 = 'zZzz_z'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
30 !$omp parallel shared (f1) reduction (.or.:l) num_threads (2)
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
31 l = l .or. f1 .ne. 'zZzz_z'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
32 !$omp barrier
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
33 !$omp master
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
34 f1 = 'abc'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
35 !$omp end master
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
36 !$omp barrier
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
37 l = l .or. f1 .ne. 'abc'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
38 !$omp barrier
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
39 if (omp_get_thread_num () .eq. 1) f1 = 'def'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
40 !$omp barrier
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
41 l = l .or. f1 .ne. 'def'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
42 !$omp end parallel
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
43 if (l) call abort
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
44 f1 = 'opqrst'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
45 end function f1
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
46 function f3 (n)
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
47 use omp_lib
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
48 character (n), dimension (2) :: f3
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
49 logical :: l
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
50 f3 = 'abcdef'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
51 l = .false.
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
52 !$omp parallel firstprivate (f3) reduction (.or.:l) num_threads (2)
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
53 l = any (f3 .ne. 'abcdef')
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
54 if (omp_get_thread_num () .eq. 0) f3 = 'ijklmn'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
55 if (omp_get_thread_num () .eq. 1) f3 = 'IJKLMN'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
56 !$omp barrier
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
57 l = l .or. (omp_get_thread_num () .eq. 0 .and. any (f3 .ne. 'ijklmn'))
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
58 l = l .or. (omp_get_thread_num () .eq. 1 .and. any (f3 .ne. 'IJKLMN'))
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
59 !$omp end parallel
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
60 f3 = 'zZzz_z'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
61 !$omp parallel shared (f3) reduction (.or.:l) num_threads (2)
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
62 l = l .or. any (f3 .ne. 'zZzz_z')
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
63 !$omp barrier
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
64 !$omp master
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
65 f3 = 'abc'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
66 !$omp end master
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
67 !$omp barrier
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
68 l = l .or. any (f3 .ne. 'abc')
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
69 !$omp barrier
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
70 if (omp_get_thread_num () .eq. 1) f3 = 'def'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
71 !$omp barrier
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
72 l = l .or. any (f3 .ne. 'def')
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
73 !$omp end parallel
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
74 if (l) call abort
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
75 f3(1) = 'opqrst'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
76 f3(2) = 'a'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
77 end function f3
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
78 function f4 (n)
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
79 use omp_lib
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
80 character (n), dimension (n - 4) :: f4
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
81 logical :: l
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
82 f4 = 'abcdef'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
83 l = .false.
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
84 !$omp parallel firstprivate (f4) reduction (.or.:l) num_threads (2)
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
85 l = any (f4 .ne. 'abcdef')
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
86 if (omp_get_thread_num () .eq. 0) f4 = 'ijklmn'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
87 if (omp_get_thread_num () .eq. 1) f4 = 'IJKLMN'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
88 !$omp barrier
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
89 l = l .or. (omp_get_thread_num () .eq. 0 .and. any (f4 .ne. 'ijklmn'))
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
90 l = l .or. (omp_get_thread_num () .eq. 1 .and. any (f4 .ne. 'IJKLMN'))
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
91 l = l .or. size (f4) .ne. 2
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
92 !$omp end parallel
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
93 f4 = 'zZzz_z'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
94 !$omp parallel shared (f4) reduction (.or.:l) num_threads (2)
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
95 l = l .or. any (f4 .ne. 'zZzz_z')
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
96 !$omp barrier
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
97 !$omp master
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
98 f4 = 'abc'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
99 !$omp end master
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
100 !$omp barrier
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
101 l = l .or. any (f4 .ne. 'abc')
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
102 !$omp barrier
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
103 if (omp_get_thread_num () .eq. 1) f4 = 'def'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
104 !$omp barrier
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
105 l = l .or. any (f4 .ne. 'def')
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
106 l = l .or. size (f4) .ne. 2
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
107 !$omp end parallel
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
108 if (l) call abort
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
109 f4(1) = 'Opqrst'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
110 f4(2) = 'A'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
111 end function f4
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
112 end
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
113 function f2 (n)
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
114 use omp_lib
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
115 character (*) :: f2
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
116 logical :: l
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
117 f2 = 'abcdef'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
118 l = .false.
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
119 !$omp parallel firstprivate (f2) reduction (.or.:l) num_threads (2)
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
120 l = f2 .ne. 'abcdef'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
121 if (omp_get_thread_num () .eq. 0) f2 = 'ijklmn'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
122 if (omp_get_thread_num () .eq. 1) f2 = 'IJKLMN'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
123 !$omp barrier
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
124 l = l .or. (omp_get_thread_num () .eq. 0 .and. f2 .ne. 'ijklmn')
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
125 l = l .or. (omp_get_thread_num () .eq. 1 .and. f2 .ne. 'IJKLMN')
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
126 !$omp end parallel
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
127 f2 = 'zZzz_z'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
128 !$omp parallel shared (f2) reduction (.or.:l) num_threads (2)
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
129 l = l .or. f2 .ne. 'zZzz_z'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
130 !$omp barrier
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
131 !$omp master
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
132 f2 = 'abc'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
133 !$omp end master
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
134 !$omp barrier
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
135 l = l .or. f2 .ne. 'abc'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
136 !$omp barrier
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
137 if (omp_get_thread_num () .eq. 1) f2 = 'def'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
138 !$omp barrier
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
139 l = l .or. f2 .ne. 'def'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
140 !$omp end parallel
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
141 if (l) call abort
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
142 f2 = '_/!!/_'
a06113de4d67 first commit
kent <kent@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
143 end function f2