23 type(counter_t),
pointer:: prev=>null(), next=>null()
24 integer:: id=0, count=0, start=0
28 type(counter_t),
pointer:: head=>null(), tail=>null()
49 logical,
save:: first_time=.true.
50 namelist /counters_params/ verbose
53 call trace%begin (
'counters_t%init')
58 read (io_unit%input, counters_params, iostat=iostat)
59 write (io_unit%output, counters_params)
60 call self%lock%init (
'coun')
72 FUNCTION decrement (self, id, start)
RESULT (count)
75 type(counter_t),
pointer:: counter
78 call trace%begin (
'counters_t%decrement')
79 if (self%id == -1)
call self%init
83 call self%lock%set (
'counters_t%decrement')
84 counter => find(self, id, start)
85 call self%lock%unset (
'counters_t%decrement')
89 if (counter%count>0)
then 91 counter%count = counter%count-1
98 write (io_unit%output,*)
'counter_t%decrement: id, count =', counter%id, count
100 END FUNCTION decrement
106 FUNCTION increment (self, id, start)
RESULT (count)
109 type(counter_t),
pointer:: counter
112 call trace%begin (
'counters_t%increment')
113 if (self%id == -1)
call self%init
117 call self%lock%set (
'counters_t%increment')
118 counter => find(self, id, start)
119 call self%lock%unset (
'counters_t%increment')
124 counter%count = counter%count+1
125 count = counter%count
128 write (io_unit%output,*)
'counter_t%increment: id, count =', counter%id, count
130 END FUNCTION increment
136 SUBROUTINE update (self, id, start, incr, count)
138 integer:: id, start, incr, count
140 type(counter_t),
pointer:: counter
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')
147 counter%count = counter%count + incr
148 count = counter%count
151 write (stdout,*)
'counter_t%update: id, start, count =', id, start, count
153 END SUBROUTINE update
158 FUNCTION find (self, id, start)
RESULT (counter)
162 type(counter_t),
pointer:: counter
164 call trace%begin (
'counters_t%find')
166 do while (
associated(counter))
167 if (counter%id==id)
then 170 counter => counter%next
175 if (.not.
associated(counter))
then 177 call counter%lock%init (
'counter')
178 call counter%lock%set (
'init')
183 self%id = self%id + 1
188 call io%assert (
present(start), &
189 'counters_t%find: start parameter must be present on new counters')
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
205 SUBROUTINE append (self, counter)
207 type(counter_t),
pointer:: counter
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
217 if (.not.
associated(self%head)) self%head => counter
218 call self%lock%unset (
'append')
220 END SUBROUTINE append
225 SUBROUTINE remove (self, id)
228 type(counter_t),
pointer:: counter
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
236 counters%head => counter%next
238 if (
associated(counter%next))
then 239 counter%next%prev => counter%prev
241 counters%tail => counter%prev
245 counters%n = counters%n-1
246 call self%lock%unset (
'counters_t%remove')
248 END SUBROUTINE remove
Help keep track of when all patches have passed some counter, by decrementing a counter, from start to 0. Typical use:
The lock module uses nested locks, to allow versatile use of locks, where a procedure may want to mak...