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
|
! { dg-do run }
! Like imperfect2.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
call f1 (1, i)
block
call g1 (1, i)
do j = 1, a2
call f1 (2, j)
block
call g1 (2, j)
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
call g2 (2, j)
end block
call f2 (2, j)
end do
call g2 (1, i)
end block
call f2 (1, i)
end do
end subroutine
end program
|
