xdmf_obj_Resize Subroutine

private pure subroutine xdmf_obj_Resize(this, size_target)

Resizes the fields array in an xdmf object. Note that resizing occurs in increaments of size (RESIZE_INCREMENT). By default, RESIZE_INCREMENT=10, meaning that if resizing occurs, it will increase or reduce the array size by 10 slots. This is done to avoid frequent reallocating.

Type Bound

xdmf_obj

Arguments

Type IntentOptional Attributes Name
class(xdmf_obj), intent(inout) :: this

XDMF object

integer, intent(in) :: size_target

Target new size


Called by

proc~~xdmf_obj_resize~~CalledByGraph proc~xdmf_obj_resize xdmf_obj%xdmf_obj_Resize proc~xdmf_obj_addfield xdmf_obj%xdmf_obj_AddField proc~xdmf_obj_addfield->proc~xdmf_obj_resize proc~xdmf_obj_init xdmf_obj%xdmf_obj_Init proc~xdmf_obj_init->proc~xdmf_obj_resize proc~eulerian_set_readhdf5 eulerian_set%eulerian_set_ReadHDF5 proc~eulerian_set_readhdf5->proc~xdmf_obj_addfield

Source Code

    pure subroutine xdmf_obj_Resize(this,size_target)
      !> Resizes the fields array in an xdmf object.
      ! Note that resizing occurs in increaments of size (RESIZE_INCREMENT).
      ! By default, RESIZE_INCREMENT=10, meaning that if resizing occurs,
      ! it will increase or reduce the array size by 10 slots. This is done
      ! to avoid frequent reallocating.
      implicit none
      class(xdmf_obj), intent(inout) :: this                                   !! XDMF object
      integer,         intent(in)    :: size_target                            !! Target new size
      ! Work variables
      type(xdmf_attribute_obj), &
             allocatable :: tmp(:)
      integer            :: size_old
      integer            :: size_new
      integer            :: n
      integer, parameter :: RESIZE_INCREMENT = 10

      if (.not.allocated(this%fields)) then
        ! the array is of size 0

        if (size_target.ne.0) allocate(this%fields(size_target))

      else if (size_target.eq.0) then
        ! the array is allocated, but we want to empty it

        deallocate(this%fields)

      else
        ! Update non zero size to another non zero size

        size_old = size(this%fields)

        if (size_target.gt.size_old) then
          ! Increase from size_old to size_new

          size_new = max(size_target,int(size_old+RESIZE_INCREMENT))

          ! Allocate temporary array
          allocate(tmp(size_new))

          ! Store values
          do n=1,size_old
            tmp(n)=this%fields(n)
          end do

          ! Move the allocation from the
          ! temporary array to the final one
          call move_alloc(tmp,this%fields)

        else if (size_target.lt.size_old-RESIZE_INCREMENT) then
          ! Decrease from size_old to size_new

          ! Allocate temporary array
          allocate(tmp(size_target))

          ! Store values
          do n=1,size_target
            tmp(n)=this%fields(n)
          end do

          ! Move the allocation from the
          ! temporary array to the final one
          call move_alloc(tmp,this%fields)
        end if
      end if

      ! Update count info
      this%fields_count=size_target

      return
    end subroutine xdmf_obj_Resize