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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
! { dg-do run }
! Like imperfect4.f90, but enables offloading.
program foo
integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
!$omp declare target enter (f1count, f2count)
!$omp declare target enter (g1count, g2count)
f1count(1) = 0
f1count(2) = 0
f1count(3) = 0
f2count(1) = 0
f2count(2) = 0
f2count(3) = 0
g1count(1) = 0
g1count(2) = 0
g1count(3) = 0
g2count(1) = 0
g2count(2) = 0
g2count(3) = 0
call s1 (3, 4, 5)
! All intervening code at the same depth must be executed the same
! number of times.
if (f1count(1) /= f2count(1)) error stop 101
if (f1count(2) /= f2count(2)) error stop 102
if (f1count(3) /= f2count(3)) error stop 103
if (g1count(1) /= f1count(1)) error stop 104
if (g2count(1) /= f1count(1)) error stop 105
if (g1count(2) /= f1count(2)) error stop 106
if (g2count(2) /= f1count(2)) error stop 107
if (g1count(3) /= f1count(3)) error stop 108
if (g2count(3) /= f1count(3)) error stop 109
! Intervening code must be executed at least as many times as the loop
! that encloses it.
if (f1count(1) < 3) error stop 111
if (f1count(2) < 3 * 4) error stop 112
! Intervening code must not be executed more times than the number
! of logical iterations.
if (f1count(1) > 3 * 4 * 5) error stop 121
if (f1count(2) > 3 * 4 * 5) error stop 122
! Check that the innermost loop body is executed exactly the number
! of logical iterations expected.
if (f1count(3) /= 3 * 4 * 5) error stop 131
contains
subroutine f1 (depth, iter)
integer :: depth, iter
!$omp atomic
f1count(depth) = f1count(depth) + 1
end subroutine
subroutine f2 (depth, iter)
integer :: depth, iter
!$omp atomic
f2count(depth) = f2count(depth) + 1
end subroutine
subroutine g1 (depth, iter)
integer :: depth, iter
!$omp atomic
g1count(depth) = g1count(depth) + 1
end subroutine
subroutine g2 (depth, iter)
integer :: depth, iter
!$omp atomic
g2count(depth) = g2count(depth) + 1
end subroutine
subroutine s1 (a1, a2, a3)
integer :: a1, a2, a3
integer :: i, j, k
!$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count)
do i = 1, a1
block
call f1 (1, i)
end block
block
block
call g1 (1, i)
end block
do j = 1, a2
block
call f1 (2, j)
end block
block
block
call g1 (2, j)
end block
do k = 1, a3
call f1 (3, k)
block
call g1 (3, k)
call g2 (3, k)
end block
call f2 (3, k)
end do
block
call g2 (2, j)
end block
end block
block
call f2 (2, j)
end block
end do
block
call g2 (1, i)
end block
end block
block
call f2 (1, i)
end block
end do
end subroutine
end program
|
