21 USE timings_base_type,
ONLY: callstack_entry_type, routine_report_type, routine_stat_type
24 #include "../base/base_uses.f90"
34 TYPE private_item_type_callstackentry
36 TYPE(callstack_entry_type) ::
value = callstack_entry_type()
37 END TYPE private_item_type_callstackentry
40 TYPE private_item_p_type_callstackentry
42 TYPE(private_item_type_callstackentry),
POINTER :: p => null()
43 END TYPE private_item_p_type_callstackentry
46 TYPE list_callstackentry_type
48 TYPE(private_item_p_type_callstackentry),
DIMENSION(:),
POINTER :: arr => null()
50 END TYPE list_callstackentry_type
63 TYPE(list_callstackentry_type),
intent(in) ::
list
65 res =
ASSOCIATED(
list%arr)
79 TYPE(list_callstackentry_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_callstackentry_create: initial_capacity < 0")
90 IF (
ASSOCIATED(
list%arr)) &
91 cpabort(
"list_callstackentry_create: list is already initialized.")
93 ALLOCATE (
list%arr(initial_capacity_), stat=stat)
95 cpabort(
"list_callstackentry_init: allocation failed")
110 TYPE(list_callstackentry_type),
intent(inout) ::
list
112 IF (.not.
ASSOCIATED(
list%arr)) &
113 cpabort(
"list_callstackentry_destroy: list is not initialized.")
116 deallocate (
list%arr(i)%p)
118 deallocate (
list%arr)
134 TYPE(list_callstackentry_type),
intent(inout) ::
list
135 TYPE(callstack_entry_type),
intent(in) :: value
136 INTEGER,
intent(in) :: pos
137 IF (.not.
ASSOCIATED(
list%arr)) &
138 cpabort(
"list_callstackentry_set: list is not initialized.")
140 cpabort(
"list_callstackentry_set: pos < 1")
141 IF (pos >
list%size) &
142 cpabort(
"list_callstackentry_set: pos > size")
143 list%arr(pos)%p%value =
value
155 TYPE(list_callstackentry_type),
intent(inout) ::
list
156 TYPE(callstack_entry_type),
intent(in) :: value
159 IF (.not.
ASSOCIATED(
list%arr)) &
160 cpabort(
"list_callstackentry_push: list is not initialized.")
162 call change_capacity_callstackentry (
list, 2*
size(
list%arr) + 1)
165 ALLOCATE (
list%arr(
list%size)%p, stat=stat)
167 cpabort(
"list_callstackentry_push: allocation failed")
182 TYPE(list_callstackentry_type),
intent(inout) ::
list
183 TYPE(callstack_entry_type),
intent(in) :: value
184 INTEGER,
intent(in) :: pos
187 IF (.not.
ASSOCIATED(
list%arr)) &
188 cpabort(
"list_callstackentry_insert: list is not initialized.")
190 cpabort(
"list_callstackentry_insert: pos < 1")
191 IF (pos >
list%size + 1) &
192 cpabort(
"list_callstackentry_insert: pos > size+1")
195 call change_capacity_callstackentry (
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_callstackentry_insert: allocation failed.")
205 list%arr(pos)%p%value =
value
218 TYPE(list_callstackentry_type),
intent(inout) ::
list
219 TYPE(callstack_entry_type) :: value
221 IF (.not.
ASSOCIATED(
list%arr)) &
222 cpabort(
"list_callstackentry_peek: list is not initialized.")
224 cpabort(
"list_callstackentry_peek: list is empty.")
242 TYPE(list_callstackentry_type),
intent(inout) ::
list
243 TYPE(callstack_entry_type) :: value
245 IF (.not.
ASSOCIATED(
list%arr)) &
246 cpabort(
"list_callstackentry_pop: list is not initialized.")
248 cpabort(
"list_callstackentry_pop: list is empty.")
263 TYPE(list_callstackentry_type),
intent(inout) ::
list
266 IF (.not.
ASSOCIATED(
list%arr)) &
267 cpabort(
"list_callstackentry_clear: list is not initialized.")
270 deallocate (
list%arr(i)%p)
286 TYPE(list_callstackentry_type),
intent(in) ::
list
287 INTEGER,
intent(in) :: pos
288 TYPE(callstack_entry_type) :: value
290 IF (.not.
ASSOCIATED(
list%arr)) &
291 cpabort(
"list_callstackentry_get: list is not initialized.")
293 cpabort(
"list_callstackentry_get: pos < 1")
294 IF (pos >
list%size) &
295 cpabort(
"list_callstackentry_get: pos > size")
297 value =
list%arr(pos)%p%value
310 TYPE(list_callstackentry_type),
intent(inout) ::
list
311 INTEGER,
intent(in) :: pos
314 IF (.not.
ASSOCIATED(
list%arr)) &
315 cpabort(
"list_callstackentry_del: list is not initialized.")
317 cpabort(
"list_callstackentry_det: pos < 1")
318 IF (pos >
list%size) &
319 cpabort(
"list_callstackentry_det: pos > size")
321 deallocate (
list%arr(pos)%p)
322 do i = pos,
list%size - 1
339 TYPE(list_callstackentry_type),
intent(in) ::
list
342 IF (.not.
ASSOCIATED(
list%arr)) &
343 cpabort(
"list_callstackentry_size: list is not initialized.")
356 SUBROUTINE change_capacity_callstackentry (list, new_capacity)
357 TYPE(list_callstackentry_type),
intent(inout) ::
list
358 INTEGER,
intent(in) :: new_capacity
359 INTEGER :: i, new_cap, stat
360 TYPE(private_item_p_type_callstackentry),
DIMENSION(:),
POINTER :: old_arr
362 new_cap = new_capacity
364 cpabort(
"list_callstackentry_change_capacity: new_capacity < 0")
365 IF (new_cap <
list%size) &
366 cpabort(
"list_callstackentry_change_capacity: new_capacity < size")
367 IF (new_cap > huge(i))
THEN
368 IF (
size(
list%arr) == huge(i)) &
369 cpabort(
"list_callstackentry_change_capacity: list has reached integer limit.")
374 allocate (
list%arr(new_cap), stat=stat)
376 cpabort(
"list_callstackentry_change_capacity: allocation failed")
379 allocate (
list%arr(i)%p, stat=stat)
381 cpabort(
"list_callstackentry_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_callstackentry
An array-based list which grows on demand. When the internal array is full, a new array of twice the ...
subroutine, public list_callstackentry_push(list, value)
Appends the given value at the end of the list.
subroutine, public list_callstackentry_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_callstackentry_del(list, pos)
Removes the value at the given position from the list.
integer function, public list_callstackentry_size(list)
Returns the current size of the list.
type(callstack_entry_type) function, public list_callstackentry_get(list, pos)
Returns the value at the given position from the list.
subroutine, public list_callstackentry_destroy(list)
Deallocated the internal data-structures of the given list. Caution: If the stored values are pointer...
subroutine, public list_callstackentry_insert(list, value, pos)
Inserts the given value at the givenn position within the list. Values which lay behind the insertion...
subroutine, public list_callstackentry_init(list, initial_capacity)
Allocates the internal data-structures of the given list. This has to be called before any of the oth...
type(callstack_entry_type) function, public list_callstackentry_pop(list)
Returns the last element in the list and removes it. Is equivialent to: value = list_callstackentry_g...
subroutine, public list_callstackentry_clear(list)
Removes all values from the list. The list itself is not deallocated.
type(callstack_entry_type) function, public list_callstackentry_peek(list)
Returns the last element in the list. Is equivalent to: list_callstackentry_get(list,...
logical function, public list_callstackentry_isready(list)
Test if the given list has been initialized.
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,...