SimulationCore2/CSharp/Equipments/MudPathFinding/CArrangement.i90

# 1 "/home/admin/SimulationCore2/CSharp/Equipments/MudPathFinding/CArrangement.f90"
module CArrangement
    implicit none    
    public    
    
    integer, parameter :: Normal = 0
    integer, parameter :: Relation = 1
    integer, parameter :: Input = 2
    integer, parameter :: Output = 3
    integer, parameter :: InputOutput = 4
    
    
    type, public :: Arrangement
        integer, allocatable :: Adjacent(:) !adjacent valves that is connected to this valve
        logical :: Status !valve status ... open/close ... true/false
        integer :: ValveType ! Normal/Input/Output/InputOutput
        integer :: Number
        logical :: IsTraversed
        contains
        procedure :: Init => Init 
        procedure :: IsConnectedTo => IsConnectedTo 
        procedure :: IsSource => IsSource 
        procedure :: Length => Length
        procedure :: AdjacentTo => AdjacentTo 
        procedure :: RemoveAdjacent => RemoveAdjacent
    end type Arrangement
    contains  
    
    subroutine Init(this, value)
        implicit none
        class(Arrangement), intent(inout) :: this
        integer, intent(in) :: value
        if(allocated(this%Adjacent)) deallocate(this%Adjacent)
        this%Status = .false.
        this%IsTraversed = .false.
        this%ValveType = Normal
        this%Number = value
    end subroutine
    
    integer function Length(this)
        implicit none
        class(Arrangement), intent(in) :: this
        if(allocated(this%Adjacent)) then 
            Length = size(this%Adjacent)
            return
        end if
        Length = 0
    end function
    
    subroutine AdjacentTo(this, value)
        implicit none
        class(Arrangement), intent(inout) :: this
        integer, intent(in) :: value
        integer, allocatable :: tempArr(:)
        integer :: i, isize
        
        if(allocated(this%Adjacent)) then
            isize = size(this%Adjacent)
            
! check to see if already AdjacentTo that valve#
            do i=1,isize          
                if(this%Adjacent(i)==value) return
            end do
            
! if value is a new entry then add it to the collection
            allocate(tempArr(isize+1))
            do i=1,isize          
                tempArr(i) = this%Adjacent(i)
            end do
            tempArr(isize+1) = value
            deallocate(this%Adjacent)
            call move_alloc(tempArr, this%Adjacent)
        else
            allocate(this%Adjacent(1))
            this%Adjacent(1) = value
        end if
    end subroutine
    
    logical function IsConnectedTo(this, value) 
        implicit none
        class(Arrangement), intent(in) :: this
        integer, intent(in) :: value
        if(.not.allocated(this%Adjacent)) then
            IsConnectedTo = .false.
            return
        endif
        IsConnectedTo = any(this%Adjacent == value)
        return
    end function
    
    logical function IsSource(this) 
        implicit none
        class(Arrangement), intent(in) :: this
        IsSource = this%ValveType > Relation
    end function
    
    
    
    subroutine RemoveAdjacent(this, value)
        implicit none
        class(Arrangement), intent(inout) :: this
        integer, intent(in) :: value
        integer, allocatable :: tempArr(:)
        integer :: i, index, isize 
        logical :: found
        
        if(.not.allocated(this%Adjacent))return
        index = -1
        do i=1, size(this%Adjacent)
            if(this%Adjacent(i)==value) then
                index = i
                exit
            end if
        end do
        
        if(index <= 0 .or. index > size(this%Adjacent)) return
        
        allocate(tempArr(size(this%Adjacent)-1))
        found = .false.
        do i=1, size(this%Adjacent)
            if(i==index) then
                found = .true.
                cycle
            end if
            if(found) then
                tempArr(i-1) = this%Adjacent(i)
            else 
                tempArr(i) = this%Adjacent(i)
            endif
        end do
        deallocate(this%Adjacent)
        call move_alloc(tempArr, this%Adjacent)
        
        
    end subroutine
    
    
end module CArrangement