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
|
! { dg-options "-O2" }
integer, save :: u(64), v
integer :: min_iters, max_iters, ntasks, cnt
procedure(grainsize), pointer :: fn
!$omp parallel
!$omp single
fn => grainsize
! If grainsize is present, # of task loop iters is
! >= grainsize && < 2 * grainsize,
! unless # of loop iterations is smaller than grainsize.
call test (0, 79, 1, 17, fn, ntasks, min_iters, max_iters, cnt)
if (cnt .ne. 79) stop 1
if (min_iters .lt. 17 .or. max_iters .ge. 17 * 2) stop 2
call test (-49, 2541, 7, 28, fn, ntasks, min_iters, max_iters, cnt)
if (cnt .ne. 370) stop 3
if (min_iters .lt. 28 .or. max_iters .ge. 28 * 2) stop 4
call test (7, 21, 2, 15, fn, ntasks, min_iters, max_iters, cnt)
if (cnt .ne. 7) stop 5
if (min_iters .ne. 7 .or. max_iters .ne. 7) stop 6
if (ntasks .ne. 1) stop 7
fn => num_tasks
! If num_tasks is present, # of task loop iters is
! min (# of loop iters, num_tasks).
call test (-51, 2500, 48, 9, fn, ntasks, min_iters, max_iters, cnt)
if (cnt .ne. 54 .or. ntasks .ne. 9) stop 8
call test (0, 25, 2, 17, fn, ntasks, min_iters, max_iters, cnt)
if (cnt .ne. 13 .or. ntasks .ne. 13) stop 9
!$omp end single
!$omp end parallel
contains
subroutine grainsize (a, b, c, d)
integer, intent (in) :: a, b, c, d
integer :: i, j, k
j = 0
k = 0
!$omp taskloop firstprivate (j, k) grainsize (d)
do i = a, b - 1, c
if (j .eq. 0) then
!$omp atomic capture
k = v
v = v + 1
!$omp end atomic
if (k .ge. 64) stop 10
end if
j = j + 1
u(k + 1) = j
end do
end subroutine grainsize
subroutine num_tasks (a, b, c, d)
integer, intent (in) :: a, b, c, d
integer :: i, j, k
j = 0
k = 0
!$omp taskloop firstprivate (j, k) num_tasks (d)
do i = a, b - 1, c
if (j .eq. 0) then
!$omp atomic capture
k = v
v = v + 1
!$omp end atomic
if (k .ge. 64) stop 11
end if
j = j + 1
u(k + 1) = j
end do
end subroutine num_tasks
subroutine test (a, b, c, d, fn, num_tasks, min_iters, max_iters, cnt)
integer, intent (in) :: a, b, c, d
procedure(grainsize), pointer :: fn
integer, intent (out) :: num_tasks, min_iters, max_iters, cnt
integer :: i
u(:) = 0
v = 0
cnt = 0
call fn (a, b, c, d)
min_iters = 0
max_iters = 0
num_tasks = v
if (v .ne. 0) then
min_iters = minval (u(1:v))
max_iters = maxval (u(1:v))
cnt = sum (u(1:v))
end if
end subroutine test
end
|
