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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
<ompts:test>
<ompts:testdescription>Test which checks the guided option of the omp do schedule directive.</ompts:testdescription>
<ompts:ompversion>2.0</ompts:ompversion>
<ompts:directive>omp do schedule(guided)</ompts:directive>
<ompts:dependences>omp flush,omp do nowait,omp critical,omp single</ompts:dependences>
<ompts:testcode>
! TODO:
! C. Niethammer:
! Find check to decide if the test was run as schedule(static) because
! this also can pass the test if the work is divided into thread-counts
INTEGER FUNCTION <ompts:testcode:functionname>do_schedule_guided</ompts:testcode:functionname>()
IMPLICIT NONE
INTEGER omp_get_thread_num,omp_get_num_threads
CHARACTER*20 logfile
INTEGER threads
INTEGER tmp_count
INTEGER, allocatable :: tmp(:)
INTEGER ii, flag
INTEGER result
INTEGER expected
INTEGER openwork
DOUBLE PRECISION c
<ompts:orphan:vars>
INTEGER i
INTEGER tid
INTEGER count
INTEGER DELAY
INTEGER MAX_TIME
INTEGER CFSMAX_SIZE
! ... choose small iteration space for small sync. overhead
PARAMETER (DELAY = 1)
PARAMETER (MAX_TIME = 5)
PARAMETER (CFSMAX_SIZE = 150)
INTEGER notout
INTEGER maxiter
INTEGER tids(0:CFSMAX_SIZE-1)
COMMON /orphvars/ notout,maxiter,tids
</ompts:orphan:vars>
result = 0
notout = 1
maxiter = 0
count = 0
tmp_count = 0
openwork = CFSMAX_SIZE
<ompts:check>
! Determine the number of available threads
!$omp parallel
!$omp single
threads = omp_get_num_threads()
!$omp end single
!$omp end parallel
IF ( threads .LT. 2) THEN
PRINT *,"This test only works with at least two threads"
WRITE(1,*) "This test only works with at least two threads"
<testfunctionname></testfunctionname> = 0
STOP
END IF
! ... Now the real parallel work:
! ... Each thread will start immediately with the first chunk.
!$omp parallel private(tid,count) shared(tids,maxiter)
tid = omp_get_thread_num()
<ompts:orphan>
!$omp do schedule(guided)
DO i = 0 , CFSMAX_SIZE-1
count = 0
!$omp flush(maxiter)
IF ( i .GT. maxiter ) THEN
!$omp critical
maxiter = i
!$omp end critical
END IF
!.. if it is not our turn we wait
! a) until another thread executed an iteration
! with a higher iteration count
! b) we are at the end of the loop (first thread finished
! and set notout=0 OR
! c) timeout arrived
!$omp flush(maxiter,notout)
IF ( notout .GE. 1 .AND. count .LT. MAX_TIME
& .AND. maxiter .EQ. i ) THEN
DO WHILE ( notout .GE. 1 .AND. count .LT. MAX_TIME
& .AND. maxiter .EQ. i )
CALL sleep(DELAY)
count = count + DELAY
END DO
END IF
tids(i) = tid
END DO
!$omp end do nowait
</ompts:orphan>
notout = 0
!$omp flush(notout)
!$omp end parallel
!*******************************************************!
! evaluation of the values
!*******************************************************!
count = 0
DO i=0, CFSMAX_SIZE - 2
IF ( tids(i) .NE. tids(i+1) ) THEN
count = count + 1
END IF
END DO
ALLOCATE( tmp(0:count) )
tmp_count = 0
tmp(0) = 1
! ... calculate the chunksize for each dispatch
DO i=0, CFSMAX_SIZE - 2
IF ( tids(i) .EQ. tids(i+1) ) THEN
tmp(tmp_count) = tmp(tmp_count) + 1
ELSE
tmp_count = tmp_count + 1
tmp(tmp_count) = 1
END IF
END DO
! ... Check if chunk sizes are decreased until equals to
! ... the specified one, ignore the last dispatch
! ... for possible smaller remainder
! Determine the constant
expected = openwork / threads
c = real(tmp(0)) / real(expected)
WRITE(1,*) "Found constant to be ", c
DO i = 0, count - 2
WRITE(1,*) "open:", openwork, "size:", tmp(i)
IF (expected .GT. 1) THEN
expected = c * openwork / threads
END IF
IF (abs(tmp(i) - expected) .GE. 2 ) THEN
result = 1
WRITE(1,*) "Chunksize differed from expected ",
& "value: ",tmp(i), "instead ", expected
END IF
IF (i .GT. 0 .AND. (tmp(i-1) - tmp(i)) .LT. 0) THEN
WRITE(1,*) "Chunksize did not decrease: ", tmp(i),
& "instead",tmp(i-1)
END IF
openwork = openwork - tmp(i)
END DO
IF ( result .EQ. 0 ) THEN
<testfunctionname></testfunctionname> = 1
ELSE
<testfunctionname></testfunctionname> = 0
END IF
END
</ompts:check>
<ompts:crosscheck>
<testfunctionname></testfunctionname> = 0
END
</ompts:crosscheck>
</ompts:testcode>
</omtps:test>
|
