tem_appendDp2dArray Subroutine

private subroutine tem_appendDp2dArray(Array, Position1, Position2, Value)

append an entry to an allocatable array 1d with double precision If the array is too small, reallocate with double size

Arguments

Type IntentOptional Attributes Name
real(kind=rk), intent(inout), allocatable :: Array(:,:)

array to append value to
integer, intent(in) :: Position1
integer, intent(in) :: Position2
real(kind=rk), intent(in) :: Value

value to append

Called by

proc~~tem_appenddp2darray~~CalledByGraph proc~tem_appenddp2darray tem_appendDp2dArray interface~append~2 append interface~append~2->proc~tem_appenddp2darray proc~tem_calc_vrtx_coord tem_calc_vrtx_coord proc~tem_calc_vrtx_coord->interface~append~2 proc~tem_unify_vrtx tem_unify_vrtx proc~tem_calc_vrtx_coord->proc~tem_unify_vrtx proc~tem_findelement tem_findElement proc~tem_findelement->interface~append~2 proc~tem_findelement->proc~tem_findelement proc~tem_findpath tem_findPath proc~tem_findpath->interface~append~2 proc~tem_findpath->proc~tem_findpath proc~tem_unify_vrtx->interface~append~2 proc~hvs_output_init hvs_output_init proc~hvs_output_init->proc~tem_calc_vrtx_coord proc~tem_init_tracker tem_init_tracker proc~tem_init_tracker->proc~hvs_output_init

Source Code

  subroutine tem_appendDp2dArray(Array, Position1, Position2, Value )
    ! ---------------------------------------------------------------------------
    !> array to append value to
    real(kind=rk),intent(inout), allocatable :: Array(:,:)
    !>
    integer,intent(in) :: Position1
    !>
    integer,intent(in) :: Position2
    !> value to append
    real(kind=rk),intent(in) :: Value
    ! ---------------------------------------------------------------------------
    real(kind=rk),allocatable :: tempArray(:,:)
    integer :: ArraySize1,ArraySize2,ierr
    integer :: NewSize1,NewSize2
    logical :: changeSize
    logical :: sizeZero
    ! ---------------------------------------------------------------------------

    ! Get size of array
    ArraySize1 = size(Array,1)
    ArraySize2 = size(Array,2)
    changeSize = .false.
    sizeZero   = .false.

    ! Compare position, where to store with size
    if(Position1 .gt. ArraySize1) then
      if( ArraySize1 .eq. 0) then
         ArraySize1 = 1
         sizeZero  = .true.
      endif
      NewSize1 = max( Position1, ArraySize1*2)
      changeSize = .true.
    else
      NewSize1 = ArraySize1
    endif
    if(Position2 .gt. ArraySize2) then
      if( ArraySize2 .eq. 0) then
         ArraySize2 = 1
         sizeZero  = .true.
      endif
      NewSize2 = max( Position2, ArraySize2*2 )
      changeSize = .true.
    else
      NewSize2 = ArraySize2
    endif

    if(changeSize) then
      ! allocate temporary array with double size
      allocate(tempArray(NewSize1, NewSize2),stat=ierr)
      ! Copy to temp array
      if(.not. sizeZero)                                                       &
        & tempArray( 1:ArraySize1,1:ArraySize2 ) =                             &
        &                                    Array( 1:ArraySize1,1:ArraySize2 )
      ! Deallocate Array
      deallocate(Array)
      ! Reallocate Array
      allocate(Array(NewSize1, NewSize2),stat=ierr)
      Array(1:ArraySize1,1:ArraySize2) = tempArray(1:ArraySize1,1:ArraySize2)
      ! Deallocate temp array
      deallocate(tempArray)
      if(ierr .ne. 0) Write(*,*) 'Error in reallocating array'
    endif

    Array(Position1,Position2) = Value

  end subroutine tem_appendDp2dArray