Internal routine for changing the size of the internal array.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(list_routinereport_type), | intent(inout) | :: | list | |||
integer, | intent(in) | :: | new_capacity |
SUBROUTINE change_capacity_routinereport(list, new_capacity)
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
!! Internal routine for changing the size of the internal array.
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
TYPE(list_routinereport_type), intent(inout) :: list
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
INTEGER, intent(in) :: new_capacity
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
INTEGER :: i, new_cap, stat
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
TYPE(private_item_p_type_routinereport), DIMENSION(:), POINTER :: old_arr
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
new_cap = new_capacity
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
IF(new_cap < 0) &
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
DBCSR_ABORT("list_routinereport_change_capacity: new_capacity < 0")
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
IF(new_cap < list%size) &
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
DBCSR_ABORT("list_routinereport_change_capacity: new_capacity < size")
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
IF(new_cap > HUGE(i)) THEN
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
IF(size(list%arr) == HUGE(i)) &
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
DBCSR_ABORT("list_routinereport_change_capacity: list has reached integer limit.")
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
new_cap = HUGE(i) ! grow as far as possible
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
END IF
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
old_arr => list%arr
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
allocate(list%arr(new_cap), stat=stat)
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
IF (stat/=0)&
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
DBCSR_ABORT("list_routinereport_change_capacity: allocation failed")
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
do i=1, list%size
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
allocate(list%arr(i)%p, stat=stat)
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
IF (stat/=0)&
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
DBCSR_ABORT("list_routinereport_change_capacity: allocation failed")
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
list%arr(i)%p%value => old_arr(i)%p%value
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
deallocate(old_arr(i)%p)
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
end do
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
deallocate(old_arr)
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinereport.F"
END SUBROUTINE change_capacity_routinereport