double_map_add Subroutine

subroutine double_map_add(src_map, dst_map, src_ptr, dst_ptr)

Add pointer pair to double-array map (grow if needed)

Arguments

Type IntentOptional Attributes Name
type(array_ptr), allocatable :: src_map(:)
type(array_ptr), allocatable :: dst_map(:)
type(array_type), intent(in), target :: src_ptr
type(array_type), intent(in), target :: dst_ptr

Source Code

  subroutine double_map_add(src_map, dst_map, src_ptr, dst_ptr)
    !! Add pointer pair to double-array map (grow if needed)
    implicit none
    type(array_ptr), allocatable :: src_map(:), dst_map(:)
    type(array_type), intent(in), target :: src_ptr, dst_ptr
    integer :: n, i, newcap
    if(.not. allocated(src_map)) allocate(src_map(diffstruc__init_map_cap))
    if(.not. allocated(dst_map)) allocate(dst_map(diffstruc__init_map_cap))
    n = size(src_map)
    ! find first null slot
    do i = 1, n
       if(.not. associated(src_map(i)%p))then
          src_map(i)%p => src_ptr
          dst_map(i)%p => dst_ptr
          return
       end if
    end do
    ! no slot -> grow (double capacity)
    newcap = n
    block
      type(array_ptr) :: src_tmp(n), dst_tmp(n)
      src_tmp = src_map
      dst_tmp = dst_map
      deallocate(src_map, dst_map)
      allocate(src_map(n + newcap))
      allocate(dst_map(n + newcap))
      src_map(1:n) = src_tmp
      dst_map(1:n) = dst_tmp
    end block
    ! store at next free
    src_map(n+1)%p => src_ptr
    dst_map(n+1)%p => dst_ptr
  end subroutine double_map_add