DISPATCH
counters_mod.f90
1 !===============================================================================
2 !> Help keep track of when all patches have passed some counter, by decrementing
3 !> a counter, from start to 0. Typical use:
4 !>
5 !> if (self%time > some_time) then
6 !> count = counters%count (id, io%ntask)
7 !> if (count==0) then
8 !> print *, 'all tasks have passed time =', some_time
9 !> call counters%remove (id)
10 !> end if
11 !> end if
12 !===============================================================================
14  USE io_mod
15  USE trace_mod
16  USE omp_lock_mod
17  implicit none
18  private
19  !-----------------------------------------------------------------------------
20  ! counter data type, to keep track of output
21  !-----------------------------------------------------------------------------
22  type:: counter_t
23  type(counter_t), pointer:: prev=>null(), next=>null()
24  integer:: id=0, count=0, start=0
25  type(lock_t):: lock
26  end type
27  type, public:: counters_t
28  type(counter_t), pointer:: head=>null(), tail=>null()
29  integer:: n=0
30  integer:: id=0
31  type(lock_t):: lock
32  contains
33  procedure:: init
34  procedure:: decrement ! (id, start)
35  procedure:: increment ! (id, start)
36  procedure:: update ! (id, incr)
37  procedure:: remove ! (id)
38  end type
39  integer:: verbose=0
40  type(counters_t), public:: counters
41 CONTAINS
42 
43 !===============================================================================
44 !> Allow changing verbosity
45 !===============================================================================
46 SUBROUTINE init(self)
47  class(counters_t):: self
48  integer:: iostat
49  logical, save:: first_time=.true.
50  namelist /counters_params/ verbose
51  !-----------------------------------------------------------------------------
52  if (first_time) then
53  call trace%begin ('counters_t%init')
54  !$omp critical (input_cr)
55  if (first_time) then
56  self%id = 0
57  rewind(io_unit%input)
58  read (io_unit%input, counters_params, iostat=iostat)
59  write (io_unit%output, counters_params)
60  call self%lock%init ('coun')
61  first_time = .false.
62  end if
63  !$omp end critical (input_cr)
64  call trace%end()
65  end if
66 END SUBROUTINE init
67 
68 !===============================================================================
69 !> Find the counter instance with a given id and decrement counter. If a
70 !> counter with that id is not in the list, create one, and decrement it
71 !===============================================================================
72 FUNCTION decrement (self, id, start) RESULT (count)
73  integer:: count
74  class(counters_t):: self
75  type(counter_t), pointer:: counter
76  integer:: id, start
77  !-----------------------------------------------------------------------------
78  call trace%begin ('counters_t%decrement')
79  if (self%id == -1) call self%init
80  !-----------------------------------------------------------------------------
81  ! Search for the counter instance, return a new one if not found
82  !-----------------------------------------------------------------------------
83  call self%lock%set ('counters_t%decrement')
84  counter => find(self, id, start)
85  call self%lock%unset ('counters_t%decrement')
86  !-----------------------------------------------------------------------------
87  ! Decrement to zero
88  !-----------------------------------------------------------------------------
89  if (counter%count>0) then
90  !$omp atomic capture
91  counter%count = counter%count-1
92  count = counter%count
93  !$omp end atomic
94  else
95  count = counter%count
96  end if
97  if (verbose > 0) &
98  write (io_unit%output,*) 'counter_t%decrement: id, count =', counter%id, count
99  call trace%end()
100 END FUNCTION decrement
101 
102 !===============================================================================
103 !> Find the counter instance with a given id and decrement counter. If a
104 !> counter with that id is not in the list, create one, with count=start.
105 !===============================================================================
106 FUNCTION increment (self, id, start) RESULT (count)
107  integer:: count
108  class(counters_t):: self
109  type(counter_t), pointer:: counter
110  integer:: id, start
111  !-----------------------------------------------------------------------------
112  call trace%begin ('counters_t%increment')
113  if (self%id == -1) call self%init
114  !-----------------------------------------------------------------------------
115  ! Search for the counter instance, return a new one if not found
116  !-----------------------------------------------------------------------------
117  call self%lock%set ('counters_t%increment')
118  counter => find(self, id, start)
119  call self%lock%unset ('counters_t%increment')
120  !-----------------------------------------------------------------------------
121  ! Increment away from zero
122  !-----------------------------------------------------------------------------
123  !$omp atomic capture
124  counter%count = counter%count+1
125  count = counter%count
126  !$omp end atomic
127  if (verbose > 0) &
128  write (io_unit%output,*) 'counter_t%increment: id, count =', counter%id, count
129  call trace%end()
130 END FUNCTION increment
131 
132 !===============================================================================
133 !> Find the counter instance with a given id and update counter. If a counter
134 !> with the given ID does not exist, create one with count=start initially.
135 !===============================================================================
136 SUBROUTINE update (self, id, start, incr, count)
137  class(counters_t):: self
138  integer:: id, start, incr, count
139  !.............................................................................
140  type(counter_t), pointer:: counter
141  !-----------------------------------------------------------------------------
142  call trace%begin ('counters_t%update')
143  call self%lock%set ('counters_t%update')
144  counter => find(self, id, start)
145  call self%lock%unset ('counters_t%update')
146  !$omp atomic capture
147  counter%count = counter%count + incr
148  count = counter%count
149  !$omp end atomic
150  if (verbose > 0) &
151  write (stdout,*) 'counter_t%update: id, start, count =', id, start, count
152  call trace%end()
153 END SUBROUTINE update
154 
155 !===============================================================================
156 !> Find a counter with the given id, or create one
157 !===============================================================================
158 FUNCTION find (self, id, start) RESULT (counter)
159  class(counters_t):: self
160  integer:: id, start
161  optional:: start
162  type(counter_t), pointer:: counter
163  !-----------------------------------------------------------------------------
164  call trace%begin ('counters_t%find')
165  counter => self%head
166  do while (associated(counter))
167  if (counter%id==id) then
168  exit
169  end if
170  counter => counter%next
171  end do
172  !-----------------------------------------------------------------------------
173  ! If a counter instance does not exist, append a new one to the list
174  !-----------------------------------------------------------------------------
175  if (.not.associated(counter)) then
176  allocate (counter)
177  call counter%lock%init ('counter')
178  call counter%lock%set ('init')
179  !---------------------------------------------------------------------------
180  ! If id is zero on entry, give it a unique value, otherwise use the given id
181  !---------------------------------------------------------------------------
182  if (id<=0) then
183  self%id = self%id + 1
184  id = self%id
185  else
186  self%id = id
187  end if
188  call io%assert (present(start), &
189  'counters_t%find: start parameter must be present on new counters')
190  counter%id = self%id
191  counter%start = start
192  counter%count = start
193  call counter%lock%set ('init')
194  call append (self, counter)
195  if (verbose > 0) then
196  write (stdout,*) 'counters_t%find: new id, start =', counter%id, start
197  end if
198  end if
199  call trace%end()
200 END FUNCTION find
201 
202 !===============================================================================
203 !> Append a new counter record counter to the list
204 !===============================================================================
205 SUBROUTINE append (self, counter)
206  class(counters_t):: self
207  type(counter_t), pointer:: counter
208  !-----------------------------------------------------------------------------
209  call trace%begin ('counters_t%append')
210  call self%lock%set ('append')
211  counter%prev => self%tail
212  if (associated(self%tail)) then
213  self%tail%next => counter
214  end if
215  self%tail => counter
216  self%n = self%n+1
217  if (.not.associated(self%head)) self%head => counter
218  call self%lock%unset ('append')
219  call trace%end()
220 END SUBROUTINE append
221 
222 !===============================================================================
223 !> Remove the counter instance from the list
224 !===============================================================================
225 SUBROUTINE remove (self, id)
226  class(counters_t):: self
227  integer:: id
228  type(counter_t), pointer:: counter
229  !-----------------------------------------------------------------------------
230  call trace%begin ('counters_t%remove')
231  call self%lock%set ('counters_t%remove')
232  counter => find(self, id)
233  if (associated(counter%prev)) then
234  counter%prev%next => counter%next
235  else
236  counters%head => counter%next
237  end if
238  if (associated(counter%next)) then
239  counter%next%prev => counter%prev
240  else
241  counters%tail => counter%prev
242  end if
243  deallocate(counter)
244  nullify (counter)
245  counters%n = counters%n-1
246  call self%lock%unset ('counters_t%remove')
247  call trace%end()
248 END SUBROUTINE remove
249 
250 END MODULE counters_mod
Help keep track of when all patches have passed some counter, by decrementing a counter, from start to 0. Typical use:
Definition: io_mod.f90:4
The lock module uses nested locks, to allow versatile use of locks, where a procedure may want to mak...