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