67 procedure:: spawn_update
70 procedure:: print_state
71 procedure:: diagnostics
75 integer:: n_state(0:4)=0
76 integer:: d_state(0:4)=0
78 integer:: n_write=2000
79 integer(8):: n_check=0, n_ready=0
81 real(8):: wc_failed=0d0
83 logical:: master_works=.true.
84 logical:: use_locks=.false.
85 logical:: use_critical=.true.
86 logical:: use_taskyield=.false.
87 character(len=32):: fmt0=
'( f12.6,i4,2x,a,2x,i7,2i4)' 88 character(len=32):: fmt1=
'(40x,f12.6,i4,2x,a,2x,i7,2i4)' 89 character(len=48):: fmt2=
'(40x,f12.6,i4,2x,a,2x,i7,2x,a,1p,g14.5)' 95 SUBROUTINE init (self, task_list)
99 namelist /dispatcher4_params/ use_locks, use_critical, use_taskyield, f_over, &
100 master_works, n_write, verbose
102 rewind(io%input);
read (io%input, dispatcher4_params, iostat=iostat)
103 if (io%master)
write (io%output, dispatcher4_params)
104 self%verbose = verbose
112 SUBROUTINE execute (self, task_list, test)
115 logical:: test, fell_through
117 class(
link_t),
pointer:: link, nbor
118 class(
task_t),
pointer:: task
121 real(8):: start_fail, start_iter
122 integer,
save:: itimer=0
124 call trace%begin (
'dispatcher4_t%execute', itimer=itimer)
125 call io%header(
'begin dispatcher4_t%execute: Any opportunity dispatcher')
126 call self%init (task_list)
127 self%task_list => task_list
129 n_state = 0; n_state(0) = io%ntask
130 call tic (time=start)
134 do while (task_list%na>0 .and. wallclock()-start < io%job_seconds)
135 start_iter = wallclock()
139 call task_list%check_mpi()
143 fell_through = .true.
144 link => task_list%head
145 do while (
associated(link))
147 if (.not.task%is_set (bits%virtual))
then 152 if (link%task%state==4)
then 153 call self%set_state (link%task, 0)
158 if (task%state==0)
then 159 if (self%is_ready (link))
then 160 call self%set_state (link%task, 1)
161 else if (link%task%time == 0.0_8)
then 162 write(io_unit%queue,*) link%task%id,
'ERROR: at time=0, but not ready!' 164 do while (
associated(nbor))
165 write(io_unit%queue,
'(i7,i3,2f10.6,2x,2l3)') &
166 nbor%task%id, nbor%task%state, (nbor%task%time-link%task%time), nbor%task%dtime, &
167 nbor%needed, nbor%task%is_ahead_of (link%task)
175 if (task%state==1)
then 176 fell_through = .false.
178 task_list%nq = n_state(1)
180 task_list%nq = task_list%nq + n_state(2)
181 if (omp%nthreads > 1)
then 182 call self%spawn_update (task_list, link, test)
184 call self%update (task_list, link, test)
190 call write_state (self, io_unit%queue,
'1')
191 if (self%verbose>1)
call self%print_state (
'1')
197 call mpi_mesg%diagnostics(1)
198 call toc (
'wall time', timer%n_update, time=start)
199 call trace%end (itimer)
200 END SUBROUTINE execute
204 SUBROUTINE print_state (self, label)
206 character(len=*):: label
208 call write_state (self, io_unit%output, label)
213 SUBROUTINE write_state (self, unit, label)
216 character(len=*):: label
218 if (n_write <= 0)
return 221 write(unit,
'("DISPATCHER3: ",a,f12.6,f9.3,2x,3(2x,a,i6),9(2x,a,i5))') &
222 label, wallclock(), &
223 wc_failed/max(1d-10,wallclock()-start), &
225 'idl:', n_state(0), &
226 'rdy:', n_state(1), &
227 'spw:', n_state(2), &
228 'act:', n_state(3), &
229 'upd:', n_state(4), &
230 'idl:', d_state(0), &
231 'rdy:', d_state(1), &
232 'spw:', d_state(2), &
233 'act:', d_state(3), &
237 END SUBROUTINE write_state
245 SUBROUTINE update (self, task_list, link, test)
248 class(
link_t),
pointer:: link, nbor
249 class(
task_t),
pointer:: task
253 call self%set_state (link%task, 3)
254 call task_list%update (link, test)
255 call self%set_state (link%task, 4)
256 END SUBROUTINE update
261 SUBROUTINE spawn_update (self, task_list, link, test)
264 class(
link_t),
pointer:: link
267 call self%set_state (link%task, 2)
269 call self%set_state (link%task, 3)
270 call task_list%update (link, test)
271 call self%set_state (link%task, 4)
273 END SUBROUTINE spawn_update
278 SUBROUTINE set_state (self, task, in)
280 class(
task_t),
pointer:: task
283 if (use_critical)
then 287 n_state(ip) = n_state(ip) - 1
288 n_state(in) = n_state(in) + 1
289 d_state(in) = d_state(in) + 1
290 if (self%verbose>1) &
291 print
'(a,i4,f12.6,2x,5i4,2x,2i3)',
' dispatcher4:', omp%thread, wallclock(), n_state, ip, in
297 n_state(ip) = n_state(ip) - 1
299 n_state(in) = n_state(in) + 1
301 d_state(in) = d_state(in) + 1
304 if (self%verbose>1) &
305 write (io%output,
'(a,i4,f12.6,2x,5i4,2x,2i3)') &
306 ' dispatcher4:', omp%thread, wallclock(), n_state, ip, in
314 LOGICAL FUNCTION is_ready (self, link)
316 class(
link_t),
pointer:: link, nbor
321 call io%assert (
associated(link),
'is_ready: link missing')
322 call io%assert (
associated(link%task),
'is_ready: link%task missing')
324 state = link%task%state
325 if (link%task%is_set (bits%virtual))
then 330 do while (
associated(nbor))
331 if (nbor%needed)
then 333 state = nbor%task%state
337 is_ready = is_ready .and. nbor%task%is_ahead_of (link%task)
339 if (.not.is_ready)
then 341 print *, link%task%id,
'is_ready: failed on', nbor%task%id, &
342 nbor%task%time, link%task%time
353 END FUNCTION is_ready
360 write(io%output,
'(a,i6,4(a,f7.4))') &
361 ' dispatcher4_t%finalize: rank =',mpi%rank, &
362 ', fraction of ready tasks =',
real(n_ready)/
real(n_check), &
363 ', fraction of dispatcher idle time =', wc_failed/max(1d-10,wallclock()-start)
364 END SUBROUTINE finalize
368 SUBROUTINE diagnostics (self, task_list)
371 class(
link_t),
pointer:: link, nbor, culprit
374 link => task_list%head
375 do while (
associated(link))
380 END SUBROUTINE diagnostics
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.
Task list data type, with methods for startup and updates. Message handling is inherited from the tas...
Execute a task list. Since only the master thread is calling check_mpi(), we need to make sure that i...
Module with list handling for generic class task_t objects.
Template module for tasks.