OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [libgomp/] [testsuite/] [libgomp.fortran/] [omp_parse1.f90] - Blame information for rev 735

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 735 jeremybenn
! { 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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.