(git:0de0cc2)
list_routinestat.F
Go to the documentation of this file.
1 !--------------------------------------------------------------------------------------------------!
2 ! CP2K: A general program to perform molecular dynamics simulations !
3 ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 ! !
5 ! SPDX-License-Identifier: GPL-2.0-or-later !
6 !--------------------------------------------------------------------------------------------------!
7 
8 ! **************************************************************************************************
9 !> \brief An array-based list which grows on demand.
10 !> When the internal array is full, a new array of twice the size will be
11 !> allocated and the items are copied over.
12 !>
13 !> This list can also be used as a stack.
14 !> Have look at list_push(), list_pop() and list_peek().
15 !> \par History
16 !> 12.2012 first version [ole]
17 !> \author Ole Schuett
18 ! **************************************************************************************************
19 
21  USE timings_base_type, ONLY: routine_stat_type, callstack_entry_type, routine_report_type
22 
23 
24 #include "../base/base_uses.f90"
25  IMPLICIT NONE
26  PRIVATE
27 
31 
32 !this is an internal type
33  TYPE private_item_type_routinestat
34  PRIVATE
35  TYPE(routine_stat_type), POINTER :: value => null()
36  END TYPE private_item_type_routinestat
37 
38 !this is an internal type
39  TYPE private_item_p_type_routinestat
40  PRIVATE
41  TYPE(private_item_type_routinestat), POINTER :: p => null()
42  END TYPE private_item_p_type_routinestat
43 
44 ! this is the public type, which holds a list-instance
45  TYPE list_routinestat_type
46  PRIVATE
47  TYPE(private_item_p_type_routinestat), DIMENSION(:), POINTER :: arr => null()
48  INTEGER :: size = -1
49  END TYPE list_routinestat_type
50 
51  CONTAINS
52 
53 ! **************************************************************************************************
54 !> \brief Test if the given list has been initialized.
55 !> \param list ...
56 !> \return ...
57 !> \par History
58 !> 12.2012 created [ole]
59 !> \author Ole Schuett
60 ! **************************************************************************************************
61  FUNCTION list_routinestat_isready(list) RESULT(res)
62  TYPE(list_routinestat_type), intent(in) :: list
63  LOGICAL :: res
64  res = ASSOCIATED(list%arr)
65  END FUNCTION list_routinestat_isready
66 
67 ! **************************************************************************************************
68 !> \brief Allocates the internal data-structures of the given list.
69 !> This has to be called before any of the other routines.
70 !> For deallocation call list_[valuetype]_destroy.
71 !> \param list ...
72 !> \param initial_capacity The initial size of the internal array (default=11).
73 !> \par History
74 !> 12.2012 created [ole]
75 !> \author Ole Schuett
76 ! **************************************************************************************************
77  SUBROUTINE list_routinestat_init(list, initial_capacity)
78  TYPE(list_routinestat_type), intent(inout) :: list
79  INTEGER, INTENT(in), OPTIONAL :: initial_capacity
80  INTEGER :: stat
81  INTEGER :: initial_capacity_
82 
83  initial_capacity_ = 11
84  If (PRESENT(initial_capacity)) initial_capacity_ = initial_capacity
85 
86  IF (initial_capacity_ < 0) &
87  cpabort("list_routinestat_create: initial_capacity < 0")
88 
89  IF (ASSOCIATED(list%arr)) &
90  cpabort("list_routinestat_create: list is already initialized.")
91 
92  ALLOCATE (list%arr(initial_capacity_), stat=stat)
93  IF (stat /= 0) &
94  cpabort("list_routinestat_init: allocation failed")
95 
96  list%size = 0
97  END SUBROUTINE list_routinestat_init
98 
99 ! **************************************************************************************************
100 !> \brief Deallocated the internal data-structures of the given list.
101 !> Caution: If the stored values are pointers, their targets will
102 !> not get deallocated by this routine.
103 !> \param list ...
104 !> \par History
105 !> 12.2012 created [ole]
106 !> \author Ole Schuett
107 ! **************************************************************************************************
108  SUBROUTINE list_routinestat_destroy(list)
109  TYPE(list_routinestat_type), intent(inout) :: list
110  INTEGER :: i
111  IF (.not. ASSOCIATED(list%arr)) &
112  cpabort("list_routinestat_destroy: list is not initialized.")
113 
114  do i = 1, list%size
115  deallocate (list%arr(i)%p)
116  end do
117  deallocate (list%arr)
118  list%size = -1
119  END SUBROUTINE list_routinestat_destroy
120 
121 ! **************************************************************************************************
122 !> \brief Assings the given value to the given position in the list.
123 !> Thereby, the former value at that position gets overwritten.
124 !> If the position is out of bounds, the program stops.
125 !> \param list ...
126 !> \param value ...
127 !> \param pos Position in the list - musst fulfill 0 < pos < list_size+1.
128 !> \par History
129 !> 12.2012 created [ole]
130 !> \author Ole Schuett
131 ! **************************************************************************************************
132  SUBROUTINE list_routinestat_set(list, value, pos)
133  TYPE(list_routinestat_type), intent(inout) :: list
134  TYPE(routine_stat_type), POINTER, intent(in) :: value
135  INTEGER, intent(in) :: pos
136  IF (.not. ASSOCIATED(list%arr)) &
137  cpabort("list_routinestat_set: list is not initialized.")
138  IF (pos < 1) &
139  cpabort("list_routinestat_set: pos < 1")
140  IF (pos > list%size) &
141  cpabort("list_routinestat_set: pos > size")
142  list%arr(pos)%p%value =>value
143  END SUBROUTINE list_routinestat_set
144 
145 ! **************************************************************************************************
146 !> \brief Appends the given value at the end of the list.
147 !> \param list ...
148 !> \param value ...
149 !> \par History
150 !> 12.2012 created [ole]
151 !> \author Ole Schuett
152 ! **************************************************************************************************
153  SUBROUTINE list_routinestat_push(list, value)
154  TYPE(list_routinestat_type), intent(inout) :: list
155  TYPE(routine_stat_type), POINTER, intent(in) :: value
156  INTEGER :: stat
157 
158  IF (.not. ASSOCIATED(list%arr)) &
159  cpabort("list_routinestat_push: list is not initialized.")
160  if (list%size == size(list%arr)) &
161  call change_capacity_routinestat (list, 2*size(list%arr) + 1)
162 
163  list%size = list%size + 1
164  ALLOCATE (list%arr(list%size)%p, stat=stat)
165  IF (stat /= 0) &
166  cpabort("list_routinestat_push: allocation failed")
167  list%arr(list%size)%p%value =>value
168  END SUBROUTINE list_routinestat_push
169 
170 ! **************************************************************************************************
171 !> \brief Inserts the given value at the givenn position within the list.
172 !> Values which lay behind the insertion-position move one position up.
173 !> \param list ...
174 !> \param value ...
175 !> \param pos Position in the list - musst fulfill 0 < pos < list_size+2 .
176 !> \par History
177 !> 12.2012 created [ole]
178 !> \author Ole Schuett
179 ! **************************************************************************************************
180  SUBROUTINE list_routinestat_insert(list, value, pos)
181  TYPE(list_routinestat_type), intent(inout) :: list
182  TYPE(routine_stat_type), POINTER, intent(in) :: value
183  INTEGER, intent(in) :: pos
184  INTEGER :: i, stat
185 
186  IF (.not. ASSOCIATED(list%arr)) &
187  cpabort("list_routinestat_insert: list is not initialized.")
188  IF (pos < 1) &
189  cpabort("list_routinestat_insert: pos < 1")
190  IF (pos > list%size + 1) &
191  cpabort("list_routinestat_insert: pos > size+1")
192 
193  if (list%size == size(list%arr)) &
194  call change_capacity_routinestat (list, 2*size(list%arr) + 1)
195 
196  list%size = list%size + 1
197  do i = list%size, pos + 1, -1
198  list%arr(i)%p => list%arr(i - 1)%p
199  end do
200 
201  ALLOCATE (list%arr(pos)%p, stat=stat)
202  IF (stat /= 0) &
203  cpabort("list_routinestat_insert: allocation failed.")
204  list%arr(pos)%p%value =>value
205  END SUBROUTINE list_routinestat_insert
206 
207 ! **************************************************************************************************
208 !> \brief Returns the last element in the list.
209 !> Is equivalent to: list_routinestat_get(list, list_routinestat_size(list))
210 !> \param list ...
211 !> \return ...
212 !> \par History
213 !> 12.2012 created [ole]
214 !> \author Ole Schuett
215 ! **************************************************************************************************
216  FUNCTION list_routinestat_peek(list) RESULT(value)
217  TYPE(list_routinestat_type), intent(inout) :: list
218  TYPE(routine_stat_type), POINTER :: value
219 
220  IF (.not. ASSOCIATED(list%arr)) &
221  cpabort("list_routinestat_peek: list is not initialized.")
222  IF (list%size < 1) &
223  cpabort("list_routinestat_peek: list is empty.")
224 
225  value =>list%arr(list%size)%p%value
226  END FUNCTION list_routinestat_peek
227 
228 ! **************************************************************************************************
229 !> \brief Returns the last element in the list and removes it.
230 !> Is equivialent to:
231 !> value = list_routinestat_get(list, list_routinestat_size(list))
232 !> call list_routinestat_del(list, list_routinestat_size(list))
233 !>
234 !> \param list ...
235 !> \return ...
236 !> \par History
237 !> 12.2012 created [ole]
238 !> \author Ole Schuett
239 ! **************************************************************************************************
240  FUNCTION list_routinestat_pop(list) RESULT(value)
241  TYPE(list_routinestat_type), intent(inout) :: list
242  TYPE(routine_stat_type), POINTER :: value
243 
244  IF (.not. ASSOCIATED(list%arr)) &
245  cpabort("list_routinestat_pop: list is not initialized.")
246  IF (list%size < 1) &
247  cpabort("list_routinestat_pop: list is empty.")
248 
249  value =>list%arr(list%size)%p%value
250  deallocate (list%arr(list%size)%p)
251  list%size = list%size - 1
252  END FUNCTION list_routinestat_pop
253 
254 ! **************************************************************************************************
255 !> \brief Removes all values from the list. The list itself is not deallocated.
256 !> \param list ...
257 !> \par History
258 !> 12.2012 created [ole]
259 !> \author Ole Schuett
260 ! **************************************************************************************************
261  SUBROUTINE list_routinestat_clear(list)
262  TYPE(list_routinestat_type), intent(inout) :: list
263  INTEGER :: i
264 
265  IF (.not. ASSOCIATED(list%arr)) &
266  cpabort("list_routinestat_clear: list is not initialized.")
267 
268  do i = 1, list%size
269  deallocate (list%arr(i)%p)
270  end do
271  list%size = 0
272  END SUBROUTINE list_routinestat_clear
273 
274 !
275 ! **************************************************************************************************
276 !> \brief Returns the value at the given position from the list.
277 !> \param list ...
278 !> \param pos Position in the list - musst fulfill 0 < pos < list_size+1 .
279 !> \return ...
280 !> \par History
281 !> 12.2012 created [ole]
282 !> \author Ole Schuett
283 ! **************************************************************************************************
284  FUNCTION list_routinestat_get(list, pos) RESULT(value)
285  TYPE(list_routinestat_type), intent(in) :: list
286  INTEGER, intent(in) :: pos
287  TYPE(routine_stat_type), POINTER :: value
288 
289  IF (.not. ASSOCIATED(list%arr)) &
290  cpabort("list_routinestat_get: list is not initialized.")
291  IF (pos < 1) &
292  cpabort("list_routinestat_get: pos < 1")
293  IF (pos > list%size) &
294  cpabort("list_routinestat_get: pos > size")
295 
296  value =>list%arr(pos)%p%value
297 
298  END FUNCTION list_routinestat_get
299 
300 ! **************************************************************************************************
301 !> \brief Removes the value at the given position from the list.
302 !> \param list ...
303 !> \param pos Position in the list - musst fulfill 0 < pos < list_size+1 .
304 !> \par History
305 !> 12.2012 created [ole]
306 !> \author Ole Schuett
307 ! **************************************************************************************************
308  SUBROUTINE list_routinestat_del(list, pos)
309  TYPE(list_routinestat_type), intent(inout) :: list
310  INTEGER, intent(in) :: pos
311  INTEGER :: i
312 
313  IF (.not. ASSOCIATED(list%arr)) &
314  cpabort("list_routinestat_del: list is not initialized.")
315  IF (pos < 1) &
316  cpabort("list_routinestat_det: pos < 1")
317  IF (pos > list%size) &
318  cpabort("list_routinestat_det: pos > size")
319 
320  deallocate (list%arr(pos)%p)
321  do i = pos, list%size - 1
322  list%arr(i)%p => list%arr(i + 1)%p
323  end do
324 
325  list%size = list%size - 1
326 
327  END SUBROUTINE list_routinestat_del
328 
329 ! **************************************************************************************************
330 !> \brief Returns the current size of the list.
331 !> \param list ...
332 !> \return ...
333 !> \par History
334 !> 12.2012 created [ole]
335 !> \author Ole Schuett
336 ! **************************************************************************************************
337  FUNCTION list_routinestat_size(list) RESULT(size)
338  TYPE(list_routinestat_type), intent(in) :: list
339  INTEGER :: size
340 
341  IF (.not. ASSOCIATED(list%arr)) &
342  cpabort("list_routinestat_size: list is not initialized.")
343 
344  size = list%size
345  END FUNCTION list_routinestat_size
346 
347 ! **************************************************************************************************
348 !> \brief Internal routine for changing the size of the internal array.
349 !> \param list ...
350 !> \param new_capacity ...
351 !> \par History
352 !> 12.2012 created [ole]
353 !> \author Ole Schuett
354 ! **************************************************************************************************
355  SUBROUTINE change_capacity_routinestat (list, new_capacity)
356  TYPE(list_routinestat_type), intent(inout) :: list
357  INTEGER, intent(in) :: new_capacity
358  INTEGER :: i, new_cap, stat
359  TYPE(private_item_p_type_routinestat), DIMENSION(:), POINTER :: old_arr
360 
361  new_cap = new_capacity
362  IF (new_cap < 0) &
363  cpabort("list_routinestat_change_capacity: new_capacity < 0")
364  IF (new_cap < list%size) &
365  cpabort("list_routinestat_change_capacity: new_capacity < size")
366  IF (new_cap > huge(i)) THEN
367  IF (size(list%arr) == huge(i)) &
368  cpabort("list_routinestat_change_capacity: list has reached integer limit.")
369  new_cap = huge(i) ! grow as far as possible
370  END IF
371 
372  old_arr => list%arr
373  allocate (list%arr(new_cap), stat=stat)
374  IF (stat /= 0) &
375  cpabort("list_routinestat_change_capacity: allocation failed")
376 
377  do i = 1, list%size
378  allocate (list%arr(i)%p, stat=stat)
379  IF (stat /= 0) &
380  cpabort("list_routinestat_change_capacity: allocation failed")
381  list%arr(i)%p%value =>old_arr(i)%p%value
382  deallocate (old_arr(i)%p)
383  end do
384  deallocate (old_arr)
385 
386  END SUBROUTINE change_capacity_routinestat
387 
388 END MODULE list_routinestat
An array-based list which grows on demand. When the internal array is full, a new array of twice the ...
subroutine, public list_routinestat_init(list, initial_capacity)
Allocates the internal data-structures of the given list. This has to be called before any of the oth...
integer function, public list_routinestat_size(list)
Returns the current size of the list.
subroutine, public list_routinestat_set(list, value, pos)
Assings the given value to the given position in the list. Thereby, the former value at that position...
logical function, public list_routinestat_isready(list)
Test if the given list has been initialized.
subroutine, public list_routinestat_insert(list, value, pos)
Inserts the given value at the givenn position within the list. Values which lay behind the insertion...
subroutine, public list_routinestat_clear(list)
Removes all values from the list. The list itself is not deallocated.
type(routine_stat_type) function, pointer, public list_routinestat_pop(list)
Returns the last element in the list and removes it. Is equivialent to: value = list_routinestat_get(...
subroutine, public list_routinestat_push(list, value)
Appends the given value at the end of the list.
subroutine, public list_routinestat_destroy(list)
Deallocated the internal data-structures of the given list. Caution: If the stored values are pointer...
subroutine, public list_routinestat_del(list, pos)
Removes the value at the given position from the list.
type(routine_stat_type) function, pointer, public list_routinestat_peek(list)
Returns the last element in the list. Is equivalent to: list_routinestat_get(list,...
type(routine_stat_type) function, pointer, public list_routinestat_get(list, pos)
Returns the value at the given position from the list.
An array-based list which grows on demand. When the internal array is full, a new array of twice the ...
Definition: list.F:24
Types used by timings.F and timings_report.F The types in this module are used within dict or list,...