# 1 "/home/admin/SimulationCore2/Common/DynamicDoubleArray.f90" module DynamicDoubleArray implicit none public type, public :: DynamicDoubleArrayType real(8), allocatable :: Array(:) contains procedure :: First => First procedure :: Last => Last procedure :: Length => Length procedure :: Add => Add procedure :: AddToFirst => AddToFirst procedure :: AddTo => AddTo procedure :: Remove => Remove procedure :: Empty => Empty end type DynamicDoubleArrayType private::First,Last,Length contains real(8) function First(this) implicit none class(DynamicDoubleArrayType), intent(in) :: this if(allocated(this%Array) .and. size(this%Array) > 0) then First = this%Array(1) return end if First = 0 end function real(8) function Last(this) implicit none class(DynamicDoubleArrayType), intent(in) :: this if(allocated(this%Array) .and. size(this%Array) > 0) then Last = this%Array(size(this%Array)) return end if Last = 0 end function integer function Length(this) implicit none class(DynamicDoubleArrayType), intent(in) :: this if(allocated(this%Array)) then Length = size(this%Array) return end if Length = 0 end function subroutine AddToFirst(this, value) implicit none class(DynamicDoubleArrayType), intent(inout) :: this real(8), allocatable :: tempArr(:) real(8), intent(in) :: value integer :: i, isize if(allocated(this%Array)) then isize = size(this%Array) allocate(tempArr(isize+1)) tempArr(1) = value do i=2,isize+1 tempArr(i) = this%Array(i-1) end do deallocate(this%Array) call move_alloc(tempArr, this%Array) else allocate(this%Array(1)) this%Array(1) = value end if end subroutine subroutine AddTo(this, index, value) implicit none class(DynamicDoubleArrayType), intent(inout) :: this real(8), allocatable :: tempArr(:) integer, intent(in) :: index real(8), intent(in) :: value integer :: isize if(index <= 0) return if(index > size(this%Array)) then call this%Add(value) return endif if(allocated(this%Array)) then isize = size(this%Array) allocate(tempArr(isize+1)) tempArr(:index-1) = this%Array(:index-1) tempArr(index) = value tempArr(index+1:) = this%Array(index:) deallocate(this%Array) call move_alloc(tempArr, this%Array) end if end subroutine subroutine Add(this, value) implicit none class(DynamicDoubleArrayType), intent(inout) :: this real(8), allocatable :: tempArr(:) real(8), intent(in) :: value integer :: i, isize if(allocated(this%Array)) then isize = size(this%Array) allocate(tempArr(isize+1)) do i=1,isize tempArr(i) = this%Array(i) end do tempArr(isize+1) = value deallocate(this%Array) call move_alloc(tempArr, this%Array) else allocate(this%Array(1)) this%Array(1) = value end if end subroutine subroutine Empty(this) implicit none class(DynamicDoubleArrayType), intent(inout) :: this if(allocated(this%Array)) deallocate(this%Array) end subroutine subroutine Remove(this, index) implicit none class(DynamicDoubleArrayType), intent(inout) :: this integer, intent(in) :: index real(8), allocatable :: tempArr(:) integer :: i logical :: found if(index <= 0 .or. index > size(this%Array)) return if(.not.allocated(this%Array))return allocate(tempArr(size(this%Array)-1)) found = .false. do i=1, size(this%Array) if(i==index) then found = .true. cycle end if if(found) then tempArr(i-1) = this%Array(i) else tempArr(i) = this%Array(i) endif end do deallocate(this%Array) call move_alloc(tempArr, this%Array) end subroutine end module DynamicDoubleArray