DISPATCH
dispatcher2_mod.f90
1 !===============================================================================
2 !> A simple task dispatcher, which handles a list of tasks that may be started
3 !> as background OpenMP tasks. A task can be in any of 4 states:
4 !>
5 !> 1: ready for updating
6 !> 2: undergoing updating by some thread
7 !> 3: has been updated, but nbors not yet checked
8 !> 4: finished
9 !>
10 !> When starting, all tasks are normally in state 1, and the dispatcher starts
11 !> a number (omp%nthreads) of background tasks that update them, first changing
12 !> the state to 2. When finished, the updating thread changes the state from 2
13 !> to 3. When the dispatcher finds a task in state 3, it runs a check on the
14 !> nbor tasks
15 !>
16 !> dispatcher%execute
17 !> dispatcher%update
18 !> link%check_task
19 !> dispatcher%activate
20 !> link%check_mpi
21 !> link%update
22 !===============================================================================
24  USE io_mod
25  USE io_unit_mod
26  USE omp_mod
27  USE omp_timer_mod
28  USE timer_mod
29  USE trace_mod
30  USE mpi_mesg_mod
31  USE link_mod
32  USE list_mod
33  USE task_list_mod
34  USE bits_mod
35  USE task_mod
36  USE experiment_mod
37  implicit none
38  private
39  type, public :: dispatcher2_t
40  integer :: running
41  type(task_list_t), pointer:: task_list => null()
42  contains
43  procedure :: execute
44  procedure :: activate
45  procedure :: update
46  end type
47  type(dispatcher2_t), public:: dispatcher2
48 CONTAINS
49 
50 !===============================================================================
51 !> Initialize the list, by populating it from a task_list
52 !===============================================================================
53 SUBROUTINE execute (self, task_list, test)
54  class(dispatcher2_t) :: self
55  type(task_list_t), pointer :: task_list
56  logical:: test
57  !.............................................................................
58  class(link_t), pointer :: link
59  real(8):: start
60  !-----------------------------------------------------------------------------
61  call trace_begin ('dispatcher2_t%execute')
62  call task_list%startup
63  self%running = 0
64  self%task_list => task_list
65  task_list%nq = task_list%n
66  task_list%na = task_list%n
67  link => task_list%head
68  do while (associated(link))
69  call link%task%set (bits%ready)
70  link => link%next
71  end do
72  call tic (time=start)
73  !$omp parallel
74  !$omp master
75  do while (self%task_list%na > 0 .and. wallclock() < io%job_seconds)
76  call self%update (test)
77  end do
78  !$omp end master
79  !$omp end parallel
80  call trace_end
81  call timer%print()
82  call mpi_mesg%diagnostics(1)
83  call toc ('wall time', timer%n_update, time=start)
84 END SUBROUTINE execute
85 
86 !===============================================================================
87 !> Activate a task pointed to by a link, by starting a task%update as a
88 !> background OpenMP task. Set the state of task to 1 when dormant, 2 when
89 !> ready, and 3 when active.
90 !===============================================================================
91 SUBROUTINE activate (self, link, test)
92  class(dispatcher2_t) :: self
93  class(link_t), pointer :: link
94  logical:: test
95  !-----------------------------------------------------------------------------
96  if (omp%nthreads==1) then
97  link%task%state = 3
98  call self%task_list%update (link, test)
99  link%task%state = 1
100  else
101  !$omp task default(shared) firstprivate(link)
102  !$omp atomic write
103  link%task%state = 3
104  call self%task_list%check_mpi ()
105  call self%task_list%update (link, test)
106  !$omp atomic write
107  link%task%state = 1
108  !$omp atomic
109  self%task_list%nq = self%task_list%nq - 1
110  !$omp end task
111  end if
112 END SUBROUTINE activate
113 
114 !===============================================================================
115 !> Update the list of running tasks. For each task on the running list, if it
116 !> is no longer busy, check if any of its passive nbors has become executable.
117 !> Finally, check the task itself.
118 !===============================================================================
119 SUBROUTINE update (self, test)
120  class(dispatcher2_t) :: self
121  logical :: test
122  !.............................................................................
123  class(link_t), pointer :: link, nbor
124  integer :: state
125  logical :: ok
126  integer, save :: itimer=0
127  !-----------------------------------------------------------------------------
128  call trace_begin ('dispatcher2_t%update', itimer=itimer)
129  link => self%task_list%head
130  do while (associated(link))
131  if (io%debug(2)) then
132  print *, 'checking link', link%task%id, link%task%state
133  end if
134  !$omp atomic read
135  state = link%task%state
136  if (state==4) then
137  link => link%next
138  cycle
139  end if
140  if (link%task%time > io%end_time) then
141  !$omp atomic
142  self%task_list%na = self%task_list%na - 1
143  !$omp atomic write
144  link%task%state = 4
145  cycle
146  end if
147  if (state<=1) then
148  nbor => link%nbor
149  do while (associated(nbor))
150  !$omp atomic read
151  state = nbor%link%task%state
152  if (state==1) then
153  if (io%debug(3)) then
154  print '(i3,f12.6,a,i6,i3)', omp%thread, wallclock(), ' checking nbor', nbor%link%task%id, state
155  end if
156  call check_task (nbor%link, ok)
157  end if
158  nbor => nbor%next
159  end do
160  call check_task (link, ok)
161  end if
162  link => link%next
163  end do
164  call trace_end (itimer)
165 contains
166  !-----------------------------------------------------------------------------
167  ! If all nbors of a task are ahead in time activate the task. Only the master
168  ! thread is checking, so there should be no chance of starting multiple
169  ! threads on the same update. The only state change performed by the many
170  ! production threads is to go from state 2 to state 3, which is of no concern
171  ! to the master thread, and then from state 3 to state 1, which will
172  ! eventually be detected (typically much later) by the master thread. The
173  ! delay before checking is not a disadvantage, since it actually increases
174  ! the chances that the patch is ready for updating when it checked. At the end
175  ! a change to state 4 indicates a finished task.
176  !-----------------------------------------------------------------------------
177  subroutine check_task (link, ok)
178  class(link_t), pointer:: link, nbor
179  class(task_t), pointer:: task
180  logical:: ok
181  integer:: state
182  !---------------------------------------------------------------------------
183  ok = .true.
184  task => link%task
185  nbor => link%nbor
186  do while (ok.and.associated (nbor))
187  ok = ok .and. nbor%task%is_ahead_of(task)
188  nbor => nbor%next
189  end do
190  if (ok) then
191  !$omp atomic read
192  state = link%task%state
193  if (state<=1) then
194  if (state==1) then
195  !$omp atomic
196  self%task_list%nq = self%task_list%nq + 1
197  end if
198  !$omp atomic write
199  link%task%state = 2
200  call self%activate (link, test)
201  else
202  print '(i3,f12.6,a,i6,i3)', omp%thread, wallclock(), ' found unexpected state', link%task%id, link%task%state
203  end if
204  end if
205  end subroutine check_task
206 END SUBROUTINE update
207 
208 END MODULE dispatcher2_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...
Module with list handling for generic class task_t objects.
Definition: list_mod.f90:4
Task list data type, with methods for startup and updates. Message handling is inherited from the tas...
Definition: io_mod.f90:4
A simple task dispatcher, which handles a list of tasks that may be started as background OpenMP task...
Template module for tasks.
Definition: task_mod.f90:4