24#include "../base/base_uses.f90"
33 TYPE private_item_type_timerenv
35 TYPE(timer_env_type),
POINTER ::
value => null()
36 END TYPE private_item_type_timerenv
39 TYPE private_item_p_type_timerenv
41 TYPE(private_item_type_timerenv),
POINTER :: p => null()
42 END TYPE private_item_p_type_timerenv
47 TYPE(private_item_p_type_timerenv),
DIMENSION(:),
POINTER :: arr => null()
64 res =
ASSOCIATED(
list%arr)
79 INTEGER,
INTENT(in),
OPTIONAL :: initial_capacity
81 INTEGER :: initial_capacity_
83 initial_capacity_ = 11
84 If (
PRESENT(initial_capacity)) initial_capacity_ = initial_capacity
86 IF (initial_capacity_ < 0) &
87 cpabort(
"list_timerenv_create: initial_capacity < 0")
89 IF (
ASSOCIATED(
list%arr)) &
90 cpabort(
"list_timerenv_create: list is already initialized.")
92 ALLOCATE (
list%arr(initial_capacity_), stat=stat)
94 cpabort(
"list_timerenv_init: allocation failed")
111 IF (.not.
ASSOCIATED(
list%arr)) &
112 cpabort(
"list_timerenv_destroy: list is not initialized.")
115 deallocate (
list%arr(i)%p)
117 deallocate (
list%arr)
135 INTEGER,
intent(in) :: pos
136 IF (.not.
ASSOCIATED(
list%arr)) &
137 cpabort(
"list_timerenv_set: list is not initialized.")
139 cpabort(
"list_timerenv_set: pos < 1")
140 IF (pos >
list%size) &
141 cpabort(
"list_timerenv_set: pos > size")
142 list%arr(pos)%p%value =>
value
158 IF (.not.
ASSOCIATED(
list%arr)) &
159 cpabort(
"list_timerenv_push: list is not initialized.")
161 call change_capacity_timerenv (
list, 2*
size(
list%arr) + 1)
164 ALLOCATE (
list%arr(
list%size)%p, stat=stat)
166 cpabort(
"list_timerenv_push: allocation failed")
183 INTEGER,
intent(in) :: pos
186 IF (.not.
ASSOCIATED(
list%arr)) &
187 cpabort(
"list_timerenv_insert: list is not initialized.")
189 cpabort(
"list_timerenv_insert: pos < 1")
190 IF (pos >
list%size + 1) &
191 cpabort(
"list_timerenv_insert: pos > size+1")
194 call change_capacity_timerenv (
list, 2*
size(
list%arr) + 1)
197 do i =
list%size, pos + 1, -1
201 ALLOCATE (
list%arr(pos)%p, stat=stat)
203 cpabort(
"list_timerenv_insert: allocation failed.")
204 list%arr(pos)%p%value =>
value
220 IF (.not.
ASSOCIATED(
list%arr)) &
221 cpabort(
"list_timerenv_peek: list is not initialized.")
223 cpabort(
"list_timerenv_peek: list is empty.")
244 IF (.not.
ASSOCIATED(
list%arr)) &
245 cpabort(
"list_timerenv_pop: list is not initialized.")
247 cpabort(
"list_timerenv_pop: list is empty.")
265 IF (.not.
ASSOCIATED(
list%arr)) &
266 cpabort(
"list_timerenv_clear: list is not initialized.")
269 deallocate (
list%arr(i)%p)
286 INTEGER,
intent(in) :: pos
289 IF (.not.
ASSOCIATED(
list%arr)) &
290 cpabort(
"list_timerenv_get: list is not initialized.")
292 cpabort(
"list_timerenv_get: pos < 1")
293 IF (pos >
list%size) &
294 cpabort(
"list_timerenv_get: pos > size")
296 value =>
list%arr(pos)%p%value
310 INTEGER,
intent(in) :: pos
313 IF (.not.
ASSOCIATED(
list%arr)) &
314 cpabort(
"list_timerenv_del: list is not initialized.")
316 cpabort(
"list_timerenv_det: pos < 1")
317 IF (pos >
list%size) &
318 cpabort(
"list_timerenv_det: pos > size")
320 deallocate (
list%arr(pos)%p)
321 do i = pos,
list%size - 1
341 IF (.not.
ASSOCIATED(
list%arr)) &
342 cpabort(
"list_timerenv_size: list is not initialized.")
355 SUBROUTINE change_capacity_timerenv (list, new_capacity)
357 INTEGER,
intent(in) :: new_capacity
358 INTEGER :: i, new_cap, stat
359 TYPE(private_item_p_type_timerenv),
DIMENSION(:),
POINTER :: old_arr
361 new_cap = new_capacity
363 cpabort(
"list_timerenv_change_capacity: new_capacity < 0")
364 IF (new_cap <
list%size) &
365 cpabort(
"list_timerenv_change_capacity: new_capacity < size")
366 IF (new_cap > huge(i))
THEN
367 IF (
size(
list%arr) == huge(i)) &
368 cpabort(
"list_timerenv_change_capacity: list has reached integer limit.")
373 allocate (
list%arr(new_cap), stat=stat)
375 cpabort(
"list_timerenv_change_capacity: allocation failed")
378 allocate (
list%arr(i)%p, stat=stat)
380 cpabort(
"list_timerenv_change_capacity: allocation failed")
381 list%arr(i)%p%value =>old_arr(i)%p%value
382 deallocate (old_arr(i)%p)
386 END SUBROUTINE change_capacity_timerenv
An array-based list which grows on demand. When the internal array is full, a new array of twice the ...
integer function, public list_timerenv_size(list)
Returns the current size of the list.
type(timer_env_type) function, pointer, public list_timerenv_get(list, pos)
Returns the value at the given position from the list.
subroutine, public list_timerenv_init(list, initial_capacity)
Allocates the internal data-structures of the given list. This has to be called before any of the oth...
logical function, public list_timerenv_isready(list)
Test if the given list has been initialized.
type(timer_env_type) function, pointer, public list_timerenv_pop(list)
Returns the last element in the list and removes it. Is equivialent to: value = list_timerenv_get(lis...
subroutine, public list_timerenv_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_timerenv_insert(list, value, pos)
Inserts the given value at the givenn position within the list. Values which lay behind the insertion...
subroutine, public list_timerenv_clear(list)
Removes all values from the list. The list itself is not deallocated.
subroutine, public list_timerenv_push(list, value)
Appends the given value at the end of the list.
subroutine, public list_timerenv_del(list, pos)
Removes the value at the given position from the list.
subroutine, public list_timerenv_destroy(list)
Deallocated the internal data-structures of the given list. Caution: If the stored values are pointer...
type(timer_env_type) function, pointer, public list_timerenv_peek(list)
Returns the last element in the list. Is equivalent to: list_timerenv_get(list, list_timerenv_size(li...
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 Due to the fortran restriction on cicular module-depende...