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 adds bindings to the blocks.
program foo
integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
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
f1count(depth) = f1count(depth) + 1
end subroutine
subroutine f2 (depth, iter)
integer :: depth, iter
f2count(depth) = f2count(depth) + 1
end subroutine
subroutine g1 (depth, iter)
integer :: depth, iter
g1count(depth) = g1count(depth) + 1
end subroutine
subroutine g2 (depth, iter)
integer :: depth, iter
g2count(depth) = g2count(depth) + 1
end subroutine
subroutine s1 (a1, a2, a3)
integer :: a1, a2, a3
integer :: i, j, k
!$omp do collapse(3)
do i = 1, a1
call f1 (1, i)
block
integer :: local1
local1 = 1
call g1 (local1, i)
do j = 1, a2
call f1 (2, j)
block
integer :: local2
local2 = 2
call g1 (local2, j)
do k = 1, a3
call f1 (3, k)
block
integer :: local3
local3 = 3
call g1 (local3, k)
call g2 (local3, k)
end block
call f2 (3, k)
end do
call g2 (local2, j)
end block
call f2 (2, j)
end do
call g2 (local1, i)
end block
call f2 (1, i)
end do
end subroutine
end program
|
