41 integer:: mem_thread=-1
50 real(8):: out_next = 0d0
51 real(8):: print_next = 0d0
53 real(8):: min_dtime = 0d0
55 real(8):: position(3) = 0d0
56 real(8):: origin(3)=0d0
57 real(8):: velocity(3) = 0d0
58 real(8):: size(3) = 0.9999d0
63 real(8):: unpack_time=0d0
64 real(8):: dnload_time=-1d0
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' 73 character(len=12):: type=
'task_t' 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
87 integer(8):: amr_offset=0_8
90 procedure:: init_unique
93 procedure:: update => void
97 procedure:: is_ahead_of
103 procedure:: allocate => void
104 procedure:: allocate_mesg => void
105 procedure:: unique_id
106 procedure:: load_balance
107 procedure:: has_finished
109 procedure:: overlaps_point
110 procedure:: nbor_relations
112 procedure:: point_distance
115 procedure:: is_relevant
116 procedure:: test_update
117 procedure:: solver_is
119 procedure:: task_info
122 integer,
dimension(:),
pointer,
save:: id => null()
123 type(
dll_t),
pointer:: deleted_list
127 SUBROUTINE void (self)
129 print*,
'ERROR: task_t%void called' 133 SUBROUTINE dnload (self, only)
135 integer,
optional:: only
136 call mpi%abort(
'ERROR: task_t%dnload called')
137 END SUBROUTINE dnload
142 SUBROUTINE init (self)
144 character(len=120):: ids= &
145 '$Id: 06556f02c9614987d5f9540daef1921ce5eaa169 $ tasks/task_mod.f90' 147 call trace_begin (
'task_t%init')
148 call trace%print_id (ids)
149 if (self%id == 0)
then 150 call init_unique (self)
153 call self%lock%init (self%kind(1:4), id=self%id+2)
154 call self%random%init
161 SUBROUTINE init_unique (self, same)
163 logical,
optional:: same
165 integer,
save:: id_same=0
170 call trace_begin (
'task_t%init_unique')
171 if (
present(same) .and. same)
then 176 if (mpi%rank==0)
then 179 if (io%verbose > 0) &
180 write (io_unit%log,*)
'task_t%init_unique(same): mpi%id, id =', id_same, id
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
192 END SUBROUTINE init_unique
197 SUBROUTINE dealloc (self)
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)
206 END SUBROUTINE dealloc
211 SUBROUTINE save_id (self)
215 integer,
pointer:: id
217 call trace_begin (
'task_t%save_id')
218 if (.not.
associated(deleted_list%head))
then 219 call deleted_list%init
224 call deleted_list%append (node)
226 END SUBROUTINE save_id
234 SUBROUTINE rotate (self)
236 integer:: iv, nv, new, i
238 integer,
save:: itimer=0
239 real(8),
pointer:: rptr
240 integer,
pointer:: iptr
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
248 if (self%rotated)
return 249 call trace_begin (
'task_t%rotate',itimer=itimer)
250 call self%log (
'rotate', 3)
254 if (io%verbose > 1)
then 255 write (io_unit%log,
'(a,7i10)')
'task_t%rotate iit =', self%iit
258 if (omp_lock%tasks)
then 259 call self%lock%set (
'rotate')
266 if (self%syncing)
then 267 time = self%sync_time
268 self%syncing = .false.
270 write (io_unit%mpi,*)
'task_t%rotate:: turning off syncing for now', self%id
272 time = self%time + self%dtime
282 rptr => self%dt(self%it)
285 self%dt(self%new)= self%dtime
286 self%t(self%new) = time
290 new = mod(new,self%nt)+1
291 associate(snew=>self%new)
300 iptr => self%iit(self%nt)
304 self%istep = self%istep + 1
308 write (io_unit%log,*)
'task id:',self%id,
' it:',self%it,
' new:',self%new
310 write (io_unit%log,*)
'task iit:', self%iit
312 write (io_unit%log,*)
'task t(iit):', self%t(self%iit)
314 self%rotated = .true.
315 if (omp_lock%tasks)
then 316 call self%lock%unset (
'rotate')
318 call trace_end (itimer)
319 END SUBROUTINE rotate
324 SUBROUTINE info (self, nq, ntask, experiment_name)
326 integer,
optional:: nq, ntask
327 character(len=64),
optional:: experiment_name
338 SUBROUTINE timeslots (self, slots, times)
340 real(8):: times(self%nt-1)
341 integer:: slots(self%nt-1)
347 i = 1 + mod(j+it,self%nt)
348 if (j < self%nt-self%istep)
then 355 END SUBROUTINE timeslots
363 LOGICAL FUNCTION is_ahead_of (self, target)
364 class(
task_t):: self,
target 365 real(8):: nbtime, nbdtime
372 if (self%is_set(bits%frozen))
then 378 else if (self%istep < 3)
then 379 is_ahead_of = nbtime >=
target%time
382 is_ahead_of = nbtime + nbdtime*self%grace >
target%time
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
391 SUBROUTINE print (self)
398 SUBROUTINE set (self, bits)
404 self%status = ior(self%status, bits)
412 SUBROUTINE clear (self, bits)
418 self%status = iand(self%status, not(bits))
426 LOGICAL FUNCTION is_set (self, bits)
428 integer:: bits, status
433 is_set = (iand(status, bits) /= 0)
440 LOGICAL FUNCTION is_clear (self, bits)
442 integer:: bits, status
447 is_clear = (iand(status, bits) == 0)
452 LOGICAL FUNCTION has_finished (self)
456 has_finished = (self%time > io%end_time)
460 FUNCTION unique_id (self)
464 id(self%rank) = id(self%rank) + mpi%size
465 unique_id = id(self%rank)
466 END FUNCTION unique_id
498 SUBROUTINE load_balance (self)
501 END SUBROUTINE load_balance
515 FUNCTION overlaps (self, task)
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
531 FUNCTION overlaps_point (self, p)
534 logical:: overlaps_point
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)
540 END FUNCTION overlaps_point
546 SUBROUTINE nbor_relations (self, another, needed, needs_me, download)
548 class(
task_t),
pointer:: another
549 logical:: needed, needs_me, download
550 integer,
save:: itimer=0
552 if (timer%detailed) &
553 call trace%begin (
'task_t%nbor_relations', 2, itimer=itimer)
557 if (self%rank == mpi%rank)
then 561 if (another%is_set (bits%frozen))
then 567 else if (another%rank /= mpi%rank)
then 568 call self%set(bits%boundary)
569 call self%clear(bits%internal)
592 if (another%is_set (bits%frozen))
then 598 else if (another%rank==mpi%rank)
then 599 call self%set(bits%virtual)
600 call self%clear(bits%external)
621 if (abs(another%level-self%level) > 1)
then 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)
632 if (timer%detailed) &
633 call trace%end (itimer)
634 END SUBROUTINE nbor_relations
643 FUNCTION distance (self, task)
RESULT (out)
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
656 END FUNCTION distance
661 FUNCTION point_distance (self, point1, point2)
RESULT (out)
663 real(8),
intent(in):: point1(3), point2(3)
666 call trace%begin (
'task_t%point_distance',2)
668 where (self%periodic .and. self%box /= 0d0)
669 out = modulo(out+0.5_8*self%box, self%box) - 0.5_8*self%box
672 END FUNCTION point_distance
674 SUBROUTINE pack (self, mesg)
676 class(mesg_t),
pointer:: mesg
677 call mpi%abort (
'task_t%pack called')
680 SUBROUTINE unpack (self, mesg)
682 class(mesg_t),
pointer:: mesg
683 call mpi%abort (
'task_t%unpack called')
689 FUNCTION is_relevant (self)
691 logical:: is_relevant
694 END FUNCTION is_relevant
699 SUBROUTINE test_update (self)
701 self%dtime = self%random%ran1()
702 self%dt(self%it) = self%dtime
703 END SUBROUTINE test_update
708 FUNCTION solver_is (self, kind)
711 character(len=*):: kind
712 solver_is = self%kind(1:len(kind)) == kind
713 END FUNCTION solver_is
718 FUNCTION debug (self, level)
723 debug = (io%verbose >= level) .or. (self%id == io%id_debug)
727 SUBROUTINE task_info (self)
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
736 SUBROUTINE log (self, label, level)
738 character(len=*):: label
739 integer,
optional:: level
741 if (io%task_logging > 0)
then 742 if (
present(level))
then 743 if (level > io%task_logging) &
747 write(io_unit%task,
'(f12.6,i4,i6,f12.6,4x,a)') &
748 wallclock(), omp%thread, self%id, self%time, trim(label)
Each thread uses a private timer data type, with arrays for start time and total time for each regist...
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.
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.
Template module for tasks.