DISPATCH
task_list_mod.f90
1 !===============================================================================
2 !> Task list data type, with methods for startup and updates. Message handling
3 !> is inherited from the task_mesg_t data type. At this level, task handling
4 !> is aware of experiment_t data types, and all data types it has inheritet from.
5 !===============================================================================
7  USE io_mod
8  USE trace_mod
9  USE omp_mod
10  USE omp_timer_mod
11  USE timer_mod
12  USE mpi_mod
13  USE mpi_mesg_mod
14  USE list_mod
15  USE link_mod
16  USE task_mod
17  USE patch_mod
18  USE experiment_mod
19  USE bits_mod
20  USE refine_mod
22  USE task_mesg_mod
23  USE timer_mod
24  USE validate_mod
25  USE download_mod
26  USE shared_mod
27  implicit none
28  private
29  type, public, extends(task_mesg_t):: task_list_t
30  logical:: syncing=.false.
31  logical:: dispatcher=.false.
32  real(8):: sync_time=-1.0, sync_next=-1.0
33  contains
34  procedure:: init
35  procedure:: initialize
36  procedure:: init_levels
37  procedure:: startup
38  procedure:: init_queue
39  procedure:: execute
40  procedure:: update
41  procedure:: average
42  procedure:: append_task_list
43  procedure:: print => print1
44  procedure:: init_levelstats
45  procedure:: init_task_list_pointers
46  end type
47  real(8), save:: dead_mans_hand=60d0, first_finished=0d0
48  public:: task2patch
49  type(task_list_t), target:: task_list
50 CONTAINS
51 
52 !===============================================================================
53 !> Initialize the task list, by first initializing the list tasks, then making
54 !> neighbor lists, and finally checking if they are ready to execute
55 !===============================================================================
56 SUBROUTINE init (self, name)
57  class(task_list_t):: self
58  character(len=*), optional:: name
59  class(link_t), pointer:: link
60  integer:: iostat
61  real(8), save:: job_seconds=1d30
62  real(8), save:: sync_time=0.0
63  logical, save:: detailed_timer=.false.
64  integer, save:: verbose=0
65  namelist /task_list_params/ verbose, job_seconds, dead_mans_hand, sync_time, &
66  detailed_timer
67  !-----------------------------------------------------------------------------
68  ! An optional namelist can be used to turn debugging on
69  !-----------------------------------------------------------------------------
70  call trace%begin('task_list_t%init')
71  call self%list_t%init (name)
72  call self%lock%append
73  call mpi_mesg%init
74  rewind(io%input)
75  read(io%input, task_list_params, iostat=iostat)
76  write (io%output, task_list_params)
77  if (sync_time > 0.0) &
78  self%sync_next = sync_time
79  self%sync_time = sync_time
80  io%job_seconds = job_seconds
81  timer%dead_mans_hand = dead_mans_hand
82  self%verbose = verbose
83  self%detailed_timer = detailed_timer
84  call load_balance%init
85  call trace_end
86 END SUBROUTINE init
87 
88 !===============================================================================
89 !> Initialize the task list, so it is ready to execute
90 !===============================================================================
91 SUBROUTINE initialize (self)
92  class(task_list_t):: self
93  !-----------------------------------------------------------------------------
94  call trace%begin ('task_list_t%initialize')
95  call self%init_bdries ! initialize boundaries, based on position
96  call self%init_all_nbors ! make nbor lists, based on position
97  call self%reset_status ! set status buts, based on nbor lists
98  call self%count_status ! count number of different tasks
99  call trace%end()
100 END SUBROUTINE initialize
101 
102 !===============================================================================
103 !> Find the smallest minimum level among the existing tasks. Note that this
104 !> routine runs before entering the task update parallel region.
105 !===============================================================================
106 SUBROUTINE init_levels (self)
107  class(task_list_t):: self
108  type(link_t), pointer:: link
109  logical:: first_time=.true.
110  integer:: levelmin, levelmax
111  !-----------------------------------------------------------------------------
112  call trace%begin ('task_list_t%init_levels')
113  call refine%init ! refinement parameters
114  !-----------------------------------------------------------------------------
115  ! Loop to find the initial level interval (e.g. due to fixed mesh refinement)
116  !-----------------------------------------------------------------------------
117  first_time = .true.
118  link => self%head
119  do while (associated(link))
120  associate(patch => link%task)
121  select type (patch)
122  class is (patch_t)
123  call patch%init_level
124  end select
125  if (first_time) then
126  first_time = .false.
127  levelmin = patch%level
128  levelmax = patch%level
129  else
130  levelmin = min(levelmin,patch%level)
131  levelmax = max(levelmax,patch%level)
132  end if
133  link => link%next
134  end associate
135  end do
136  !-----------------------------------------------------------------------------
137  ! If AMR is on, force levelmin to be the initial levelmin, and make sure
138  ! levelmax includes the initial levelmax
139  !-----------------------------------------------------------------------------
140  if (refine%on) then
141  refine%levelmin = levelmin
142  refine%levelmax = max(levelmax,refine%levelmax)
143  !-----------------------------------------------------------------------------
144  ! If AMR is off, set levelmin and levelmax to the initial values
145  !-----------------------------------------------------------------------------
146  else
147  refine%levelmin = levelmin
148  refine%levelmax = levelmax
149  end if
150  write (io%output,*) &
151  'task_list_t%init_levels: levelmin,max =', refine%levelmin, refine%levelmax
152  !-----------------------------------------------------------------------------
153  ! If more than one level is active, for check that guard zones are filled
154  !-----------------------------------------------------------------------------
155  if (refine%levelmax > refine%levelmin) &
156  download%check_filled = .true.
157  call self%init_levelstats
158  shared%levelmax = levelmax
159  call trace%end()
160 END SUBROUTINE init_levels
161 
162 !===============================================================================
163 !> Execute the task list, updating it until it is empty. With !$omp parallel here,
164 !> everything local to self%update is thread private.
165 !===============================================================================
166 SUBROUTINE startup (self)
167  class(task_list_t):: self
168  !.............................................................................
169  class(link_t), pointer:: link, rem
170  class(task_t), pointer:: task
171  real(8):: sec
172  integer:: dims(4)
173  integer, save:: itimer=0
174  logical:: was_refined
175  !-----------------------------------------------------------------------------
176  call trace%begin ('task_list_t%startup', itimer=itimer)
177  if (.not.self%dispatcher) call mpi%abort ("no dispatcher is used to execute the task list. Execution is unpredictable, therefore aborting.")
178  !-----------------------------------------------------------------------------
179  ! Initialize nbor lists and setting virtual and boundary bit should NOT be
180  ! done here, since at this point the task list may be a splice between the
181  ! task lists of several components, with nbor relations that should not be
182  ! overwritten. Each component should return a task list with appropriate
183  ! nbor lists, which may then be combined into a more comprehensive setup, with
184  ! special handling of nbor relations
185  !-----------------------------------------------------------------------------
186  !call self%init_bdries
187  !call self%init_all_nbors
188  !call self%reset_status
189  !-----------------------------------------------------------------------------
190  ! Must initialize refine before calling init_levels and task_mesg_t%init, but
191  ! after tasks with levels have been created and initialized
192  !-----------------------------------------------------------------------------
193  call refine%init
194  call self%init_levels
195  call self%task_mesg_t%init
196  call validate%init
197  !-----------------------------------------------------------------------------
198  ! When restarting, the virtual tasks need to be received and unpacked before
199  ! the first guard zone downloads. We therefore trigger a send of all bndry
200  ! patches, initialize the recv mechanism, and check for corresponding incoming
201  ! messages.
202  !-----------------------------------------------------------------------------
203  call self%task_mesg_t%init_virtual ()
204  if (io%restart >= 0) then
205  call self%resend_bdry ()
206  end if
207  !-----------------------------------------------------------------------------
208  ! Check the ready status of all tasks. At this point, virtual patches that
209  ! have not been received yet should have negative initial times, so should
210  ! prevent boundary tasks from trying to update.
211  !-----------------------------------------------------------------------------
212  call self%init_queue
213  !-----------------------------------------------------------------------------
214  ! Initialize the data I/O, and start timer
215  !-----------------------------------------------------------------------------
216  if (mpi%master) &
217  print '(a,f8.3,a)', ' Memory per process:', io%gb, ' GB'
218  call mpi%barrier ('self%execute')
219  call tic (time=sec)
220  call timer%print()
221  self%n_tasks = self%na
222  call trace%end (itimer)
223 END SUBROUTINE startup
224 
225 !===============================================================================
226 !> Initialize the queue
227 !===============================================================================
228 SUBROUTINE init_queue (self)
229  class(task_list_t):: self
230  class(link_t), pointer:: link
231  !-----------------------------------------------------------------------------
232  call trace%begin ('task_list_t%init_queue')
233  link => self%head
234  do while (associated(link))
235  call link%task%clear(bits%ready)
236  if (link%task%is_set(bits%virtual)) then
237  link%task%wc_last = wallclock()
238  else
239  call self%check_ready (link)
240  end if
241  if (self%sync_time > 0.0) &
242  link%task%sync_time = link%task%time + self%sync_time
243  link => link%next
244  end do
245  if (self%verbose > 0) &
246  call self%print_queue_times ('init_queue')
247  call trace%end()
248 END SUBROUTINE init_queue
249 
250 !===============================================================================
251 !> Execute the task list, updating it until it is empty. With !$omp parallel here,
252 !> everything local to self%update is thread private.
253 !===============================================================================
254 SUBROUTINE execute (self)
255  USE omp_timer_mod
256  class(task_list_t):: self
257  real(8):: sec
258  integer:: dims(4)
259  integer, save:: itimer=0
260  !-----------------------------------------------------------------------------
261  call trace%begin ('task_list_t%execute', itimer=itimer)
262  call self%startup
263  call tic (time=sec)
264  call timer%print()
265  !-----------------------------------------------------------------------------
266  ! Loop over tasks
267  !-----------------------------------------------------------------------------
268  !$omp parallel
269  do while (self%na > 0 .and. .not.io%do_stop)
270  call self%update (self%head, .false.)
271  end do
272  call timer%print()
273  call mpi_mesg%diagnostics(1)
274  write (io_unit%log,*) 'thread',omp%thread,' arrived'
275  flush (io_unit%log)
276  !$omp end parallel
277  call toc ('wall time', timer%n_update, time=sec)
278  call mpi%barrier ('end')
279  !if (io%master) &
280  ! write (io_unit%log,*) 'download_differ % =', 100.*download%n_differ/ &
281  ! max(1,(download%n_differ+download%n_same))
282  call trace%end (itimer)
283 END SUBROUTINE execute
284 
285 !===============================================================================
286 !> Common part of task list update, used by dispatchers
287 !===============================================================================
288 SUBROUTINE update (self, head, test, was_refined, was_derefined)
289  class(task_list_t):: self
290  class(link_t), pointer:: head
291  logical:: test
292  logical, optional:: was_refined, was_derefined
293  !.............................................................................
294  class(task_t), pointer:: task
295  real(8):: wc, levelstart
296  logical:: refined, derefined
297  integer, save:: itimer=0
298  !----------------------------------------------------------------------------
299  call trace%begin('task_list_t%update', itimer=itimer)
300  !-------------------------------------------------------------------------
301  ! Cost counter for AMR
302  !-------------------------------------------------------------------------
303  levelstart = wallclock()
304  task => head%task
305  call io%check_flags
306  if (task%id==io%id_track) then
307  task%track = .not.task%track
308  io%id_track = 0
309  end if
310  !---------------------------------------------------------------------------
311  ! If the task is frozen, make sure it is marked "not ready", and then return
312  !---------------------------------------------------------------------------
313  if (task%is_set (bits%frozen)) then
314  call task%clear (bits%ready)
315  call trace%end (itimer)
316  return
317  end if
318  !-----------------------------------------------------------------------------
319  ! Download nbor info -- this may be an experiment_t procedure, but if not,
320  !-- the call should be answered by a solver-specific procedure (which may or
321  ! may not choose to call the generic patch guard zone handler in tasks/).
322  ! Note that this needs to be done before the AMR refinement tests, for which
323  ! guard zones may be needed
324  !-----------------------------------------------------------------------------
325  if (.not.test) &
326  call task%dnload ! download nbor info
327  !-----------------------------------------------------------------------------
328  ! Check if refinement is needed on the task; if so this will push new tasks
329  ! onto the queue, with the same task time; i.e., to the head of the queue.
330  ! If the task is virtual, it will not be checked by this rank.
331  !-----------------------------------------------------------------------------
332  call refine%check_current(self, head, refined, derefined)
333  !-----------------------------------------------------------------------------
334  if (present(was_refined)) then
335  was_refined = refined
336  end if
337  if (present(was_derefined)) then
338  was_derefined = derefined
339  end if
340  !-----------------------------------------------------------------------------
341  ! If the task was derefined it does not exist, so bail out
342  !-----------------------------------------------------------------------------
343  if (derefined) then
344  call trace%end (itimer)
345  return
346  end if
347  !-----------------------------------------------------------------------------
348  ! Update the task, whatever that means (may include call to task%output)
349  !-----------------------------------------------------------------------------
350  if (mpi_mesg%delay_ms==0.0) then
351  wc = wallclock()
352  end if
353  task%rotated = .false.
354  if (test) then
355  call task%test_update
356  else
357  select type (task)
358  class is (patch_t)
359  call validate%check (head, task%mem(:,:,:,task%idx%d,task%it,1), 'before update')
360  end select
361  !---------------------------------------------------------------------------
362  ! IMPORTANT: The globally available io%ntask must reflect the total number
363  ! of active tasks on the rank (io%nwrite is set in data_io_mod)
364  !---------------------------------------------------------------------------
365  !$omp atomic write
366  io%ntask = self%na ! Authoritative !
367  !---------------------------------------------------------------------------
368  call task%update ! update the task
369  if (self%verbose > 0) then
370  associate(unit => merge(io_unit%log, io_unit%mpi, self%verbose > 1))
371  write (unit,'(f12.6,2x,a,i6,1p,g14.6)') &
372  wallclock(), 'update:', task%id, task%time+task%dtime
373  flush (unit)
374  end associate
375  end if
376  end if
377  !----------------------------------------------------------------------------
378  ! Default delay time = 10% of first update time
379  !----------------------------------------------------------------------------
380  if (mpi_mesg%delay_ms==0.0) then
381  !$omp atomic write
382  mpi_mesg%delay_ms = 1d3*(wallclock()-wc)*0.1
383  end if
384  !$omp atomic
385  mpi_mesg%n_update = mpi_mesg%n_update+1
386  if (self%verbose>1) &
387  write (io_unit%log,'(a,i4,2x,a,i7,2x,a,2x,a,i7,2x,a,1p,2g14.6,2x,a,2i5,l3)') &
388  'thread', omp_mythread, 'task', task%id, trim(task%type), &
389  'step', task%istep, 'dt, time:', task%dtime, task%time, &
390  'n, nq', self%n, self%nq, associated(head%nbor)
391  !-----------------------------------------------------------------------------
392  ! The rotate procedure in the generic patch_t module is responsible for
393  ! updating the time, and rotating the memory slots where information about
394  ! previous time steps are saved. Task may signal that they have already done
395  ! the rotate internally, or else are not yet ready to do so, by setting the
396  ! task%rotated flag
397  !-----------------------------------------------------------------------------
398  if (.not.task%rotated) then
399  call task%rotate
400  end if
401  select type (task)
402  class is (experiment_t)
403  call validate%check (head, task%mem(:,:,:,task%idx%d,task%it,1), ' after update')
404  call task%info (self%nq, self%na) ! print info on stdout
405  end select
406  if (io%log_sent > 0) then
407  !$omp critical (log_sent_cr)
408  call mpi_mesg%log_files ()
409  write (io_unit%sent,'(f16.6,i4,2x,a,i6,f16.6,l5)') &
410  wallclock(), omp%thread, 'upd', task%id, task%time, task%is_set(bits%boundary)
411  flush (io_unit%sent)
412  !$omp end critical (log_sent_cr)
413  end if
414  !-----------------------------------------------------------------------------
415  ! If the task is a boundary patch, first check if it should be given to
416  ! another rank. A patch that has been given to another rank becomes
417  ! a virtual patch, and the load balance procedure has already sent those
418  ! of its nbors that became new boundary patches over to relevant ranks,
419  ! while the patch itself is sent here, with bits%virtual+swap_reqest set.
420  !-----------------------------------------------------------------------------
421  if (task%is_set(bits%boundary)) then ! boundary patch?
422  head%task%nq = self%nq ! make sure to pass on
423  if (load_balance%check_load (head)) then ! sell?
424  call self%count_status ! cheap & robust overkill
425  end if
426  if (task%id == io%id_debug) &
427  write(io_unit%mpi,*) &
428  'DBG task_list_t%update: calling send_to_vnbors', task%id
429  call task%log ('send')
430  call self%send_to_vnbors (head) ! send to virtual nbors
431  end if
432  !-----------------------------------------------------------------------------
433  ! If the task has bits%init_nbors set, call init_nbors(), which also clears
434  ! the bit
435  !-----------------------------------------------------------------------------
436  if (task%is_set (bits%init_nbors)) then
437  call self%init_nbors (head)
438  call self%check_ready (head)
439  if (self%verbose > 1) then
440  call head%info
441  else if (self%verbose > 0) then
442  write (io_unit%log,*) 'task_list_t%update: init_nbors for task', task%id
443  end if
444  end if
445  !-----------------------------------------------------------------------------
446  ! Tasks that have finished are subtracted from the task list count but are
447  ! not removed, since their data may be needed by other tasks (including on
448  ! other ranks). In principle it should not be necessary to put a finished
449  ! task back into the ready queue, since it has a time > end_time, and thus
450  ! should not be able to stop another task from being considered ready.
451  !-----------------------------------------------------------------------------
452  if (task%has_finished()) then ! just finished:
453  !---------------------------------------------------------------------------
454  ! Record the time when the first task finishes, and at dead_mans_hand time
455  ! after that force the active task count to zero, which triggers job end
456  !---------------------------------------------------------------------------
457  if (first_finished == 0.0) then
458  !$omp atomic write
459  first_finished = wallclock() ! cf. dispatcher
460  else if (wallclock() > first_finished+dead_mans_hand) then
461  call dead_mans_hand_list (self)
462  self%na = 0
463  end if
464  call load_balance%active (.false.) ! turn off load balancing
465  !---------------------------------------------------------------------------
466  ! Use bits%frozen to make sure the task only decrements from self%na once
467  !---------------------------------------------------------------------------
468  if (task%is_clear (bits%frozen)) then
469  call task%set (bits%frozen)
470  call self%count_status ('has_finished') ! TEST
471  if (self%verbose > 0) then
472  write (io_unit%log,*) task%id, 'has finished, na =', self%na
473  flush (io_unit%log)
474  end if
475  end if
476  end if
477  if (task%time > io%end_time .and. task%is_clear(bits%frozen)) then
478  print *, mpi%rank, omp%thread, 'ERROR: task should be frozen', &
479  task%time, io%end_time, task%is_set(bits%frozen), task%has_finished()
480  call task%set (bits%frozen)
481  end if
482  !-----------------------------------------------------------------------------
483  ! Periodic task syncronization: The first time a task%time is exactly equal
484  ! to load_balance%sync_next, we wait for all ranks to arrive at the same
485  ! time. All tasks within a rank are then also at this time, since as long as
486  ! one has not arrived there yet, the head%ask%time is smaller.
487  !-----------------------------------------------------------------------------
488  if (self%syncing) then
489  write (io_unit%mpi,*) task%id,omp%thread, &
490  ' is waiting on a sync at t =', self%sync_next
491  !call trace%end; call trace%begin ('mpi%barrier', itimer=itimer)
492  call mpi%barrier ('sync')
493  !call trace%end (itimer); call trace%begin('dispatcher0_t%update')
494  write (io_unit%mpi,*) task%id,omp%thread, &
495  ' finished wating on a sync at t =', self%sync_next
496  self%sync_next = self%sync_next + self%sync_time
497  self%syncing = .false.
498  end if
499  task%sync_time = self%sync_next
500  !-----------------------------------------------------------------------------
501  ! AMR level cost
502  !-----------------------------------------------------------------------------
503  if (.not.was_derefined) then
504  !$omp atomic
505  timer%levelcost(task%level) = &
506  timer%levelcost(task%level) + (wallclock() - levelstart)
507  end if
508  call trace%end (itimer)
509 END SUBROUTINE update
510 
511 !===============================================================================
512 !> List remaining tasks when dead_mans_hand time interval has expired
513 !===============================================================================
514 SUBROUTINE dead_mans_hand_list (self)
515  class(task_list_t):: self
516  class(link_t), pointer:: link
517  !-----------------------------------------------------------------------------
518  write (stderr,*) 'Updates stopped after expired dead_mans_hand time!'
519  write (stderr,*) 'Active tasks remaining:', self%na
520  link => self%head
521  do while (associated(link))
522  write (stderr,*) 'task id, time =', link%task%id, link%task%time
523  link => link%next
524  end do
525  write (stderr,*) 'tasks in garbage:'
526  link => garbage%next
527  do while (associated(link))
528  write (stderr,*) 'task id, time =', &
529  link%task%id, link%task%time, link%task%n_needed
530  link => link%next
531  end do
532 END SUBROUTINE dead_mans_hand_list
533 
534 !===============================================================================
535 !> Average over a variable with index idx
536 !===============================================================================
537 FUNCTION average (self, idx, time)
538  class(task_list_t):: self
539  integer:: idx
540  real(8):: average, time
541  !.............................................................................
542  class(link_t) , pointer:: link
543  class(task_t) , pointer:: task
544  real(8), dimension(:,:,:), allocatable:: buffer
545  integer:: n, m(3), jt(2), l(3), u(3)
546  real:: pt(2)
547  !-----------------------------------------------------------------------------
548  ! Compute smallest time on the list
549  !-----------------------------------------------------------------------------
550  call trace%begin ('task_list_t%average')
551  link => self%head
552  time = link%task%time
553  do while (associated(link))
554  time = min(time, link%task%time)
555  link => link%next
556  end do
557  !-----------------------------------------------------------------------------
558  ! Interpolate to that time and sum up averages
559  !-----------------------------------------------------------------------------
560  link => self%head
561  n = 0
562  average = 0d0
563  do while (associated(link))
564  task => link%task
565  select type (task)
566  class is (patch_t)
567  m = task%ncell
568  l = task%li
569  u = l + m - 1
570  call task%time_interval (time, jt, pt)
571  if (.not.allocated(buffer)) &
572  allocate (buffer(m(1),m(2),m(3)))
573  buffer = task%mem(l(1):u(1),l(2):u(2),l(3):u(3),idx,jt(1),1)*pt(1) &
574  + task%mem(l(1):u(1),l(2):u(2),l(3):u(3),idx,jt(2),1)*pt(2)
575  average = average + sum(buffer)
576  n = n+1
577  !print '(5i5,2f8.5,3f12.6,1p,e12.4)', idx, n, task%id, jt, pt, task%t(jt(1)), time, task%t(jt(2)), average
578  end select
579  link => link%next
580  end do
581  average = average/n/product(shape(buffer))
582  call trace%end()
583 END FUNCTION average
584 
585 !===============================================================================
586 !> Append a task list to self
587 !===============================================================================
588 SUBROUTINE append_task_list (self, task_list)
589  class(task_list_t):: self
590  class(task_list_t), pointer:: task_list
591  class(list_t), pointer:: list
592  !-----------------------------------------------------------------------------
593  call trace%begin ('task_list_t%append_task_list')
594  list => task_list
595  call self%append_list (list)
596  call trace%end()
597 END SUBROUTINE append_task_list
598 
599 !===============================================================================
600 !> Print a table with task id and all neighbors
601 !===============================================================================
602 SUBROUTINE print1 (self, label)
603  class(task_list_t):: self
604  character(len=*), optional:: label
605  class(link_t) , pointer:: link, nbor
606  !.............................................................................
607  call trace%begin ('task_list_t%print_tasklist')
608  if (io%master.and.present(label)) write (io_unit%output,*) label
609  link => self%head
610  do while (associated(link))
611  call link%print_nbors ('')
612  link => link%next
613  end do
614  call self%print_queue
615  call trace%end()
616 END SUBROUTINE print1
617 
618 !===============================================================================
619 !> Upgrade task pointer to experiment level
620 !===============================================================================
621 FUNCTION task2experiment (task) RESULT (exper)
622  class(task_t), pointer:: task
623  class(experiment_t), pointer:: exper
624  !...........................................................................
625  select type (task)
626  class is (experiment_t)
627  exper => task
628  end select
629 END FUNCTION task2experiment
630 
631 !===============================================================================
632 !> Initialize level statistics, making sure to only do it once. Note that, by
633 !> placing the allocation of levelcost last, threads are encouraged to get
634 !> caught on this critical region until everything is ready.
635 !===============================================================================
636 SUBROUTINE init_levelstats (self)
637  class(task_list_t):: self
638  class(link_t), pointer:: link
639  !-----------------------------------------------------------------------------
640  call trace%begin ('task_list_t%init_levelstats')
641  !$omp critical (levelstat_cr)
642  if (.not. allocated(timer%levelcost)) then
643  allocate (timer%levelpop (refine%levelmin:refine%levelmax))
644  timer%levelmin = refine%levelmin
645  timer%levelmax = refine%levelmax
646  timer%levelpop = 0
647  link => self%head
648  do while (associated(link))
649  !$omp atomic update
650  timer%levelpop(link%task%level) = &
651  timer%levelpop(link%task%level) + 1
652  !$omp end atomic
653  link => link%next
654  end do
655  allocate (timer%levelcost(refine%levelmin:refine%levelmax))
656  timer%levelcost = 0d0
657  end if
658  !$omp end critical (levelstat_cr)
659  call trace%end()
660 END SUBROUTINE init_levelstats
661 
662 !===============================================================================
663 !> Initialize a task list pointer in each task
664 !===============================================================================
665 SUBROUTINE init_task_list_pointers (self, task_list)
666  class(task_list_t):: self
667  type(task_list_t), pointer:: task_list
668  class(list_t), pointer:: list
669  class(link_t), pointer:: link
670  !-----------------------------------------------------------------------------
671  ! Store a copy of the task list pointer in each task (generically in gpatch_t)
672  !-----------------------------------------------------------------------------
673  call trace%begin ('task_list_t%init_task_list_pointers')
674  list => task_list
675  link => self%head
676  do while (associated(link))
677  associate(task=>link%task)
678  select type (task)
679  class is (experiment_t)
680  call task%init_task_list (list)
681  end select
682  end associate
683  link => link%next
684  end do
685  call trace%end()
686 END SUBROUTINE
687 
688 END MODULE task_list_mod
Each thread uses a private timer data type, with arrays for start time and total time for each regist...
Definition: timer_mod.f90:11
download_link: takes care of downloads to linktask same: called for patches on the same level differ:...
Support tic/toc timing, as in MATLAB, and accurate wallclock() function. The timing is generally much...
Generic validation module. The general idea is to be able to compare two runs at critical points in t...
Module with list handling for generic class task_t objects.
Definition: list_mod.f90:4
Template module for patches, which adds pointers to memory and mesh, and number of dimensions and var...
Definition: patch_mod.f90:6
This module handles checking max change between neighboring points. Each instance of it needs an inde...
Definition: refine_mod.f90:168
This module is a placeholder for shared information, solving the problem of making a piece of informa...
Definition: shared_mod.f90:7
Message handling for task lists. Some of the methods are only used by dispatcher0_t, so should perhaps be moved over to that file.
Task list data type, with methods for startup and updates. Message handling is inherited from the tas...
Definition: io_mod.f90:4
Keep track of neighbor ranks and their loads, by sending and receiving short messages, storing the info in a linked list.
Template module for tasks.
Definition: task_mod.f90:4