21 USE timings_base_type,
ONLY: routine_stat_type, callstack_entry_type, routine_report_type
24 #include "../base/base_uses.f90"
34 TYPE private_item_type_routinereport
36 TYPE(routine_report_type),
POINTER ::
value => null()
37 END TYPE private_item_type_routinereport
40 TYPE private_item_p_type_routinereport
42 TYPE(private_item_type_routinereport),
POINTER :: p => null()
43 END TYPE private_item_p_type_routinereport
46 TYPE list_routinereport_type
48 TYPE(private_item_p_type_routinereport),
DIMENSION(:),
POINTER :: arr => null()
50 END TYPE list_routinereport_type
63 TYPE(list_routinereport_type),
intent(in) ::
list
65 res =
ASSOCIATED(
list%arr)
79 TYPE(list_routinereport_type),
intent(inout) ::
list
80 INTEGER,
INTENT(in),
OPTIONAL :: initial_capacity
82 INTEGER :: initial_capacity_
84 initial_capacity_ = 11
85 If (
PRESENT(initial_capacity)) initial_capacity_ = initial_capacity
87 IF (initial_capacity_ < 0) &
88 cpabort(
"list_routinereport_create: initial_capacity < 0")
90 IF (
ASSOCIATED(
list%arr)) &
91 cpabort(
"list_routinereport_create: list is already initialized.")
93 ALLOCATE (
list%arr(initial_capacity_), stat=stat)
95 cpabort(
"list_routinereport_init: allocation failed")
110 TYPE(list_routinereport_type),
intent(inout) ::
list
112 IF (.not.
ASSOCIATED(
list%arr)) &
113 cpabort(
"list_routinereport_destroy: list is not initialized.")
116 deallocate (
list%arr(i)%p)
118 deallocate (
list%arr)
134 TYPE(list_routinereport_type),
intent(inout) ::
list
135 TYPE(routine_report_type),
POINTER,
intent(in) :: value
136 INTEGER,
intent(in) :: pos
137 IF (.not.
ASSOCIATED(
list%arr)) &
138 cpabort(
"list_routinereport_set: list is not initialized.")
140 cpabort(
"list_routinereport_set: pos < 1")
141 IF (pos >
list%size) &
142 cpabort(
"list_routinereport_set: pos > size")
143 list%arr(pos)%p%value =>
value
155 TYPE(list_routinereport_type),
intent(inout) ::
list
156 TYPE(routine_report_type),
POINTER,
intent(in) :: value
159 IF (.not.
ASSOCIATED(
list%arr)) &
160 cpabort(
"list_routinereport_push: list is not initialized.")
162 call change_capacity_routinereport (
list, 2*
size(
list%arr) + 1)
165 ALLOCATE (
list%arr(
list%size)%p, stat=stat)
167 cpabort(
"list_routinereport_push: allocation failed")
182 TYPE(list_routinereport_type),
intent(inout) ::
list
183 TYPE(routine_report_type),
POINTER,
intent(in) :: value
184 INTEGER,
intent(in) :: pos
187 IF (.not.
ASSOCIATED(
list%arr)) &
188 cpabort(
"list_routinereport_insert: list is not initialized.")
190 cpabort(
"list_routinereport_insert: pos < 1")
191 IF (pos >
list%size + 1) &
192 cpabort(
"list_routinereport_insert: pos > size+1")
195 call change_capacity_routinereport (
list, 2*
size(
list%arr) + 1)
198 do i =
list%size, pos + 1, -1
202 ALLOCATE (
list%arr(pos)%p, stat=stat)
204 cpabort(
"list_routinereport_insert: allocation failed.")
205 list%arr(pos)%p%value =>
value
218 TYPE(list_routinereport_type),
intent(inout) ::
list
219 TYPE(routine_report_type),
POINTER :: value
221 IF (.not.
ASSOCIATED(
list%arr)) &
222 cpabort(
"list_routinereport_peek: list is not initialized.")
224 cpabort(
"list_routinereport_peek: list is empty.")
242 TYPE(list_routinereport_type),
intent(inout) ::
list
243 TYPE(routine_report_type),
POINTER :: value
245 IF (.not.
ASSOCIATED(
list%arr)) &
246 cpabort(
"list_routinereport_pop: list is not initialized.")
248 cpabort(
"list_routinereport_pop: list is empty.")
263 TYPE(list_routinereport_type),
intent(inout) ::
list
266 IF (.not.
ASSOCIATED(
list%arr)) &
267 cpabort(
"list_routinereport_clear: list is not initialized.")
270 deallocate (
list%arr(i)%p)
286 TYPE(list_routinereport_type),
intent(in) ::
list
287 INTEGER,
intent(in) :: pos
288 TYPE(routine_report_type),
POINTER :: value
290 IF (.not.
ASSOCIATED(
list%arr)) &
291 cpabort(
"list_routinereport_get: list is not initialized.")
293 cpabort(
"list_routinereport_get: pos < 1")
294 IF (pos >
list%size) &
295 cpabort(
"list_routinereport_get: pos > size")
297 value =>
list%arr(pos)%p%value
310 TYPE(list_routinereport_type),
intent(inout) ::
list
311 INTEGER,
intent(in) :: pos
314 IF (.not.
ASSOCIATED(
list%arr)) &
315 cpabort(
"list_routinereport_del: list is not initialized.")
317 cpabort(
"list_routinereport_det: pos < 1")
318 IF (pos >
list%size) &
319 cpabort(
"list_routinereport_det: pos > size")
321 deallocate (
list%arr(pos)%p)
322 do i = pos,
list%size - 1
339 TYPE(list_routinereport_type),
intent(in) ::
list
342 IF (.not.
ASSOCIATED(
list%arr)) &
343 cpabort(
"list_routinereport_size: list is not initialized.")
356 SUBROUTINE change_capacity_routinereport (list, new_capacity)
357 TYPE(list_routinereport_type),
intent(inout) ::
list
358 INTEGER,
intent(in) :: new_capacity
359 INTEGER :: i, new_cap, stat
360 TYPE(private_item_p_type_routinereport),
DIMENSION(:),
POINTER :: old_arr
362 new_cap = new_capacity
364 cpabort(
"list_routinereport_change_capacity: new_capacity < 0")
365 IF (new_cap <
list%size) &
366 cpabort(
"list_routinereport_change_capacity: new_capacity < size")
367 IF (new_cap > huge(i))
THEN
368 IF (
size(
list%arr) == huge(i)) &
369 cpabort(
"list_routinereport_change_capacity: list has reached integer limit.")
374 allocate (
list%arr(new_cap), stat=stat)
376 cpabort(
"list_routinereport_change_capacity: allocation failed")
379 allocate (
list%arr(i)%p, stat=stat)
381 cpabort(
"list_routinereport_change_capacity: allocation failed")
382 list%arr(i)%p%value =>old_arr(i)%p%value
383 deallocate (old_arr(i)%p)
387 END SUBROUTINE change_capacity_routinereport
An array-based list which grows on demand. When the internal array is full, a new array of twice the ...
subroutine, public list_routinereport_destroy(list)
Deallocated the internal data-structures of the given list. Caution: If the stored values are pointer...
integer function, public list_routinereport_size(list)
Returns the current size of the list.
logical function, public list_routinereport_isready(list)
Test if the given list has been initialized.
type(routine_report_type) function, pointer, public list_routinereport_peek(list)
Returns the last element in the list. Is equivalent to: list_routinereport_get(list,...
type(routine_report_type) function, pointer, public list_routinereport_pop(list)
Returns the last element in the list and removes it. Is equivialent to: value = list_routinereport_ge...
subroutine, public list_routinereport_clear(list)
Removes all values from the list. The list itself is not deallocated.
subroutine, public list_routinereport_set(list, value, pos)
Assings the given value to the given position in the list. Thereby, the former value at that position...
subroutine, public list_routinereport_init(list, initial_capacity)
Allocates the internal data-structures of the given list. This has to be called before any of the oth...
subroutine, public list_routinereport_del(list, pos)
Removes the value at the given position from the list.
subroutine, public list_routinereport_push(list, value)
Appends the given value at the end of the list.
subroutine, public list_routinereport_insert(list, value, pos)
Inserts the given value at the givenn position within the list. Values which lay behind the insertion...
type(routine_report_type) function, pointer, public list_routinereport_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 ...
Types used by timings.F and timings_report.F The types in this module are used within dict or list,...