1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
| module graph_adapter_module use legacy_graph_module use graph_interface_module implicit none private
type, public, extends(Graph) :: GraphAdapter private type(LegacyGraph) :: legacy_graph integer, dimension(:), allocatable :: vertex_list character(len=100), dimension(4) :: vertices contains procedure :: add_vertex procedure :: add_edge => add_edge_adapter procedure :: find_shortest_path => find_shortest_path_adapter end type GraphAdapter
interface GraphAdapter module procedure :: graph_adapter_constructor end interface GraphAdapter
contains
function graph_adapter_constructor(vertices) result(graph_) integer, intent(in) :: vertices type(GraphAdapter) :: graph_ continue graph_%legacy_graph = LegacyGraph(vertices) end function graph_adapter_constructor
subroutine add_vertex(this, name) class(GraphAdapter), intent(inout) :: this character(len=*), intent(in) :: name integer :: i
if (size(this%vertex_list) == 0) then allocate(this%vertex_list(4)) this%vertex_list = 0 end if
do i = 1, size(this%vertex_list) if (this%vertex_list(i) == 0) then this%vertex_list(i) = len_trim(trim(name)) this%vertices(i) = name exit end if end do end subroutine add_vertex
subroutine add_edge_adapter(this, from, to, weight) class(GraphAdapter), intent(inout) :: this character(len=*), intent(in) :: from, to integer, intent(in) :: weight integer :: src, dest
src = find_vertex_index(this%vertices, from) dest = find_vertex_index(this%vertices, to)
if (src > 0 .and. dest > 0) then call this%legacy_graph%ptr_add_edge(src, dest, weight) else print *, "Vertex not found" end if end subroutine add_edge_adapter
integer function find_shortest_path_adapter(this, start, end_node) class(GraphAdapter), intent(in) :: this character(len=*), intent(in) :: start, end_node integer :: src, dest
src = find_vertex_index(this%vertices, start) dest = find_vertex_index(this%vertices, end_node)
if (src > 0 .and. dest > 0) then find_shortest_path_adapter = this%legacy_graph%ptr_compute_shortest_path(src, dest) else find_shortest_path_adapter = -1 end if end function find_shortest_path_adapter
integer function find_vertex_index(vertices, name) character(len=*), dimension(:), intent(in) :: vertices character(len=*), intent(in) :: name integer :: i
find_vertex_index = -1 do i = 1, size(vertices) if (vertices(i) == name) then find_vertex_index = i exit end if end do end function find_vertex_index
end module graph_adapter_module
|