change_capacity_routinereport Subroutine

private subroutine change_capacity_routinereport(list, new_capacity)

Internal routine for changing the size of the internal array.

Arguments

Type IntentOptional Attributes Name
type(list_routinereport_type), intent(inout) :: list
integer, intent(in) :: new_capacity

Source Code

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