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
    
    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