1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
! The following directives are all 'pure' and should compile
pure logical function func_assume(i)
implicit none
integer, value :: i
!$omp assume holds(i > 5)
func_assume = i < 3
!$omp end assume
end
pure logical function func_assumes()
implicit none
!$omp assumes absent(parallel)
func_assumes = .false.
end
pure logical function func_reduction()
implicit none
!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) initializer (omp_priv = 0)
func_reduction = .false.
end
pure logical function func_declare_simd()
implicit none
!$omp declare simd
func_declare_simd = .false.
end
pure logical function func_declare_target()
implicit none
!$omp declare target
func_declare_target = .false.
end
pure logical function func_error_1()
implicit none
!$omp error severity(warning) ! { dg-warning "OMP ERROR encountered" }
func_error_1 = .false.
end
pure logical function func_error_2()
implicit none
!$omp error severity(warning) at(compilation) ! { dg-warning "OMP ERROR encountered" }
func_error_2 = .false.
end
pure logical function func_error_3()
implicit none
!$omp error severity(warning) at(execution) ! { dg-error "OpenMP ERROR directive at .1. with 'at\\(execution\\)' clause in a PURE procedure" }
func_error_3 = .false.
end
pure logical function func_nothing()
implicit none
!$omp nothing
func_nothing = .false.
end
pure logical function func_scan(n)
implicit none
integer, value :: n
integer :: i, r
integer :: A(n)
integer :: B(n)
A = 0
B = 0
r = 0
!$omp simd reduction (inscan, +:r)
do i = 1, 1024
r = r + a(i)
!$omp scan inclusive(r)
b(i) = i
end do
func_scan = b(1) == 3
end
pure integer function func_simd(n)
implicit none
integer, value :: n
integer :: j, r
r = 0
!$omp simd reduction(+:r)
do j = 1, n
r = r + j
end do
func_simd = r
end
|
