50 integer:: n_state(0:4)=0
51 integer:: d_state(0:4)=0
53 integer:: n_write=2000
54 integer(8):: n_check=0, n_ready=0
55 real(8):: wc_failed=0d0
57 logical:: use_critical=.false.
63 SUBROUTINE init (self, task_list)
67 namelist /dispatcher3_params/ verbose, use_critical, n_write
70 read (io%input, dispatcher3_params, iostat=iostat)
71 write (io%output, dispatcher3_params)
79 SUBROUTINE execute (self, task_list, test)
82 logical:: test, fell_through
84 class(
link_t),
pointer:: link, nbor
85 class(
task_t),
pointer:: task
88 real(8):: start_fail, start_iter
89 integer,
save:: itimer=0
91 call trace%begin (
'dispatcher3_t%execute', itimer=itimer)
92 call io%header(
'begin dispatcher3_t%execute: Any opportunity dispatcher')
93 call self%init (task_list)
94 n_state = 0; n_state(0) = io%ntask
99 do while (task_list%na>0 .and. wallclock()-start < io%job_seconds)
100 start_iter = wallclock()
104 call task_list%check_mpi()
108 fell_through = .true.
109 link => task_list%head
110 do while (
associated(link))
112 if (task%is_clear (bits%virtual))
then 117 if (link%task%state==4)
then 118 call set_state (link%task, 0)
123 if (task%state==0)
then 124 if (is_ready(link)) &
125 call set_state (link%task, 1)
130 if (task%state==1)
then 131 fell_through = .false.
133 task_list%nq = n_state(1)
135 task_list%nq = task_list%nq + n_state(2)
136 call set_state (link%task, 2)
138 call set_state (link%task, 3)
139 call task_list%update (link, test)
140 call set_state (link%task, 4)
149 if (mpi_io%iwrite_list%n == io%nwrite)
then 151 call mpi_io%iwrite_list%check()
154 call write_state (io_unit%queue,
'1')
155 if (verbose>1)
call print_state (
'1')
159 if (fell_through)
then 160 if (verbose>3) print *,
'dispatcher3: fell through' 161 wc_failed = wc_failed + (wallclock()-start_fail - start_iter)
164 if (n_fail>0 .and. verbose>0) &
165 call print_state (
'2')
173 write(io%output,
'(a,i6,4(a,f7.4))') &
174 ' dispatcher3_t%finalize: rank =',mpi%rank, &
175 ', fraction of ready tasks =',
real(n_ready)/
real(n_check), &
176 ', fraction of dispatcher idle time =', wc_failed/max(1d-10,wallclock()-start)
177 call mpi_mesg%diagnostics(1)
178 call toc (
'wall time', timer%n_update, time=start)
179 call trace%end (itimer)
180 END SUBROUTINE execute
184 SUBROUTINE print_state (label)
185 character(len=*):: label
187 call write_state (io_unit%output, label)
192 SUBROUTINE write_state (unit, label)
194 character(len=*):: label
196 if (n_write <= 0)
return 199 write(unit,
'("DISPATCHER3: ",a,f12.6,f9.3,2x,3(2x,a,i6),9(2x,a,i5))') &
200 label, wallclock(), &
201 wc_failed/max(1d-10,wallclock()-start), &
203 'idl:', n_state(0), &
204 'rdy:', n_state(1), &
205 'spw:', n_state(2), &
206 'act:', n_state(3), &
207 'upd:', n_state(4), &
208 'idl:', d_state(0), &
209 'rdy:', d_state(1), &
210 'spw:', d_state(2), &
211 'act:', d_state(3), &
215 END SUBROUTINE write_state
220 SUBROUTINE set_state (task, in)
221 class(
task_t),
pointer:: task
224 if (use_critical)
then 228 n_state(ip) = n_state(ip) - 1
229 n_state(in) = n_state(in) + 1
230 d_state(in) = d_state(in) + 1
232 print
'(a,i4,f12.6,2x,5i4,2x,2i3)',
' dispatcher3:', omp%thread, wallclock(), n_state, ip, in
238 n_state(ip) = n_state(ip) - 1
240 n_state(in) = n_state(in) + 1
242 d_state(in) = d_state(in) + 1
246 write (io%output,
'(a,i4,f12.6,2x,5i4,2x,2i3)') &
247 ' dispatcher3:', omp%thread, wallclock(), n_state, ip, in
249 END SUBROUTINE set_state
255 LOGICAL FUNCTION is_ready (link)
256 class(
link_t),
pointer:: link, nbor
261 call io%assert (
associated(link),
'is_ready: link missing')
262 call io%assert (
associated(link%task),
'is_ready: link%task missing')
264 state = link%task%state
265 if (link%task%is_set (bits%virtual))
then 270 do while (
associated(nbor))
271 if (nbor%needed)
then 273 state = nbor%task%state
277 is_ready = is_ready .and. nbor%task%is_ahead_of (link%task)
279 if (.not.is_ready)
then 281 print *, link%task%id,
'is_ready: failed on', nbor%task%id, &
282 nbor%task%time, link%task%time
293 END FUNCTION is_ready
Each thread uses a private timer data type, with arrays for start time and total time for each regist...
Module for handling blocking and non-blocking MPI parallel I/O to a single file. The module is initia...
Support tic/toc timing, as in MATLAB, and accurate wallclock() function. The timing is generally much...
Data type for computing global average, while using only nearest node nbor communication.
Execute a task list. Since only the master thread is calling check_mpi(), we need to make sure that i...
Task list data type, with methods for startup and updates. Message handling is inherited from the tas...
Module with list handling for generic class task_t objects.
Template module for tasks.