DISPATCH
task_mod.f90
1 !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
2 !> Template module for tasks.
3 !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
4 MODULE task_mod
5  USE io_mod
6  USE omp_mod
7  USE omp_lock_mod
8  USE omp_timer_mod
9  USE timer_mod
10  USE mpi_mod
11  USE bits_mod
12  USE trace_mod
13  USE mpi_mesg_mod
14  USE random_mod
15  USE dll_mod
16  USE aux_mod
17  implicit none
18  private
19  !-----------------------------------------------------------------------------
20  ! Basic task info
21  !-----------------------------------------------------------------------------
22  type, public:: task_t
23  integer:: id = 0
24  integer:: status = 0
25  integer:: rank = 0
26  integer:: n_check = 0
27  integer:: n_nbors = 0
28  integer:: istep = 0
29  integer:: iout = 0
30  integer:: level = 0
31  integer:: nt=0
32  integer:: it=1
33  integer:: new=2
34  integer:: verbose=1
35  integer:: nq=999
36  integer:: n_behind=0
37  integer:: restart=-9
38  integer:: state=0
39  integer:: parentid=0
40  integer:: thread=-1
41  integer:: mem_thread=-1
42  integer:: n_dump=0 ! number of dump files
43  integer:: ip ! rank local task id
44  integer:: n_needed=1 ! number of tasks that needs it
45  integer:: seq=0 ! incremental sequence number
46  integer:: n_failed ! number of times check_ready() failed
47  integer:: logging=0 ! level of logging
48  real(8):: time = 0d0
49  real(8):: atime = 0d0 ! for active queue
50  real(8):: out_next = 0d0
51  real(8):: print_next = 0d0
52  real(8):: dtime = 0d0
53  real(8):: min_dtime = 0d0
54  real(4):: grace = 0.0
55  real(8):: position(3) = 0d0
56  real(8):: origin(3)=0d0 ! the cartesian box origin (for BCs)
57  real(8):: velocity(3) = 0d0 ! velocity of task in Cartesian coords.
58  real(8):: size(3) = 0.9999d0
59  real(8):: gsize(3) ! convenience
60  real(8):: ds(3) ! convenience
61  real(8):: box(3)=1d0 ! the periodic wrapping size
62  real(8):: wallclock
63  real(8):: unpack_time=0d0
64  real(8):: dnload_time=-1d0 ! last dnload time
65  real(4):: quality = 0.0
66  integer, dimension(:), pointer:: iit => null()
67  real(8), dimension(:), pointer:: t => null()
68  real(8), dimension(:), pointer:: dt => null()
69  character(len=64), pointer:: name => null()
70  class(task_t), pointer:: parent => null()
71  class(mesg_t), pointer:: mesg => null()
72  character(len=64):: kind='task' ! solver name
73  character(len=12):: type='task_t' ! task type
74  real:: latency=0.0 ! MPI message latency
75  real(8):: wc_last=0.0_8
76  real(8):: sync_time=0d0
77  real(8):: update_last=0.0_8
78  real:: update_cadence=0.0
79  logical:: syncing=.false.
80  logical:: track=.false.
81  logical:: periodic(3)=.true.
82  logical:: rotated=.false.
83  logical:: limit_dtime=.false.
84  type(lock_t), pointer:: lock ! OMP lock
85  type(random_t):: random ! pseudo-random number generator
86  type(aux_t):: aux
87  integer(8):: amr_offset=0_8 ! byte offset in amr_io
88  contains
89  procedure:: init
90  procedure:: init_unique
91  procedure:: dealloc
92  procedure:: dnload
93  procedure:: update => void
94  procedure:: rotate
95  procedure:: info
96  procedure:: timeslots
97  procedure:: is_ahead_of
98  procedure:: set
99  procedure:: clear
100  procedure:: print
101  procedure:: is_set
102  procedure:: is_clear
103  procedure:: allocate => void
104  procedure:: allocate_mesg => void
105  procedure:: unique_id
106  procedure:: load_balance
107  procedure:: has_finished
108  procedure:: overlaps
109  procedure:: overlaps_point
110  procedure:: nbor_relations
111  procedure:: distance
112  procedure:: point_distance
113  procedure:: pack
114  procedure:: unpack
115  procedure:: is_relevant
116  procedure:: test_update
117  procedure:: solver_is
118  procedure:: debug
119  procedure:: task_info
120  procedure:: log
121  end type
122  integer, dimension(:), pointer, save:: id => null()
123  type(dll_t), pointer:: deleted_list
124 CONTAINS
125 
126 !===============================================================================
127 SUBROUTINE void (self)
128  class(task_t):: self
129  print*, 'ERROR: task_t%void called'
130 END SUBROUTINE void
131 
132 !===============================================================================
133 SUBROUTINE dnload (self, only)
134  class(task_t):: self
135  integer, optional:: only
136  call mpi%abort('ERROR: task_t%dnload called')
137 END SUBROUTINE dnload
138 
139 !===============================================================================
140 !> Define unique task id, unless already set before entry.
141 !===============================================================================
142 SUBROUTINE init (self)
143  class(task_t):: self
144  character(len=120):: ids= &
145  '$Id: 06556f02c9614987d5f9540daef1921ce5eaa169 $ tasks/task_mod.f90'
146  !-----------------------------------------------------------------------------
147  call trace_begin ('task_t%init')
148  call trace%print_id (ids)
149  if (self%id == 0) then
150  call init_unique (self)
151  end if
152  allocate (self%lock)
153  call self%lock%init (self%kind(1:4), id=self%id+2)
154  call self%random%init
155  call trace_end ()
156 END SUBROUTINE init
157 
158 !===============================================================================
159 !> Define unique patch ids. A critical region is OK; this is only done once.
160 !===============================================================================
161 SUBROUTINE init_unique (self, same)
162  class(task_t):: self
163  logical, optional:: same
164  integer:: id
165  integer, save:: id_same=0
166  !-----------------------------------------------------------------------------
167  ! Ranks that call this routine in sync with same=.true. get a matching set
168  ! of IDs to prune from, while the master updates the global counter
169  !-----------------------------------------------------------------------------
170  call trace_begin ('task_t%init_unique')
171  if (present(same) .and. same) then
172  !$omp atomic capture
173  id_same = id_same+1
174  id = id_same
175  !$omp end atomic
176  if (mpi%rank==0) then ! on the master rank ..
177  mpi%id%i = id+1 ! .. update the mpi%id counter directly
178  end if
179  if (io%verbose > 0) &
180  write (io_unit%log,*) 'task_t%init_unique(same): mpi%id, id =', id_same, id
181  !-----------------------------------------------------------------------------
182  ! Calls without the same option return unique IDs, which do not overlap with
183  ! matching set of IDs
184  !-----------------------------------------------------------------------------
185  else
186  id = mpi%id%update (1)
187  if (io%verbose > 0) &
188  write (io_unit%log,*) 'task_t%init_unique(else): mpi%id, id =', id_same, id
189  end if
190  self%id = id
191  call trace%end ()
192 END SUBROUTINE init_unique
193 
194 !===============================================================================
195 !> Deallocate permanent arrays
196 !===============================================================================
197 SUBROUTINE dealloc (self)
198  class(task_t):: self
199  !.............................................................................
200  call trace_begin ('task_t%dealloc')
201  if (associated(self%t )) deallocate (self%t )
202  if (associated(self%dt )) deallocate (self%dt )
203  if (associated(self%iit)) deallocate (self%iit)
204  if (associated(self%mesg)) deallocate (self%mesg)
205  call trace_end
206 END SUBROUTINE dealloc
207 
208 !===============================================================================
209 !> Save the id of a deleted task, for resuse
210 !===============================================================================
211 SUBROUTINE save_id (self)
212  class(task_t):: self
213  !.............................................................................
214  class(dll_node_t), pointer:: node
215  integer, pointer:: id
216  !-----------------------------------------------------------------------------
217  call trace_begin ('task_t%save_id')
218  if (.not.associated(deleted_list%head)) then
219  call deleted_list%init
220  end if
221  allocate (node, id)
222  id = self%id
223  node%car => id
224  call deleted_list%append (node)
225  call trace_end
226 END SUBROUTINE save_id
227 
228 !===============================================================================
229 !> Rotate time slots. The initial conditions are in slot 1, and the first time
230 !> step puts new values in the 'new' slot 2, while saving the time step used in
231 !> dt(1). Then the current slot (it) becomes 2, and the new one becomes 3, etc.
232 !> This way, there is no need to copy memory btw time steps.
233 !===============================================================================
234 SUBROUTINE rotate (self)
235  class(task_t):: self
236  integer:: iv, nv, new, i
237  real(8):: time
238  integer, save:: itimer=0
239  real(8), pointer:: rptr
240  integer, pointer:: iptr
241  !-----------------------------------------------------------------------------
242  ! Implement setting of per-patch parameters here
243  !-----------------------------------------------------------------------------
244  if (io%processing > 0d0) then
245  if (io%out_next > 0.0) self%out_next = io%out_next
246  if (io%grace > 0.0) self%grace = io%grace
247  end if
248  if (self%rotated) return
249  call trace_begin ('task_t%rotate',itimer=itimer)
250  call self%log ('rotate', 3)
251  !-----------------------------------------------------------------------------
252  ! Call timestep update procedure to fill the next time slot with values
253  !-----------------------------------------------------------------------------
254  if (io%verbose > 1) then
255  write (io_unit%log,'(a,7i10)') 'task_t%rotate iit =', self%iit
256  flush (io_unit%log)
257  end if
258  if (omp_lock%tasks) then
259  call self%lock%set ('rotate')
260  end if
261  !-----------------------------------------------------------------------------
262  ! If this task has self%syncing set, then the time step has been set so as to
263  ! arrive exactly ast sync_time. To precent problems with round-off we set the
264  ! time exactly.
265  !-----------------------------------------------------------------------------
266  if (self%syncing) then
267  time = self%sync_time
268  self%syncing = .false.
269  if (io%verbose>2) &
270  write (io_unit%mpi,*) 'task_t%rotate:: turning off syncing for now', self%id
271  else
272  time = self%time + self%dtime
273  end if
274  !-----------------------------------------------------------------------------
275  ! Time slot rotation. Note that self%time should be the LAST of these
276  ! updates, since we do not want to enforce a critical region, and the
277  ! new self%time is what a task is judged on! Also, note that the only time
278  ! slot information accessed from other tasks is self%it, self%time, self%iit,
279  ! self%t(iit(1:nt-1)), and self%dt(iit(1:nt-1)). The iit((nt) entries are
280  ! not accessed.
281  !-----------------------------------------------------------------------------
282  rptr => self%dt(self%it)
283  !$omp atomic write
284  rptr = self%dtime ! just updated
285  self%dt(self%new)= self%dtime ! next estimate
286  self%t(self%new) = time ! initial time
287  new = self%new
288  !$omp atomic write
289  self%it = new ! update time slot, new
290  new = mod(new,self%nt)+1 ! increment / rotate
291  associate(snew=>self%new)
292  !$omp atomic write
293  snew = new
294  end associate
295  do i=1,self%nt-1
296  iptr => self%iit(i)
297  !$omp atomic write
298  iptr = self%iit(i+1)
299  end do
300  iptr => self%iit(self%nt)
301  !$omp atomic write
302  iptr = self%new ! new right-most slot
303  !$omp atomic update
304  self%istep = self%istep + 1
305  !$omp atomic write
306  self%time = time
307  if (io%verbose>2) &
308  write (io_unit%log,*) 'task id:',self%id,' it:',self%it,' new:',self%new
309  if (io%verbose>3) &
310  write (io_unit%log,*) 'task iit:', self%iit
311  if (io%verbose>3) &
312  write (io_unit%log,*) 'task t(iit):', self%t(self%iit)
313  nullify (rptr, iptr)
314  self%rotated = .true.
315  if (omp_lock%tasks) then
316  call self%lock%unset ('rotate')
317  end if
318  call trace_end (itimer)
319 END SUBROUTINE rotate
320 
321 !===============================================================================
322 !> Print info to stdout
323 !===============================================================================
324 SUBROUTINE info (self, nq, ntask, experiment_name)
325  class(task_t):: self
326  integer, optional:: nq, ntask
327  character(len=64), optional:: experiment_name
328  !.............................................................................
329 END SUBROUTINE info
330 
331 !===============================================================================
332 !> Get timeslot info atomically. Note that, while the thread updating the task
333 !> set the time and dtime of slot (nt) which, in terms of the indices retrieved
334 !> here is outside the range of concern, in rare cases it may be updated again,
335 !> in which case it will access the current slot (1) the next time, then (2)
336 !> and so on; therefore, it is prudent to use a task lock shared with rotate
337 !===============================================================================
338 SUBROUTINE timeslots (self, slots, times)
339  class(task_t):: self
340  real(8):: times(self%nt-1)
341  integer:: slots(self%nt-1)
342  integer:: i, j, it
343  !-----------------------------------------------------------------------------
344  !$omp atomic read
345  it = self%it
346  do j=1,self%nt-1
347  i = 1 + mod(j+it,self%nt)
348  if (j < self%nt-self%istep) then
349  i = 1
350  end if
351  slots(j) = i
352  !$omp atomic read
353  times(j) = self%t(i)
354  end do
355 END SUBROUTINE timeslots
356 
357 !===============================================================================
358 !> Check if self (which is a nbor task) is ahead of target (which is the one to
359 !> possibly move to the ready queue), using self%dtime*target%grace as the grace
360 !> period, since we want to limit the extrapolation in the nbor task to at most
361 !> target%grace*self%dtime.
362 !===============================================================================
363 LOGICAL FUNCTION is_ahead_of (self, target)
364  class(task_t):: self, target
365  real(8):: nbtime, nbdtime
366  !.............................................................................
367  !$omp atomic read
368  nbtime = self%time
369  !$omp atomic read
370  nbdtime = self%dtime
371  ! -- if a task is frozen (in time) assume it is forever ahead of other tasks
372  if (self%is_set(bits%frozen)) then
373  is_ahead_of = .true.
374  ! -- a negative nbor time signals an invalid (e.g. initial RT) state
375 ! else if (nbtime < 0.0) then
376 ! is_ahead_of = .false.
377  ! -- do not use a grace interval for the first few steps
378  else if (self%istep < 3) then
379  is_ahead_of = nbtime >= target%time
380  ! -- use a grace interval that is fraction of the nbor time step
381  else
382  is_ahead_of = nbtime + nbdtime*self%grace > target%time
383  end if
384  if (io_unit%verbose>1) then
385  if (target%id==io%id_debug.or.io_unit%verbose>4) &
386  print'(i6,i4,2x,a,i6,3f9.5,l3)', self%id, omp_mythread, 'mk is_ahead_of: ', &
387  target%id, self%time, self%dtime*target%grace, target%time, is_ahead_of
388  end if
389 END FUNCTION
390 
391 SUBROUTINE print (self)
392  class(task_t):: self
393 END SUBROUTINE
394 
395 !===============================================================================
396 !> Set status bits
397 !===============================================================================
398 SUBROUTINE set (self, bits)
399  class(task_t):: self
400  integer:: bits
401  !.............................................................................
402 ! call trace_begin ('task_t%set')
403  !$omp atomic
404  self%status = ior(self%status, bits)
405 !write (io_unit%log,'(f12.6,3x,a,i6,z8)') wallclock(), 'set bit', self%id, bits
406 ! call trace_end
407 END SUBROUTINE
408 
409 !===============================================================================
410 !> Clear status bits
411 !===============================================================================
412 SUBROUTINE clear (self, bits)
413  class(task_t):: self
414  integer:: bits
415  !.............................................................................
416 ! call trace_begin ('task_t%clear')
417  !$omp atomic
418  self%status = iand(self%status, not(bits))
419 !write (io_unit%log,'(f12.6,3x,a,i6,z8)') wallclock(), 'clr bit', self%id, bits
420 ! call trace_end
421 END SUBROUTINE
422 
423 !===============================================================================
424 !> Check if ANY of the bits is set (argument can be sum of bits)
425 !===============================================================================
426 LOGICAL FUNCTION is_set (self, bits)
427  class(task_t):: self
428  integer:: bits, status
429  !.............................................................................
430 ! call trace_begin ('task_t%is_set')
431  !$omp atomic read
432  status = self%status
433  is_set = (iand(status, bits) /= 0)
434 ! call trace_end
435 END FUNCTION
436 
437 !===============================================================================
438 !> Check that ALL bits are clear (argument can be sum of bits)
439 !===============================================================================
440 LOGICAL FUNCTION is_clear (self, bits)
441  class(task_t):: self
442  integer:: bits, status
443  !.............................................................................
444 ! call trace_begin ('task_t%is_clear')
445  !$omp atomic read
446  status = self%status
447  is_clear = (iand(status, bits) == 0)
448 ! call trace_end
449 END FUNCTION
450 
451 !===============================================================================
452 LOGICAL FUNCTION has_finished (self)
453  class(task_t):: self
454  integer:: bit
455  !.............................................................................
456  has_finished = (self%time > io%end_time)
457 END FUNCTION
458 
459 !===============================================================================
460 FUNCTION unique_id (self)
461  class(task_t):: self
462  integer:: unique_id
463  !$omp atomic
464  id(self%rank) = id(self%rank) + mpi%size
465  unique_id = id(self%rank)
466 END FUNCTION unique_id
467 
468 !===============================================================================
469 !> The load balancing procedure is part of the negotiation between a patch and
470 !> its virtual neighbors. We use the pro-active approach, where the decision
471 !> to migrate to a different rank is taken by the task itself. It can then be
472 !> implemented with a minimum of complication, in that one of the last things
473 !> the task does before broadcasting itself to its neighbors is to change its
474 !> rank. The new rank should check if an incoming virtual patch in fact has
475 !> opted to become a boundart patch instead. It comes with a complete list of
476 !> neighbors already.
477 !>
478 !> To decide whether to migrate to another rank, the following parameters should
479 !> be considered, for both tasks:
480 !>
481 !> task%load : the load of the task, in milliseconds per update
482 !> task%dt : the time step per update
483 !> task%time : the current time of the task
484 !> rank%time : the current time of the neighbor rank
485 !> rank%surplus : the extra capacity available on the nbor rank
486 !>
487 !> If the time difference (rank%time-task%time)/task%dt is positive it means
488 !> that even the most delayed task on the other rank is ahead of the current
489 !> task, which speaks in favor of migrating.
490 !>
491 !> If the nbor rank has extra capacity, this also speaks in favor of migration
492 !>
493 !> A good measure of the load of a rank is the number of wall clock seconds per
494 !> simulation time unit. This can be computed by running through the list of
495 !> tasks on the rank, adding for each task its cost in ms/time_unit, and finally
496 !> dividing by the number of (real) cores available to work on the tasks.
497 !===============================================================================
498 SUBROUTINE load_balance (self)
499 class(task_t):: self
500 
501 END SUBROUTINE load_balance
502 
503 !===============================================================================
504 !> Check if there is overlap, using the size plus an extra cell margin. The
505 !> definition of overlap MUST be symmetric, since it is being used to define
506 !> neighbor relations.
507 !>
508 !> NOTE 1: This function was in the past NOT used by e.g. list_t%init_nbors, which
509 !> was instead using list_t%overlaps, based on the same criterion as below.
510 !>
511 !> NOTE 2: Since overlap and nbors can have a generalized definition it makes
512 !> sense that is valid for the whole task_t class. If needed, the definition
513 !> can be overloaded with alternative definitions for particular tasks.
514 !===============================================================================
515 FUNCTION overlaps (self, task)
516  class(task_t):: self
517  class(task_t):: task
518  logical:: overlaps
519  integer:: itimer=0
520  !.............................................................................
521  if (timer%detailed) &
522  call trace%begin ('task_t%overlaps', 2, itimer=itimer)
523  overlaps = all(abs(distance(self,task)) <= 0.5_8*(self%size+task%size+self%ds+task%ds))
524  if (timer%detailed) &
525  call trace%end (itimer)
526 END FUNCTION overlaps
527 
528 !===============================================================================
529 !> Check if point p overlaps with the internal region of self
530 !===============================================================================
531 FUNCTION overlaps_point (self, p)
532  class(task_t):: self
533  real(8):: p(3), d(3)
534  logical:: overlaps_point
535  !.............................................................................
536  call trace%begin ('task_t%overlaps', 2)
537  d = self%point_distance (self%position, p)
538  overlaps_point = all(abs(d) < self%size*0.5d0)
539  call trace%end ()
540 END FUNCTION overlaps_point
541 
542 !===============================================================================
543 !> Decide if another task is needed, if it needs_me, and if it should be
544 !> downloaded (= used in one way or another to prepare the task for update)
545 !===============================================================================
546 SUBROUTINE nbor_relations (self, another, needed, needs_me, download)
547  class(task_t):: self
548  class(task_t), pointer:: another
549  logical:: needed, needs_me, download
550  integer, save:: itimer=0
551  !-----------------------------------------------------------------------------
552  if (timer%detailed) &
553  call trace%begin ('task_t%nbor_relations', 2, itimer=itimer)
554  !-----------------------------------------------------------------------------
555  ! task is real
556  !-----------------------------------------------------------------------------
557  if (self%rank == mpi%rank) then
558  !---------------------------------------------------------------------------
559  ! nbor is frozen
560  !---------------------------------------------------------------------------
561  if (another%is_set (bits%frozen)) then
562  needs_me = .false.
563  needed = .false.
564  !---------------------------------------------------------------------------
565  ! nbor is virtual
566  !---------------------------------------------------------------------------
567  else if (another%rank /= mpi%rank) then
568  call self%set(bits%boundary)
569  call self%clear(bits%internal)
570  ! -- use in check_ready(), but not in check_nbors()
571  needed = .true.
572  needs_me = .false.
573  !---------------------------------------------------------------------------
574  ! nbor is real
575  !---------------------------------------------------------------------------
576  else
577  ! -- use in check_ready(), and in check_nbors()
578  needed = .true.
579  needs_me = .true.
580  end if
581  !---------------------------------------------------------------------------
582  ! real tasks need guard zones
583  !---------------------------------------------------------------------------
584  download = .true.
585  !-----------------------------------------------------------------------------
586  ! task is virtual
587  !-----------------------------------------------------------------------------
588  else
589  !---------------------------------------------------------------------------
590  ! nbor is frozen
591  !---------------------------------------------------------------------------
592  if (another%is_set (bits%frozen)) then
593  needs_me = .false.
594  needed = .false.
595  !---------------------------------------------------------------------------
596  ! task is virtual, nbor is real
597  !---------------------------------------------------------------------------
598  else if (another%rank==mpi%rank) then
599  call self%set(bits%virtual)
600  call self%clear(bits%external)
601  ! -- don't use in check_ready(), use in check_nbors()
602  needed = .false.
603  needs_me = .true.
604  !---------------------------------------------------------------------------
605  ! task is virtual, nbor is virtual
606  !---------------------------------------------------------------------------
607  else
608  needed = .false.
609  needs_me = .false.
610  end if
611  !---------------------------------------------------------------------------
612  ! virtual tasks don't need guard zones
613  !---------------------------------------------------------------------------
614  download = .false.
615  end if
616  !-----------------------------------------------------------------------------
617  ! nbor is more than one level different; these are normally not needed,
618  ! and are only used in support considerations, so should not take part
619  ! in check_nbors() and check_ready(), but may be downloaded exceptionally
620  !-----------------------------------------------------------------------------
621  if (abs(another%level-self%level) > 1) then
622  needed = .false.
623  needs_me = .false.
624  end if
625  if (self%verbose > 2) &
626  write(io_unit%log,'(a,i6,i4,3x,3l1)') &
627  'set_nbor_relations: nbor, rank, IBV =', another%id, another%rank, &
628  another%is_set(bits%internal), &
629  another%is_set(bits%boundary), &
630  another%is_set(bits%virtual)
631  !-----------------------------------------------------------------------------
632  if (timer%detailed) &
633  call trace%end (itimer)
634 END SUBROUTINE nbor_relations
635 
636 !===============================================================================
637 !> Signed distance between the centers of two tasks in a possibly periodic box
638 !>
639 !> NOTE: This function is normally NOT used (but remains so it can be overloaded
640 !> or explicitly called), since it is overloaded by the patch_t%distance, which
641 !> is patch geometry aware.
642 !===============================================================================
643 FUNCTION distance (self, task) RESULT (out)
644  class(task_t):: self
645  class(task_t):: task
646  real(8):: out(3)
647  !.............................................................................
648  call trace%begin ('task_t%distance',2)
649  out = self%point_distance (self%position, task%position)
650  if (io%verbose>1 .and. (task%id==io%id_debug .or. self%id==io%id_debug)) then
651  print *,'distance: self', self%position, self%id
652  print *,'distance: task', task%position, task%id
653  print *,'distance: box', self%box
654  end if
655  call trace%end()
656 END FUNCTION distance
657 
658 !===============================================================================
659 !> Signed distance between two points in a possibly periodic box
660 !===============================================================================
661 FUNCTION point_distance (self, point1, point2) RESULT (out)
662  class(task_t):: self
663  real(8), intent(in):: point1(3), point2(3)
664  real(8):: out(3)
665  !.............................................................................
666  call trace%begin ('task_t%point_distance',2)
667  out = point1-point2
668  where (self%periodic .and. self%box /= 0d0)
669  out = modulo(out+0.5_8*self%box, self%box) - 0.5_8*self%box
670  end where
671  call trace%end()
672 END FUNCTION point_distance
673 
674 SUBROUTINE pack (self, mesg)
675  class(task_t):: self
676  class(mesg_t), pointer:: mesg
677  call mpi%abort ('task_t%pack called')
678 END SUBROUTINE
679 
680 SUBROUTINE unpack (self, mesg)
681  class(task_t):: self
682  class(mesg_t), pointer:: mesg
683  call mpi%abort ('task_t%unpack called')
684 END SUBROUTINE
685 
686 !===============================================================================
687 !> Stub, to be overloaded in experiment_mod to drop patches
688 !===============================================================================
689 FUNCTION is_relevant (self)
690  class(task_t):: self
691  logical:: is_relevant
692  !-----------------------------------------------------------------------------
693  is_relevant = .true.
694 END FUNCTION is_relevant
695 
696 !===============================================================================
697 !> Test update procedure for dispatcher tests
698 !===============================================================================
699 SUBROUTINE test_update (self)
700  class(task_t):: self
701  self%dtime = self%random%ran1()
702  self%dt(self%it) = self%dtime
703 END SUBROUTINE test_update
704 
705 !===============================================================================
706 !> Test if solver leading characters match a given string
707 !===============================================================================
708 FUNCTION solver_is (self, kind)
709  class(task_t):: self
710  logical solver_is
711  character(len=*):: kind
712  solver_is = self%kind(1:len(kind)) == kind
713 END FUNCTION solver_is
714 
715 !===============================================================================
716 !> Turn on debug output at and beyond a given level, and for id_debug task
717 !===============================================================================
718 FUNCTION debug (self, level)
719  class(task_t):: self
720  integer:: level
721  logical debug
722  !-----------------------------------------------------------------------------
723  debug = (io%verbose >= level) .or. (self%id == io%id_debug)
724 END FUNCTION debug
725 
726 !===============================================================================
727 SUBROUTINE task_info (self)
728  class(task_t):: self
729  !-----------------------------------------------------------------------------
730  write(io_unit%mpi,'(1x,a,40x,i6,2i4,2x,5x,2l1,2x,3f9.3)') &
731  'patch_t%task_info: id, BV, pos =', self%id, self%rank, self%level, &
732  self%is_set(bits%boundary), self%is_set(bits%virtual), self%position
733 END SUBROUTINE task_info
734 
735 !===============================================================================
736 SUBROUTINE log (self, label, level)
737  class(task_t):: self
738  character(len=*):: label
739  integer, optional:: level
740  !-----------------------------------------------------------------------------
741  if (io%task_logging > 0) then
742  if (present(level)) then
743  if (level > io%task_logging) &
744  return
745  end if
746  !$omp critical (tasklog_cr)
747  write(io_unit%task,'(f12.6,i4,i6,f12.6,4x,a)') &
748  wallclock(), omp%thread, self%id, self%time, trim(label)
749  !$omp end critical (tasklog_cr)
750  end if
751 END SUBROUTINE log
752 
753 END MODULE task_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
Support tic/toc timing, as in MATLAB, and accurate wallclock() function. The timing is generally much...
Doubly linked list (DLL), carrying anything, as simply as possible.
Definition: dll_mod.f90:4
Definition: io_mod.f90:4
The lock module uses nested locks, to allow versatile use of locks, where a procedure may want to mak...
Module with which one can register any number of pointers to real or integer arrays, and then output the contents of the links later.
Definition: aux_mod.f90:14
Template module for tasks.
Definition: task_mod.f90:4