list_routinestat_insert Subroutine

public subroutine list_routinestat_insert(list, value, pos)

Inserts the given value at the given position within the list. Values which lay behind the insertion-position move one position up.

Arguments

Type IntentOptional Attributes Name
type(list_routinestat_type), intent(inout) :: list
type(routine_stat_type), intent(in), POINTER :: value
integer, intent(in) :: pos

Position in the list - must fulfill 0 < pos < list_size+2 .

Source Code

SUBROUTINE list_routinestat_insert(list, value, pos)
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
   !! Inserts the given value at the given position within the list.
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
   !! Values which lay behind the insertion-position move one position up.
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"

# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
    TYPE(list_routinestat_type), intent(inout)  :: list
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
    TYPE(routine_stat_type), POINTER, intent(in) :: value
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
    INTEGER, intent(in) :: pos
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
      !! Position in the list - must fulfill 0 < pos < list_size+2 .
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
    INTEGER :: i, stat
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"

# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
    IF(.not. ASSOCIATED(list%arr)) &
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
       DBCSR_ABORT("list_routinestat_insert: list is not initialized.")
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
    IF(pos < 1)&
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
       DBCSR_ABORT("list_routinestat_insert: pos < 1")
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
    IF(pos > list%size+1)&
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
       DBCSR_ABORT("list_routinestat_insert: pos > size+1")
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"

# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
    if(list%size == size(list%arr)) &
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
       call change_capacity_routinestat(list, 2*size(list%arr)+1)
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"

# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
    list%size = list%size + 1
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
    do i=list%size, pos+1, -1
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
       list%arr(i)%p => list%arr(i-1)%p
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
    end do
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"

# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
    ALLOCATE(list%arr(pos)%p, stat=stat)
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
     IF (stat/=0)&
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
        DBCSR_ABORT("list_routinestat_insert: allocation failed.")
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
    list%arr(pos)%p%value => value
# 21 "/__w/dbcsr/dbcsr/src/core/dbcsr_list_routinestat.F"
END SUBROUTINE list_routinestat_insert