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