diff --git a/index.html b/index.html index 1033e6c..6ac48f7 100644 --- a/index.html +++ b/index.html @@ -221,7 +221,7 @@

Modules

Procedures

- +
+
+ +
+

private subroutine dag_add_edge(me, ivertex, iedge, label, attributes) +

+
+ +

Add an edge to a dag.

+ +

Arguments

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
TypeIntentOptional AttributesName
+ + class(dag), + intent(inout) + + ::me + +
+ + integer(kind=ip), + intent(in) + + ::ivertex +

vertex number

+
+ + integer(kind=ip), + intent(in) + + ::iedge +

the vertex to connect to ivertex

+
+ + character(len=*), + intent(in),optional + + ::label +

edge label

+
+ + character(len=*), + intent(in),optional + + ::attributes +

other attributes when +saving as a diagraph.

+
+ +
@@ -1910,7 +2017,7 @@

Arguments

- + integer(kind=ip), intent(in) @@ -1965,7 +2072,7 @@

Arguments

- + class(dag), intent(inout) @@ -1980,7 +2087,7 @@

Arguments

- + integer(kind=ip), intent(in) @@ -1995,7 +2102,7 @@

Arguments

- + integer(kind=ip), intent(in) @@ -2050,7 +2157,7 @@

Arguments

- + integer(kind=ip), intent(in) @@ -2080,7 +2187,7 @@

Arguments

- + character(len=*), intent(in), @@ -2096,7 +2203,7 @@

Arguments

- + character(len=*), intent(in), @@ -2136,7 +2243,7 @@

Arguments

- + class(dag), intent(inout) @@ -2176,7 +2283,7 @@

Arguments

- + class(dag), intent(inout) @@ -2246,7 +2353,7 @@

Arguments

- + class(dag), intent(in) @@ -2301,7 +2408,7 @@

Arguments

- + class(dag), intent(in) diff --git a/proc/add_edge.html b/proc/add_edge.html index bfc003d..d888144 100644 --- a/proc/add_edge.html +++ b/proc/add_edge.html @@ -71,7 +71,7 @@

add_edge
  • 14 statements + title=" 3.3% of total for procedures.">14 statements
  • @@ -188,7 +188,7 @@

    Arguments

    - + character(len=*), intent(in), @@ -365,82 +365,97 @@

    Called by

    - - + + proc~~add_edge~~CalledByGraph - + proc~add_edge - -dag_module::vertex%add_edge + +dag_module::vertex%add_edge none~set_edges - -dag_module::vertex%set_edges + +dag_module::vertex%set_edges none~set_edges->proc~add_edge - - + + proc~set_edge_vector_vector - -dag_module::vertex%set_edge_vector_vector + +dag_module::vertex%set_edge_vector_vector - + none~set_edges->proc~set_edge_vector_vector - - + + proc~set_edge_vector_vector->proc~add_edge - - + + - + +proc~dag_add_edge + + +dag_module::dag%dag_add_edge + + + + + +proc~dag_add_edge->none~set_edges + + + + + proc~dag_set_edges_no_atts - + dag_module::dag%dag_set_edges_no_atts - + proc~dag_set_edges_no_atts->none~set_edges - - + + - + proc~dag_set_edges_vector_atts - + dag_module::dag%dag_set_edges_vector_atts - + proc~dag_set_edges_vector_atts->none~set_edges - - + + diff --git a/proc/dag_add_edge.html b/proc/dag_add_edge.html new file mode 100644 index 0000000..65f5e6b --- /dev/null +++ b/proc/dag_add_edge.html @@ -0,0 +1,504 @@ + + + + + + + + + + + dag_add_edge – daglib + + + + + + + + + + + + + +
    + +
    + +
    +
    +

    dag_add_edge + Subroutine + +

    +
    +
    +
    + +
    +
    + +
    +
    +
    + + +
    + +
    + + +
    +

    private subroutine dag_add_edge(me, ivertex, iedge, label, attributes) +

    + + +

    Add an edge to a dag.

    + +

    Type Bound

    +

    dag

    + +

    Arguments

    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    TypeIntentOptional AttributesName
    + + class(dag), + intent(inout) + + ::me + +
    + + integer(kind=ip), + intent(in) + + ::ivertex +

    vertex number

    +
    + + integer(kind=ip), + intent(in) + + ::iedge +

    the vertex to connect to ivertex

    +
    + + character(len=*), + intent(in),optional + + ::label +

    edge label

    +
    + + character(len=*), + intent(in),optional + + ::attributes +

    other attributes when +saving as a diagraph.

    +
    + +
    +
    +
    +

    Calls

    +
    +
    +
    + + + + + +proc~~dag_add_edge~~CallsGraph + + + +proc~dag_add_edge + +dag_module::dag%dag_add_edge + + + +none~set_edges + + +dag_module::vertex%set_edges + + + + + +proc~dag_add_edge->none~set_edges + + + + + +proc~add_edge + + +dag_module::vertex%add_edge + + + + + +none~set_edges->proc~add_edge + + + + + +proc~set_edge_vector_vector + + +dag_module::vertex%set_edge_vector_vector + + + + + +none~set_edges->proc~set_edge_vector_vector + + + + + +proc~sort_ascending + + +dag_module::sort_ascending + + + + + +proc~add_edge->proc~sort_ascending + + + + + +proc~set_edge_vector_vector->proc~add_edge + + + + + +proc~swap + + +dag_module::swap + + + + + +proc~sort_ascending->proc~swap + + + + + +
    + +
    +
    +
    + + + + + + + + + + + +
    +

    Source Code

    + 
        subroutine dag_add_edge(me,ivertex,iedge,label,attributes)
+
+    class(dag),intent(inout) :: me
+    integer(ip),intent(in)   :: ivertex !! vertex number
+    integer(ip),intent(in)   :: iedge   !! the vertex to connect to `ivertex`
+    character(len=*),intent(in),optional :: label !! edge label
+    character(len=*),intent(in),optional :: attributes !! other attributes when
+                                                       !! saving as a diagraph.
+
+    call me%vertices(ivertex)%set_edges(iedge,&
+                        label=label,&
+                        attributes=attributes)
+
+    end subroutine dag_add_edge
+
    + +
    +
    + +
    +
    + +
    +
    +
    +
    +
    +

    daglib was developed by Jacob Williams
    © 2023 +

    +
    +
    +

    + Documentation generated by + FORD +

    +
    +
    +
    +
    +
    + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/proc/dag_destroy.html b/proc/dag_destroy.html index 5e0acb2..2513446 100644 --- a/proc/dag_destroy.html +++ b/proc/dag_destroy.html @@ -158,7 +158,7 @@

    Arguments

    - + class(dag), intent(inout) diff --git a/proc/dag_generate_dependency_matrix.html b/proc/dag_generate_dependency_matrix.html index 4b2bfc6..56512d9 100644 --- a/proc/dag_generate_dependency_matrix.html +++ b/proc/dag_generate_dependency_matrix.html @@ -71,7 +71,7 @@

    dag_generate_dependency_matrix
  • 17 statements + title=" 4.0% of total for procedures.">17 statements
  • @@ -160,7 +160,7 @@

    Arguments

    - + class(dag), intent(in) diff --git a/proc/dag_generate_digraph.html b/proc/dag_generate_digraph.html index dced844..a054135 100644 --- a/proc/dag_generate_digraph.html +++ b/proc/dag_generate_digraph.html @@ -71,7 +71,7 @@

    dag_generate_digraph
  • 70 statements + title="16.5% of total for procedures.">70 statements
  • @@ -163,7 +163,7 @@

    Arguments

    - + class(dag), intent(in) diff --git a/proc/dag_get_dependencies.html b/proc/dag_get_dependencies.html index 7e38046..80e1140 100644 --- a/proc/dag_get_dependencies.html +++ b/proc/dag_get_dependencies.html @@ -71,7 +71,7 @@

    dag_get_dependencies
  • 19 statements + title=" 4.5% of total for procedures.">19 statements
  • @@ -158,7 +158,7 @@

    Arguments

    - + class(dag), intent(in) @@ -173,7 +173,7 @@

    Arguments

    - + integer(kind=ip), intent(in) diff --git a/proc/dag_get_edges.html b/proc/dag_get_edges.html index 68bf89e..232eca0 100644 --- a/proc/dag_get_edges.html +++ b/proc/dag_get_edges.html @@ -159,7 +159,7 @@

    Arguments

    - + class(dag), intent(in) @@ -174,7 +174,7 @@

    Arguments

    - + integer(kind=ip), intent(in) diff --git a/proc/dag_remove_edge.html b/proc/dag_remove_edge.html index 55e747c..56c01f3 100644 --- a/proc/dag_remove_edge.html +++ b/proc/dag_remove_edge.html @@ -158,7 +158,7 @@

    Arguments

    - + class(dag), intent(inout) @@ -173,7 +173,7 @@

    Arguments

    - + integer(kind=ip), intent(in) @@ -188,7 +188,7 @@

    Arguments

    - + integer(kind=ip), intent(in) diff --git a/proc/dag_remove_node.html b/proc/dag_remove_node.html index 065f0bb..f31509d 100644 --- a/proc/dag_remove_node.html +++ b/proc/dag_remove_node.html @@ -71,7 +71,7 @@

    dag_remove_node
  • 24 statements + title=" 5.7% of total for procedures.">24 statements
  • @@ -161,7 +161,7 @@

    Arguments

    - + class(dag), intent(inout) diff --git a/proc/dag_save_digraph.html b/proc/dag_save_digraph.html index 4cd3bcd..7efdb6f 100644 --- a/proc/dag_save_digraph.html +++ b/proc/dag_save_digraph.html @@ -71,7 +71,7 @@

    dag_save_digraph
  • 16 statements + title=" 3.8% of total for procedures.">16 statements
  • @@ -158,7 +158,7 @@

    Arguments

    - + class(dag), intent(in) diff --git a/proc/dag_set_edges_no_atts.html b/proc/dag_set_edges_no_atts.html index 1c228ef..de22b3d 100644 --- a/proc/dag_set_edges_no_atts.html +++ b/proc/dag_set_edges_no_atts.html @@ -173,7 +173,7 @@

    Arguments

    - + integer(kind=ip), intent(in) diff --git a/proc/dag_set_edges_vector_atts.html b/proc/dag_set_edges_vector_atts.html index f1aad90..c2cf969 100644 --- a/proc/dag_set_edges_vector_atts.html +++ b/proc/dag_set_edges_vector_atts.html @@ -173,7 +173,7 @@

    Arguments

    - + integer(kind=ip), intent(in) @@ -203,7 +203,7 @@

    Arguments

    - + character(len=*), intent(in), @@ -219,7 +219,7 @@

    Arguments

    - + character(len=*), intent(in), diff --git a/proc/dag_set_vertex_info.html b/proc/dag_set_vertex_info.html index aafac00..2d8bc23 100644 --- a/proc/dag_set_vertex_info.html +++ b/proc/dag_set_vertex_info.html @@ -158,7 +158,7 @@

    Arguments

    - + class(dag), intent(inout) diff --git a/proc/dag_set_vertices.html b/proc/dag_set_vertices.html index f30504f..609a905 100644 --- a/proc/dag_set_vertices.html +++ b/proc/dag_set_vertices.html @@ -71,7 +71,7 @@

    dag_set_vertices
  • 20 statements + title=" 4.7% of total for procedures.">20 statements
  • diff --git a/proc/dag_toposort.html b/proc/dag_toposort.html index 277565c..124ba3d 100644 --- a/proc/dag_toposort.html +++ b/proc/dag_toposort.html @@ -71,7 +71,7 @@

    dag_toposort
  • 39 statements + title=" 9.2% of total for procedures.">39 statements
  • @@ -158,7 +158,7 @@

    Arguments

    - + class(dag), intent(inout) diff --git a/proc/edge_constructor.html b/proc/edge_constructor.html index 568379c..b0b78e1 100644 --- a/proc/edge_constructor.html +++ b/proc/edge_constructor.html @@ -71,7 +71,7 @@

    edge_constructor
  • 9 statements + title=" 2.1% of total for procedures.">9 statements
  • @@ -156,7 +156,7 @@

    Arguments

    - + integer(kind=ip), intent(in), @@ -171,7 +171,7 @@

    Arguments

    - + character(len=*), intent(in), @@ -186,7 +186,7 @@

    Arguments

    - + character(len=*), intent(in), diff --git a/proc/init_internal_vars.html b/proc/init_internal_vars.html index 20c7acd..a144919 100644 --- a/proc/init_internal_vars.html +++ b/proc/init_internal_vars.html @@ -158,7 +158,7 @@

    Arguments

    - + class(dag), intent(inout) diff --git a/proc/integer_to_string.html b/proc/integer_to_string.html index caae3c9..8ca9625 100644 --- a/proc/integer_to_string.html +++ b/proc/integer_to_string.html @@ -71,7 +71,7 @@

    integer_to_string
  • 12 statements + title=" 2.8% of total for procedures.">12 statements
  • diff --git a/proc/remove_edge.html b/proc/remove_edge.html index ab647f9..0cb8758 100644 --- a/proc/remove_edge.html +++ b/proc/remove_edge.html @@ -71,7 +71,7 @@

    remove_edge
  • 21 statements + title=" 5.0% of total for procedures.">21 statements
  • diff --git a/proc/set_edge_vector_vector.html b/proc/set_edge_vector_vector.html index daeac14..03c9196 100644 --- a/proc/set_edge_vector_vector.html +++ b/proc/set_edge_vector_vector.html @@ -188,7 +188,7 @@

    Arguments

    - + character(len=*), intent(in), @@ -384,61 +384,76 @@

    Called by

    - - + + proc~~set_edge_vector_vector~~CalledByGraph - + proc~set_edge_vector_vector - -dag_module::vertex%set_edge_vector_vector + +dag_module::vertex%set_edge_vector_vector none~set_edges - -dag_module::vertex%set_edges + +dag_module::vertex%set_edges none~set_edges->proc~set_edge_vector_vector - - + + - + +proc~dag_add_edge + + +dag_module::dag%dag_add_edge + + + + + +proc~dag_add_edge->none~set_edges + + + + + proc~dag_set_edges_no_atts - + dag_module::dag%dag_set_edges_no_atts - + proc~dag_set_edges_no_atts->none~set_edges - - + + - + proc~dag_set_edges_vector_atts - + dag_module::dag%dag_set_edges_vector_atts - + proc~dag_set_edges_vector_atts->none~set_edges - - + + diff --git a/proc/sort_ascending.html b/proc/sort_ascending.html index eb2a90d..1e3750f 100644 --- a/proc/sort_ascending.html +++ b/proc/sort_ascending.html @@ -71,7 +71,7 @@

    sort_ascending
  • 44 statements + title="10.4% of total for procedures.">44 statements
  • @@ -304,11 +304,11 @@

    Called by

    - - + + proc~~sort_ascending~~CalledByGraph - + proc~sort_ascending @@ -370,7 +370,7 @@

    Called by

    - + none~set_edges->proc~set_edge_vector_vector @@ -381,35 +381,50 @@

    Called by

     - + +proc~dag_add_edge + + +dag_module::dag%dag_add_edge + + + + + +proc~dag_add_edge->none~set_edges + + + + + proc~dag_set_edges_no_atts - - -dag_module::dag%dag_set_edges_no_atts + + +dag_module::dag%dag_set_edges_no_atts - + proc~dag_set_edges_no_atts->none~set_edges - - + + - + proc~dag_set_edges_vector_atts - - -dag_module::dag%dag_set_edges_vector_atts + + +dag_module::dag%dag_set_edges_vector_atts - + proc~dag_set_edges_vector_atts->none~set_edges - - + + diff --git a/proc/swap.html b/proc/swap.html index 74a751c..4fc10cc 100644 --- a/proc/swap.html +++ b/proc/swap.html @@ -199,11 +199,11 @@

    Called by

    - - + + proc~~swap~~CalledByGraph - + proc~swap @@ -280,7 +280,7 @@

    Called by

         - + none~set_edges->proc~set_edge_vector_vector @@ -291,35 +291,50 @@

    Called by

     - + +proc~dag_add_edge + + +dag_module::dag%dag_add_edge + + + + + +proc~dag_add_edge->none~set_edges + + + + + proc~dag_set_edges_no_atts - - -dag_module::dag%dag_set_edges_no_atts + + +dag_module::dag%dag_set_edges_no_atts - + proc~dag_set_edges_no_atts->none~set_edges - - + + - + proc~dag_set_edges_vector_atts - - -dag_module::dag%dag_set_edges_vector_atts + + +dag_module::dag%dag_set_edges_vector_atts - + proc~dag_set_edges_vector_atts->none~set_edges - - + + diff --git a/proc/unique.html b/proc/unique.html index 64169e6..eefa364 100644 --- a/proc/unique.html +++ b/proc/unique.html @@ -71,7 +71,7 @@

    unique
  • 17 statements + title=" 4.0% of total for procedures.">17 statements
  • diff --git a/sourcefile/dag_module.f90.html b/sourcefile/dag_module.f90.html index bc5ae32..d3684e9 100644 --- a/sourcefile/dag_module.f90.html +++ b/sourcefile/dag_module.f90.html @@ -71,7 +71,7 @@

    dag_module.F90
  • 466 statements + title="100.0% of total for source files.">475 statements
  • @@ -221,785 +221,806 @@

    Source Code

    procedure,public :: set_vertices => dag_set_vertices generic,public :: set_edges => dag_set_edges_no_atts, & dag_set_edges_vector_atts - procedure,public :: remove_edge => dag_remove_edge - procedure,public :: remove_vertex => dag_remove_node - procedure,public :: set_vertex_info => dag_set_vertex_info - procedure,public :: toposort => dag_toposort - procedure,public :: generate_digraph => dag_generate_digraph - procedure,public :: generate_dependency_matrix => dag_generate_dependency_matrix - procedure,public :: save_digraph => dag_save_digraph - procedure,public :: get_edges => dag_get_edges - procedure,public :: get_dependencies => dag_get_dependencies - procedure,public :: destroy => dag_destroy - - procedure :: init_internal_vars !! private routine to initialize some internal variables - procedure :: dag_set_edges_no_atts, dag_set_edges_vector_atts - - end type dag - - contains -!******************************************************************************* - -!******************************************************************************* -!> -! Constructor for [[edge]] type. - - pure elemental function edge_constructor(ivertex,label,attributes) result(e) - - integer(ip),intent(in),optional :: ivertex - character(len=*),intent(in),optional :: label - character(len=*),intent(in),optional :: attributes - type(edge) :: e - e%ivertex = ivertex - if (present(label)) e%label = label - if (present(attributes)) e%attributes = attributes - - end function edge_constructor -!******************************************************************************* - -!******************************************************************************* -!> -! Destroy the `dag`. - - subroutine dag_destroy(me) - - class(dag),intent(inout) :: me - - me%n = 0 - if (allocated(me%vertices)) deallocate(me%vertices) - - end subroutine dag_destroy -!******************************************************************************* - -!******************************************************************************* -!> -! specify the edge indices for this vertex - - subroutine set_edge_vector_vector(me,edges,label,attributes) - - class(vertex),intent(inout) :: me - integer(ip),dimension(:),intent(in) :: edges - character(len=*),dimension(:),intent(in),optional :: label - character(len=*),dimension(:),intent(in),optional :: attributes !! other attributes when - !! saving as a diagraph. - - integer(ip) :: i !! counter - - do i=1,size(edges) - if (present(label) .and. present(attributes)) then - call me%add_edge(edges(i),label=label(i),attributes=attributes(i)) - else if (.not. present(label) .and. present(attributes)) then - call me%add_edge(edges(i),attributes=attributes(i)) - else if (present(label) .and. .not. present(attributes)) then - call me%add_edge(edges(i),label=label(i)) - else - call me%add_edge(edges(i)) - end if - end do - - end subroutine set_edge_vector_vector -!******************************************************************************* - -!******************************************************************************* -!> -! add an edge index for this vertex - - subroutine add_edge(me,e,label,attributes) - - class(vertex),intent(inout) :: me - integer(ip),intent(in) :: e - character(len=*),intent(in),optional :: label - character(len=*),intent(in),optional :: attributes !! other attributes when - !! saving as a diagraph. - - if (allocated(me%edges)) then - if (.not. any(e==me%edges%ivertex)) then ! don't add if already there - me%edges = [me%edges, edge(e,label=label,attributes=attributes)] - call sort_ascending(me%edges) - end if - else - me%edges = [edge(e,label=label,attributes=attributes)] - end if - - end subroutine add_edge -!******************************************************************************* - -!******************************************************************************* -!> -! remove an edge index from this vertex - - subroutine remove_edge(me,e) - - class(vertex),intent(inout) :: me - integer(ip),intent(in) :: e - - integer(ip),dimension(1) :: idx - type(edge),dimension(:),allocatable :: tmp - - if (allocated(me%edges)) then - idx = findloc(me%edges%ivertex, e) - if (idx(1)>0) then - ! the edge is in the list - associate (i => idx(1), n => size(me%edges)) - if (n==1) then - deallocate(me%edges) ! it's the only one there - else - allocate(tmp(n-1)) - if (i>1) tmp(1:i-1) = me%edges(1:i-1) - if (i<n) tmp(i:n-1) = me%edges(i+1:n) - call move_alloc(tmp,me%edges) - end if - end associate - end if - end if - - end subroutine remove_edge -!******************************************************************************* - -!******************************************************************************* -!> -! Remove a node from a dag. Will also remove any edges connected to it. -! -! This will renumber the nodes and edges internally. -! Note that any default integer labels generated in -! [[dag_set_vertices]] would then be questionable. - - subroutine dag_remove_node(me,ivertex) - - class(dag),intent(inout) :: me - integer(ip),intent(in) :: ivertex !! the node to remove - - integer(ip) :: i !! counter - type(vertex),dimension(:),allocatable :: tmp !! for resizing `me%vertices` - - if (allocated(me%vertices)) then - associate (n => size(me%vertices)) - do i = 1, n - ! first remove any edges: - call me%vertices(i)%remove_edge(ivertex) - ! next, renumber the existing edges so they will be - ! correct after ivertex is deleted - ! Example (removing 2): 1 [2] 3 4 ==> 1 2 3 - if (allocated(me%vertices(i)%edges)) then - where (me%vertices(i)%edges%ivertex>ivertex) - me%vertices(i)%edges%ivertex = me%vertices(i)%edges%ivertex - 1 - end where - end if - end do - ! now, remove the node: - allocate(tmp(n-1)) - if (ivertex>1) tmp(1:ivertex-1) = me%vertices(1:ivertex-1) - if (ivertex<n) tmp(ivertex:n-1) = me%vertices(ivertex+1:n) - call move_alloc(tmp,me%vertices) - end associate - end if - me%n = size(me%vertices) - if (me%n==0) deallocate(me%vertices) - - end subroutine dag_remove_node -!******************************************************************************* - -!******************************************************************************* -!> -! get the edges for the vertex (all of the vertices -! that this vertex depends on). - - pure function dag_get_edges(me,ivertex) result(edges) - - class(dag),intent(in) :: me - integer(ip),intent(in) :: ivertex - integer(ip),dimension(:),allocatable :: edges - - if (ivertex>0 .and. ivertex <= me%n) then - edges = me%vertices(ivertex)%edges%ivertex ! auto LHS allocation - end if - - end function dag_get_edges -!******************************************************************************* - -!******************************************************************************* -!> -! get all the vertices that depend on this vertex. - - pure function dag_get_dependencies(me,ivertex) result(dep) - - class(dag),intent(in) :: me - integer(ip),intent(in) :: ivertex - integer(ip),dimension(:),allocatable :: dep !! the set of all vertices - !! than depend on `ivertex` - - integer(ip) :: i !! vertex counter - - if (ivertex>0 .and. ivertex <= me%n) then - - ! have to check all the vertices: - do i=1, me%n - if (allocated(me%vertices(i)%edges)) then - if (any(me%vertices(i)%edges%ivertex == ivertex)) then - if (allocated(dep)) then - dep = [dep, i] ! auto LHS allocation - else - dep = [i] ! auto LHS allocation - end if - end if - end if - end do - - end if - - end function dag_get_dependencies -!******************************************************************************* - -!******************************************************************************* -!> -! set the number of vertices (nodes) in the dag. -! -!### See also -! * [[dag_remove_node]] which can be used to remove a vertex. -! * [[dag_set_vertex_info]] which can be used to set/change -! the labels and other attributes. - - subroutine dag_set_vertices(me,nvertices,labels) - - class(dag),intent(inout) :: me - integer(ip),intent(in) :: nvertices !! number of vertices - character(len=*),dimension(nvertices),intent(in),optional :: labels !! vertex name strings - integer(ip) :: i !! counter - - if (nvertices<=0) error stop 'error: nvertices must be >= 1' - - if (allocated(me%vertices)) deallocate(me%vertices) - - me%n = nvertices - allocate(me%vertices(nvertices)) - me%vertices%ivertex = [(i,i=1,nvertices)] - - if (present(labels)) then - do i = 1, nvertices - me%vertices(i)%label = trim(adjustl(labels(i))) - end do - else - ! just use the vertex number - do i = 1, nvertices - me%vertices(i)%label = integer_to_string(i) - end do - end if - - end subroutine dag_set_vertices -!******************************************************************************* - -!******************************************************************************* -!> -! Returns the number of vertices (nodes) in the dag. - - pure function dag_get_number_of_vertices(me) result(nvertices) - - class(dag),intent(in) :: me - integer(ip) :: nvertices !! number of vertices - - nvertices = me%n - - end function dag_get_number_of_vertices -!******************************************************************************* - -!******************************************************************************* -!> -! set info about a vertex in a dag. - - subroutine dag_set_vertex_info(me,ivertex,label,attributes) - - class(dag),intent(inout) :: me - integer(ip),intent(in) :: ivertex !! vertex number - character(len=*),intent(in),optional :: label !! if a label is not set, - !! then the integer vertex - !! number is used. - character(len=*),intent(in),optional :: attributes !! other attributes when - !! saving as a diagraph. - - if (present(label)) me%vertices(ivertex)%label = label - if (present(attributes)) me%vertices(ivertex)%attributes = attributes - - end subroutine dag_set_vertex_info -!******************************************************************************* - -!******************************************************************************* -!> -! Get the `i`th vertex. -! -! The program will stop if vertex `i` does not exist. - - function dag_get_vertex(me,i) result(v) - - class(dag),intent(inout) :: me - integer(ip),intent(in) :: i !! vertex number - type(vertex) :: v - - if (i<0 .or. i>me%n) then - error stop 'Error in dag_get_vertex: invalid vertex number' - else - v = me%vertices(i) - end if - - end function dag_get_vertex -!******************************************************************************* - -!******************************************************************************* -!> -! set the edges for a vertex in a dag - - subroutine dag_set_edges_no_atts(me,ivertex,edges) - - class(dag),intent(inout) :: me - integer(ip),intent(in) :: ivertex !! vertex number - integer(ip),dimension(:),intent(in) :: edges - - call me%vertices(ivertex)%set_edges(edges) - - end subroutine dag_set_edges_no_atts -!******************************************************************************* - -!******************************************************************************* -!> -! Remove an edge from a dag. - - subroutine dag_remove_edge(me,ivertex,iedge) + procedure,public :: add_edge => dag_add_edge + procedure,public :: remove_edge => dag_remove_edge + procedure,public :: remove_vertex => dag_remove_node + procedure,public :: set_vertex_info => dag_set_vertex_info + procedure,public :: toposort => dag_toposort + procedure,public :: generate_digraph => dag_generate_digraph + procedure,public :: generate_dependency_matrix => dag_generate_dependency_matrix + procedure,public :: save_digraph => dag_save_digraph + procedure,public :: get_edges => dag_get_edges + procedure,public :: get_dependencies => dag_get_dependencies + procedure,public :: destroy => dag_destroy + + procedure :: init_internal_vars !! private routine to initialize some internal variables + procedure :: dag_set_edges_no_atts, dag_set_edges_vector_atts + + end type dag + + contains +!******************************************************************************* + +!******************************************************************************* +!> +! Constructor for [[edge]] type. + + pure elemental function edge_constructor(ivertex,label,attributes) result(e) + + integer(ip),intent(in),optional :: ivertex + character(len=*),intent(in),optional :: label + character(len=*),intent(in),optional :: attributes + type(edge) :: e + e%ivertex = ivertex + if (present(label)) e%label = label + if (present(attributes)) e%attributes = attributes + + end function edge_constructor +!******************************************************************************* + +!******************************************************************************* +!> +! Destroy the `dag`. + + subroutine dag_destroy(me) + + class(dag),intent(inout) :: me + + me%n = 0 + if (allocated(me%vertices)) deallocate(me%vertices) + + end subroutine dag_destroy +!******************************************************************************* + +!******************************************************************************* +!> +! specify the edge indices for this vertex + + subroutine set_edge_vector_vector(me,edges,label,attributes) + + class(vertex),intent(inout) :: me + integer(ip),dimension(:),intent(in) :: edges + character(len=*),dimension(:),intent(in),optional :: label + character(len=*),dimension(:),intent(in),optional :: attributes !! other attributes when + !! saving as a diagraph. + + integer(ip) :: i !! counter + + do i=1,size(edges) + if (present(label) .and. present(attributes)) then + call me%add_edge(edges(i),label=label(i),attributes=attributes(i)) + else if (.not. present(label) .and. present(attributes)) then + call me%add_edge(edges(i),attributes=attributes(i)) + else if (present(label) .and. .not. present(attributes)) then + call me%add_edge(edges(i),label=label(i)) + else + call me%add_edge(edges(i)) + end if + end do + + end subroutine set_edge_vector_vector +!******************************************************************************* + +!******************************************************************************* +!> +! add an edge index for this vertex + + subroutine add_edge(me,e,label,attributes) + + class(vertex),intent(inout) :: me + integer(ip),intent(in) :: e + character(len=*),intent(in),optional :: label + character(len=*),intent(in),optional :: attributes !! other attributes when + !! saving as a diagraph. + + if (allocated(me%edges)) then + if (.not. any(e==me%edges%ivertex)) then ! don't add if already there + me%edges = [me%edges, edge(e,label=label,attributes=attributes)] + call sort_ascending(me%edges) + end if + else + me%edges = [edge(e,label=label,attributes=attributes)] + end if + + end subroutine add_edge +!******************************************************************************* + +!******************************************************************************* +!> +! remove an edge index from this vertex + + subroutine remove_edge(me,e) + + class(vertex),intent(inout) :: me + integer(ip),intent(in) :: e + + integer(ip),dimension(1) :: idx + type(edge),dimension(:),allocatable :: tmp + + if (allocated(me%edges)) then + idx = findloc(me%edges%ivertex, e) + if (idx(1)>0) then + ! the edge is in the list + associate (i => idx(1), n => size(me%edges)) + if (n==1) then + deallocate(me%edges) ! it's the only one there + else + allocate(tmp(n-1)) + if (i>1) tmp(1:i-1) = me%edges(1:i-1) + if (i<n) tmp(i:n-1) = me%edges(i+1:n) + call move_alloc(tmp,me%edges) + end if + end associate + end if + end if + + end subroutine remove_edge +!******************************************************************************* + +!******************************************************************************* +!> +! Remove a node from a dag. Will also remove any edges connected to it. +! +! This will renumber the nodes and edges internally. +! Note that any default integer labels generated in +! [[dag_set_vertices]] would then be questionable. + + subroutine dag_remove_node(me,ivertex) + + class(dag),intent(inout) :: me + integer(ip),intent(in) :: ivertex !! the node to remove + + integer(ip) :: i !! counter + type(vertex),dimension(:),allocatable :: tmp !! for resizing `me%vertices` + + if (allocated(me%vertices)) then + associate (n => size(me%vertices)) + do i = 1, n + ! first remove any edges: + call me%vertices(i)%remove_edge(ivertex) + ! next, renumber the existing edges so they will be + ! correct after ivertex is deleted + ! Example (removing 2): 1 [2] 3 4 ==> 1 2 3 + if (allocated(me%vertices(i)%edges)) then + where (me%vertices(i)%edges%ivertex>ivertex) + me%vertices(i)%edges%ivertex = me%vertices(i)%edges%ivertex - 1 + end where + end if + end do + ! now, remove the node: + allocate(tmp(n-1)) + if (ivertex>1) tmp(1:ivertex-1) = me%vertices(1:ivertex-1) + if (ivertex<n) tmp(ivertex:n-1) = me%vertices(ivertex+1:n) + call move_alloc(tmp,me%vertices) + end associate + end if + me%n = size(me%vertices) + if (me%n==0) deallocate(me%vertices) + + end subroutine dag_remove_node +!******************************************************************************* + +!******************************************************************************* +!> +! get the edges for the vertex (all of the vertices +! that this vertex depends on). + + pure function dag_get_edges(me,ivertex) result(edges) + + class(dag),intent(in) :: me + integer(ip),intent(in) :: ivertex + integer(ip),dimension(:),allocatable :: edges + + if (ivertex>0 .and. ivertex <= me%n) then + edges = me%vertices(ivertex)%edges%ivertex ! auto LHS allocation + end if + + end function dag_get_edges +!******************************************************************************* + +!******************************************************************************* +!> +! get all the vertices that depend on this vertex. + + pure function dag_get_dependencies(me,ivertex) result(dep) + + class(dag),intent(in) :: me + integer(ip),intent(in) :: ivertex + integer(ip),dimension(:),allocatable :: dep !! the set of all vertices + !! than depend on `ivertex` + + integer(ip) :: i !! vertex counter + + if (ivertex>0 .and. ivertex <= me%n) then + + ! have to check all the vertices: + do i=1, me%n + if (allocated(me%vertices(i)%edges)) then + if (any(me%vertices(i)%edges%ivertex == ivertex)) then + if (allocated(dep)) then + dep = [dep, i] ! auto LHS allocation + else + dep = [i] ! auto LHS allocation + end if + end if + end if + end do + + end if + + end function dag_get_dependencies +!******************************************************************************* + +!******************************************************************************* +!> +! set the number of vertices (nodes) in the dag. +! +!### See also +! * [[dag_remove_node]] which can be used to remove a vertex. +! * [[dag_set_vertex_info]] which can be used to set/change +! the labels and other attributes. + + subroutine dag_set_vertices(me,nvertices,labels) + + class(dag),intent(inout) :: me + integer(ip),intent(in) :: nvertices !! number of vertices + character(len=*),dimension(nvertices),intent(in),optional :: labels !! vertex name strings + integer(ip) :: i !! counter + + if (nvertices<=0) error stop 'error: nvertices must be >= 1' + + if (allocated(me%vertices)) deallocate(me%vertices) + + me%n = nvertices + allocate(me%vertices(nvertices)) + me%vertices%ivertex = [(i,i=1,nvertices)] + + if (present(labels)) then + do i = 1, nvertices + me%vertices(i)%label = trim(adjustl(labels(i))) + end do + else + ! just use the vertex number + do i = 1, nvertices + me%vertices(i)%label = integer_to_string(i) + end do + end if + + end subroutine dag_set_vertices +!******************************************************************************* + +!******************************************************************************* +!> +! Returns the number of vertices (nodes) in the dag. + + pure function dag_get_number_of_vertices(me) result(nvertices) + + class(dag),intent(in) :: me + integer(ip) :: nvertices !! number of vertices + + nvertices = me%n + + end function dag_get_number_of_vertices +!******************************************************************************* + +!******************************************************************************* +!> +! set info about a vertex in a dag. + + subroutine dag_set_vertex_info(me,ivertex,label,attributes) + + class(dag),intent(inout) :: me + integer(ip),intent(in) :: ivertex !! vertex number + character(len=*),intent(in),optional :: label !! if a label is not set, + !! then the integer vertex + !! number is used. + character(len=*),intent(in),optional :: attributes !! other attributes when + !! saving as a diagraph. + + if (present(label)) me%vertices(ivertex)%label = label + if (present(attributes)) me%vertices(ivertex)%attributes = attributes + + end subroutine dag_set_vertex_info +!******************************************************************************* + +!******************************************************************************* +!> +! Get the `i`th vertex. +! +! The program will stop if vertex `i` does not exist. + + function dag_get_vertex(me,i) result(v) + + class(dag),intent(inout) :: me + integer(ip),intent(in) :: i !! vertex number + type(vertex) :: v + + if (i<0 .or. i>me%n) then + error stop 'Error in dag_get_vertex: invalid vertex number' + else + v = me%vertices(i) + end if + + end function dag_get_vertex +!******************************************************************************* + +!******************************************************************************* +!> +! Add an edge to a dag. + + subroutine dag_add_edge(me,ivertex,iedge,label,attributes) + + class(dag),intent(inout) :: me + integer(ip),intent(in) :: ivertex !! vertex number + integer(ip),intent(in) :: iedge !! the vertex to connect to `ivertex` + character(len=*),intent(in),optional :: label !! edge label + character(len=*),intent(in),optional :: attributes !! other attributes when + !! saving as a diagraph. + + call me%vertices(ivertex)%set_edges(iedge,& + label=label,& + attributes=attributes) + + end subroutine dag_add_edge +!******************************************************************************* - class(dag),intent(inout) :: me - integer(ip),intent(in) :: ivertex !! vertex number - integer(ip),intent(in) :: iedge !! the edge to remove +!******************************************************************************* +!> +! set the edges for a vertex in a dag - call me%vertices(ivertex)%remove_edge(iedge) + subroutine dag_set_edges_no_atts(me,ivertex,edges) - end subroutine dag_remove_edge -!******************************************************************************* - -!******************************************************************************* -!> -! set the edges for a vertex in a dag - - subroutine dag_set_edges_vector_atts(me,ivertex,edges,attributes,label) + class(dag),intent(inout) :: me + integer(ip),intent(in) :: ivertex !! vertex number + integer(ip),dimension(:),intent(in) :: edges + + call me%vertices(ivertex)%set_edges(edges) + + end subroutine dag_set_edges_no_atts +!******************************************************************************* - class(dag),intent(inout) :: me - integer(ip),intent(in) :: ivertex !! vertex number - integer(ip),dimension(:),intent(in) :: edges - character(len=*),dimension(:),intent(in) :: attributes !! other attributes when - !! saving as a diagraph. - character(len=*),dimension(:),intent(in),optional :: label - - call me%vertices(ivertex)%set_edges(edges,label=label,attributes=attributes) - - end subroutine dag_set_edges_vector_atts -!******************************************************************************* +!******************************************************************************* +!> +! Remove an edge from a dag. + + subroutine dag_remove_edge(me,ivertex,iedge) + + class(dag),intent(inout) :: me + integer(ip),intent(in) :: ivertex !! vertex number + integer(ip),intent(in) :: iedge !! the edge to remove + + call me%vertices(ivertex)%remove_edge(iedge) -!******************************************************************************* -!> -! Initialize the internal private variables used for graph traversal. - - subroutine init_internal_vars(me) - - class(dag),intent(inout) :: me - - integer(ip) :: i !! counter - - do i = 1, me%n - me%vertices(i)%marked = .false. - me%vertices(i)%checking = .false. - end do - - end subroutine init_internal_vars -!******************************************************************************* + end subroutine dag_remove_edge +!******************************************************************************* + +!******************************************************************************* +!> +! set the edges for a vertex in a dag + + subroutine dag_set_edges_vector_atts(me,ivertex,edges,attributes,label) + + class(dag),intent(inout) :: me + integer(ip),intent(in) :: ivertex !! vertex number + integer(ip),dimension(:),intent(in) :: edges + character(len=*),dimension(:),intent(in) :: attributes !! other attributes when + !! saving as a diagraph. + character(len=*),dimension(:),intent(in),optional :: label + + call me%vertices(ivertex)%set_edges(edges,label=label,attributes=attributes) -!******************************************************************************* -!> -! Main toposort routine - - subroutine dag_toposort(me,order,istat) - - class(dag),intent(inout) :: me - integer(ip),dimension(:),allocatable,intent(out) :: order !! the toposort order - integer(ip),intent(out) :: istat !! Status flag: - !! - !! * 0 if no errors - !! * -1 if circular dependency - !! (in this case, `order` will not be allocated) - - integer(ip) :: i,iorder - - if (me%n==0) return + end subroutine dag_set_edges_vector_atts +!******************************************************************************* + +!******************************************************************************* +!> +! Initialize the internal private variables used for graph traversal. + + subroutine init_internal_vars(me) + + class(dag),intent(inout) :: me + + integer(ip) :: i !! counter + + do i = 1, me%n + me%vertices(i)%marked = .false. + me%vertices(i)%checking = .false. + end do - ! initialize internal variables, in case - ! we have called this routine before. - call me%init_internal_vars() - - allocate(order(me%n)) - iorder = 0 ! index in order array - istat = 0 ! no errors so far - do i=1,me%n - if (.not. me%vertices(i)%marked) call dfs(me%vertices(i)) - if (istat==-1) exit - end do - - if (istat==-1) deallocate(order) - - contains - - recursive subroutine dfs(v) - - !! depth-first graph traversal - - type(vertex),intent(inout) :: v - integer(ip) :: j - - if (istat==-1) return + end subroutine init_internal_vars +!******************************************************************************* + +!******************************************************************************* +!> +! Main toposort routine + + subroutine dag_toposort(me,order,istat) + + class(dag),intent(inout) :: me + integer(ip),dimension(:),allocatable,intent(out) :: order !! the toposort order + integer(ip),intent(out) :: istat !! Status flag: + !! + !! * 0 if no errors + !! * -1 if circular dependency + !! (in this case, `order` will not be allocated) + + integer(ip) :: i,iorder + + if (me%n==0) return + + ! initialize internal variables, in case + ! we have called this routine before. + call me%init_internal_vars() - if (v%checking) then - ! error: circular dependency - istat = -1 - else - if (.not. v%marked) then - v%checking = .true. - if (allocated(v%edges)) then - do j=1,size(v%edges) - call dfs(me%vertices(v%edges(j)%ivertex)) - if (istat==-1) return - end do - end if - v%checking = .false. - v%marked = .true. - iorder = iorder + 1 - order(iorder) = v%ivertex - end if - end if + allocate(order(me%n)) + iorder = 0 ! index in order array + istat = 0 ! no errors so far + do i=1,me%n + if (.not. me%vertices(i)%marked) call dfs(me%vertices(i)) + if (istat==-1) exit + end do + + if (istat==-1) deallocate(order) + + contains + + recursive subroutine dfs(v) + + !! depth-first graph traversal + + type(vertex),intent(inout) :: v + integer(ip) :: j - end subroutine dfs + if (istat==-1) return - end subroutine dag_toposort -!******************************************************************************* - -!******************************************************************************* -!> -! Generate a Graphviz digraph structure for the DAG. -! -!### Example -! * To convert this to a PDF using `dot`: `dot -Tpdf -o test.pdf test.dot`, -! where `test.dot` is `str` written to a file. - - function dag_generate_digraph(me,rankdir,dpi) result(str) - - class(dag),intent(in) :: me - character(len=:),allocatable :: str - character(len=*),intent(in),optional :: rankdir !! right to left orientation (e.g. 'RL') - integer(ip),intent(in),optional :: dpi !! resolution (e.g. 300) - - integer(ip) :: i,j !! counter - integer(ip) :: n_edges !! number of edges - character(len=:),allocatable :: attributes !! full attributes string for node or edge - logical :: compress !! if we can write all the edges on one line - - character(len=*),parameter :: tab = ' ' !! for indenting - character(len=*),parameter :: newline = new_line(' ') !! line break character - - if (me%n == 0) return - - str = 'digraph G {'//newline//newline - if (present(rankdir)) & - str = str//tab//'rankdir='//rankdir//newline//newline - if (present(dpi)) & - str = str//tab//'graph [ dpi = '//integer_to_string(dpi)//' ]'//newline//newline + if (v%checking) then + ! error: circular dependency + istat = -1 + else + if (.not. v%marked) then + v%checking = .true. + if (allocated(v%edges)) then + do j=1,size(v%edges) + call dfs(me%vertices(v%edges(j)%ivertex)) + if (istat==-1) return + end do + end if + v%checking = .false. + v%marked = .true. + iorder = iorder + 1 + order(iorder) = v%ivertex + end if + end if + + end subroutine dfs + + end subroutine dag_toposort +!******************************************************************************* + +!******************************************************************************* +!> +! Generate a Graphviz digraph structure for the DAG. +! +!### Example +! * To convert this to a PDF using `dot`: `dot -Tpdf -o test.pdf test.dot`, +! where `test.dot` is `str` written to a file. + + function dag_generate_digraph(me,rankdir,dpi) result(str) - ! define the vertices: - do i=1,me%n - attributes = get_attributes_string(me%vertices(i)%label, & - me%vertices(i)%attributes) - str = str//tab//integer_to_string(i)//' '//attributes//newline - if (i==me%n) str = str//newline - end do - - ! define the dependencies: - do i=1,me%n - if (allocated(me%vertices(i)%edges)) then - n_edges = size(me%vertices(i)%edges) + class(dag),intent(in) :: me + character(len=:),allocatable :: str + character(len=*),intent(in),optional :: rankdir !! right to left orientation (e.g. 'RL') + integer(ip),intent(in),optional :: dpi !! resolution (e.g. 300) + + integer(ip) :: i,j !! counter + integer(ip) :: n_edges !! number of edges + character(len=:),allocatable :: attributes !! full attributes string for node or edge + logical :: compress !! if we can write all the edges on one line + + character(len=*),parameter :: tab = ' ' !! for indenting + character(len=*),parameter :: newline = new_line(' ') !! line break character - ! if none of the edges have attributes, - ! then we can write them all on one line - ! otherwise, write them line by line - compress = .true. - do j = 1, n_edges - if (allocated(me%vertices(i)%edges(j)%label) .or. & - allocated(me%vertices(i)%edges(j)%attributes)) then - compress = .false. - exit - end if - end do - if (.not. compress) then - ! Example: 1 -> 2 [penwidth=2, arrowhead=none] - do j=1,n_edges - attributes = get_attributes_string(me%vertices(i)%edges(j)%label, & - me%vertices(i)%edges(j)%attributes) - str = str//tab//integer_to_string(i)//' -> '//& - integer_to_string(me%vertices(i)%edges(j)%ivertex)//' '//attributes//newline - end do - else - ! Example: 1 -> 2,5,10 - str = str//tab//integer_to_string(i)// merge(' -> ',' ',n_edges/=0) - do j=1,n_edges - ! comma-separated list: - str = str//integer_to_string(me%vertices(i)%edges(j)%ivertex) - if (n_edges>1 .and. j<n_edges) str = str//',' - end do - str = str//';'//newline - end if - - end if - end do - - str = str//newline//'}' - - contains - - function get_attributes_string(label, attributes) result(str) - !! create the full attributes string for an edge or node. - character(len=:),allocatable,intent(in) :: label !! if not allocated or blank, then not used - character(len=:),allocatable,intent(in) :: attributes !! if not allocated or blank, then not used - character(len=:),allocatable :: str !! the attributes string, enclosed in brackets - - character(len=:),allocatable :: tmp_label - logical :: has_label, has_attributes - - has_label = allocated(label) - if (has_label) has_label = label /= '' - if (has_label) tmp_label = 'label="'//trim(adjustl(label))//'"' - - has_attributes = allocated(attributes) - if (has_attributes) has_attributes = attributes /= '' - - if (has_label .and. has_attributes) then - str = '['//trim(adjustl(attributes))//','//tmp_label//']' - elseif (has_label .and. .not. has_attributes) then - str = '['//tmp_label//']' - elseif (.not. has_label .and. has_attributes) then - str = '['//trim(adjustl(attributes))//']' - else ! neither - str = '' - end if - end function get_attributes_string + if (me%n == 0) return + + str = 'digraph G {'//newline//newline + if (present(rankdir)) & + str = str//tab//'rankdir='//rankdir//newline//newline + if (present(dpi)) & + str = str//tab//'graph [ dpi = '//integer_to_string(dpi)//' ]'//newline//newline + + ! define the vertices: + do i=1,me%n + attributes = get_attributes_string(me%vertices(i)%label, & + me%vertices(i)%attributes) + str = str//tab//integer_to_string(i)//' '//attributes//newline + if (i==me%n) str = str//newline + end do + + ! define the dependencies: + do i=1,me%n + if (allocated(me%vertices(i)%edges)) then + n_edges = size(me%vertices(i)%edges) + + ! if none of the edges have attributes, + ! then we can write them all on one line + ! otherwise, write them line by line + compress = .true. + do j = 1, n_edges + if (allocated(me%vertices(i)%edges(j)%label) .or. & + allocated(me%vertices(i)%edges(j)%attributes)) then + compress = .false. + exit + end if + end do + if (.not. compress) then + ! Example: 1 -> 2 [penwidth=2, arrowhead=none] + do j=1,n_edges + attributes = get_attributes_string(me%vertices(i)%edges(j)%label, & + me%vertices(i)%edges(j)%attributes) + str = str//tab//integer_to_string(i)//' -> '//& + integer_to_string(me%vertices(i)%edges(j)%ivertex)//' '//attributes//newline + end do + else + ! Example: 1 -> 2,5,10 + str = str//tab//integer_to_string(i)// merge(' -> ',' ',n_edges/=0) + do j=1,n_edges + ! comma-separated list: + str = str//integer_to_string(me%vertices(i)%edges(j)%ivertex) + if (n_edges>1 .and. j<n_edges) str = str//',' + end do + str = str//';'//newline + end if + + end if + end do + + str = str//newline//'}' + + contains + + function get_attributes_string(label, attributes) result(str) + !! create the full attributes string for an edge or node. + character(len=:),allocatable,intent(in) :: label !! if not allocated or blank, then not used + character(len=:),allocatable,intent(in) :: attributes !! if not allocated or blank, then not used + character(len=:),allocatable :: str !! the attributes string, enclosed in brackets - end function dag_generate_digraph -!******************************************************************************* + character(len=:),allocatable :: tmp_label + logical :: has_label, has_attributes -!******************************************************************************* -!> -! Generate the dependency matrix for the DAG. -! -! This is an \(n \times n \) matrix with elements \(A_{ij}\), -! such that \(A_{ij}\) is true if vertex \(i\) depends on vertex \(j\). + has_label = allocated(label) + if (has_label) has_label = label /= '' + if (has_label) tmp_label = 'label="'//trim(adjustl(label))//'"' + + has_attributes = allocated(attributes) + if (has_attributes) has_attributes = attributes /= '' - subroutine dag_generate_dependency_matrix(me,mat) - - class(dag),intent(in) :: me - logical,dimension(:,:),intent(out),allocatable :: mat !! dependency matrix - - integer(ip) :: i !! vertex counter - integer(ip) :: j !! edge counter - - if (me%n > 0) then - - allocate(mat(me%n,me%n)) - mat = .false. - - do i=1,me%n - if (allocated(me%vertices(i)%edges)) then - do j = 1, size(me%vertices(i)%edges) - mat(i,me%vertices(i)%edges(j)%ivertex) = .true. - end do - end if - end do + if (has_label .and. has_attributes) then + str = '['//trim(adjustl(attributes))//','//tmp_label//']' + elseif (has_label .and. .not. has_attributes) then + str = '['//tmp_label//']' + elseif (.not. has_label .and. has_attributes) then + str = '['//trim(adjustl(attributes))//']' + else ! neither + str = '' + end if + end function get_attributes_string + + end function dag_generate_digraph +!******************************************************************************* + +!******************************************************************************* +!> +! Generate the dependency matrix for the DAG. +! +! This is an \(n \times n \) matrix with elements \(A_{ij}\), +! such that \(A_{ij}\) is true if vertex \(i\) depends on vertex \(j\). - end if + subroutine dag_generate_dependency_matrix(me,mat) - end subroutine dag_generate_dependency_matrix -!******************************************************************************* + class(dag),intent(in) :: me + logical,dimension(:,:),intent(out),allocatable :: mat !! dependency matrix -!******************************************************************************* -!> -! Generate a Graphviz digraph structure for the DAG and write it to a file. - - subroutine dag_save_digraph(me,filename,rankdir,dpi) - - class(dag),intent(in) :: me - character(len=*),intent(in),optional :: filename !! file name for diagraph - character(len=*),intent(in),optional :: rankdir !! right to left orientation (e.g. 'RL') - integer(ip),intent(in),optional :: dpi !! resolution (e.g. 300) - - integer(ip) :: iunit, istat - character(len=:),allocatable :: diagraph - - diagraph = me%generate_digraph(rankdir,dpi) + integer(ip) :: i !! vertex counter + integer(ip) :: j !! edge counter + + if (me%n > 0) then + + allocate(mat(me%n,me%n)) + mat = .false. + + do i=1,me%n + if (allocated(me%vertices(i)%edges)) then + do j = 1, size(me%vertices(i)%edges) + mat(i,me%vertices(i)%edges(j)%ivertex) = .true. + end do + end if + end do - open(newunit=iunit,file=filename,status='REPLACE',iostat=istat) + end if - if (istat==0) then - write(iunit,fmt='(A)',iostat=istat) diagraph - else - write(*,*) 'error opening '//trim(filename) - end if - - close(iunit,iostat=istat) - - end subroutine dag_save_digraph -!******************************************************************************* - -!******************************************************************************* -!> -! Integer to allocatable string. - - pure function integer_to_string(i) result(s) + end subroutine dag_generate_dependency_matrix +!******************************************************************************* + +!******************************************************************************* +!> +! Generate a Graphviz digraph structure for the DAG and write it to a file. + + subroutine dag_save_digraph(me,filename,rankdir,dpi) + + class(dag),intent(in) :: me + character(len=*),intent(in),optional :: filename !! file name for diagraph + character(len=*),intent(in),optional :: rankdir !! right to left orientation (e.g. 'RL') + integer(ip),intent(in),optional :: dpi !! resolution (e.g. 300) + + integer(ip) :: iunit, istat + character(len=:),allocatable :: diagraph - integer(ip),intent(in) :: i - character(len=:),allocatable :: s - - integer(ip) :: istat - - allocate( character(len=MAX_INT_STR_LEN) :: s ) ! should be big enough - write(s,fmt='(ss,I0)',iostat=istat) i - if (istat==0) then - s = trim(adjustl(s)) - else - s = '***' - end if - - end function integer_to_string -!******************************************************************************* - -!******************************************************************************* -!> -! Return only the unique values from `vec`. -! The result is also sorted by ascending value. + diagraph = me%generate_digraph(rankdir,dpi) + + open(newunit=iunit,file=filename,status='REPLACE',iostat=istat) + + if (istat==0) then + write(iunit,fmt='(A)',iostat=istat) diagraph + else + write(*,*) 'error opening '//trim(filename) + end if + + close(iunit,iostat=istat) + + end subroutine dag_save_digraph +!******************************************************************************* + +!******************************************************************************* +!> +! Integer to allocatable string. + + pure function integer_to_string(i) result(s) - function unique(vec) result(vec_unique) - - type(edge),dimension(:),intent(in) :: vec - type(edge),dimension(:),allocatable :: vec_unique !! only the unique elements of `vec` + integer(ip),intent(in) :: i + character(len=:),allocatable :: s + + integer(ip) :: istat - integer(ip) :: i !! counter - integer(ip) :: n !! size of `vec` - logical,dimension(:),allocatable :: mask !! for flagging the unique values - - n = size(vec) - vec_unique = vec ! make a copy - if (n<=1) return + allocate( character(len=MAX_INT_STR_LEN) :: s ) ! should be big enough + write(s,fmt='(ss,I0)',iostat=istat) i + if (istat==0) then + s = trim(adjustl(s)) + else + s = '***' + end if - ! get the unique elements by sorting the array - ! and then excluding any that are the same as the previous element. - call sort_ascending(vec_unique) - allocate(mask(n)); mask(1) = .true. - do i = 2, n - mask(i) = (vec_unique(i)%ivertex/=vec_unique(i-1)%ivertex) - end do - vec_unique = pack(vec_unique, mask) - - end function unique -!******************************************************************************* - -!******************************************************************************* -!> -! Sorts an [[edge]] array `ivec` in increasing order by vertex number. -! Uses a basic recursive quicksort -! (with insertion sort for partitions with \(\le\) 20 elements). - - subroutine sort_ascending(ivec) - - type(edge),dimension(:),intent(inout) :: ivec - - integer(ip),parameter :: max_size_for_insertion_sort = 20_ip !! max size for using insertion sort. - - call quicksort(1_ip,size(ivec,kind=ip)) - - contains - - recursive subroutine quicksort(ilow,ihigh) + end function integer_to_string +!******************************************************************************* + +!******************************************************************************* +!> +! Return only the unique values from `vec`. +! The result is also sorted by ascending value. + + function unique(vec) result(vec_unique) + + type(edge),dimension(:),intent(in) :: vec + type(edge),dimension(:),allocatable :: vec_unique !! only the unique elements of `vec` + + integer(ip) :: i !! counter + integer(ip) :: n !! size of `vec` + logical,dimension(:),allocatable :: mask !! for flagging the unique values + + n = size(vec) + vec_unique = vec ! make a copy + if (n<=1) return + + ! get the unique elements by sorting the array + ! and then excluding any that are the same as the previous element. + call sort_ascending(vec_unique) + allocate(mask(n)); mask(1) = .true. + do i = 2, n + mask(i) = (vec_unique(i)%ivertex/=vec_unique(i-1)%ivertex) + end do + vec_unique = pack(vec_unique, mask) - !! Sort the array - - integer(ip),intent(in) :: ilow - integer(ip),intent(in) :: ihigh - - integer(ip) :: ipivot !! pivot element - integer(ip) :: i !! counter - integer(ip) :: j !! counter + end function unique +!******************************************************************************* + +!******************************************************************************* +!> +! Sorts an [[edge]] array `ivec` in increasing order by vertex number. +! Uses a basic recursive quicksort +! (with insertion sort for partitions with \(\le\) 20 elements). - if ( ihigh-ilow<=max_size_for_insertion_sort .and. ihigh>ilow ) then + subroutine sort_ascending(ivec) - ! do insertion sort: - do i = ilow + 1,ihigh - do j = i,ilow + 1,-1 - if ( ivec(j)%ivertex < ivec(j-1)%ivertex ) then - call swap(ivec(j),ivec(j-1)) - else - exit - end if - end do - end do - - elseif ( ihigh-ilow>max_size_for_insertion_sort ) then - - ! do the normal quicksort: - call partition(ilow,ihigh,ipivot) - call quicksort(ilow,ipivot - 1_ip) - call quicksort(ipivot + 1_ip,ihigh) - - end if - - end subroutine quicksort - - subroutine partition(ilow,ihigh,ipivot) - - !! Partition the array, based on the - !! lexical ivecing comparison. - - integer(ip),intent(in) :: ilow - integer(ip),intent(in) :: ihigh - integer(ip),intent(out) :: ipivot - - integer(ip) :: i,ii - - call swap(ivec(ilow),ivec((ilow+ihigh)/2)) - ii = ilow - do i = ilow + 1, ihigh - if ( ivec(i)%ivertex < ivec(ilow)%ivertex ) then - ii = ii + 1 - call swap(ivec(ii),ivec(i)) - end if - end do - call swap(ivec(ilow),ivec(ii)) - ipivot = ii - - end subroutine partition - - end subroutine sort_ascending -!******************************************************************************* - -!******************************************************************************* -!> -! Swap two [[edge]] values. - - pure elemental subroutine swap(i1,i2) - - type(edge),intent(inout) :: i1 - type(edge),intent(inout) :: i2 - - type(edge) :: tmp - - tmp = i1 - i1 = i2 - i2 = tmp - - end subroutine swap -!******************************************************************************* + type(edge),dimension(:),intent(inout) :: ivec + + integer(ip),parameter :: max_size_for_insertion_sort = 20_ip !! max size for using insertion sort. + + call quicksort(1_ip,size(ivec,kind=ip)) + + contains + + recursive subroutine quicksort(ilow,ihigh) + + !! Sort the array + + integer(ip),intent(in) :: ilow + integer(ip),intent(in) :: ihigh + + integer(ip) :: ipivot !! pivot element + integer(ip) :: i !! counter + integer(ip) :: j !! counter + + if ( ihigh-ilow<=max_size_for_insertion_sort .and. ihigh>ilow ) then + + ! do insertion sort: + do i = ilow + 1,ihigh + do j = i,ilow + 1,-1 + if ( ivec(j)%ivertex < ivec(j-1)%ivertex ) then + call swap(ivec(j),ivec(j-1)) + else + exit + end if + end do + end do + + elseif ( ihigh-ilow>max_size_for_insertion_sort ) then + + ! do the normal quicksort: + call partition(ilow,ihigh,ipivot) + call quicksort(ilow,ipivot - 1_ip) + call quicksort(ipivot + 1_ip,ihigh) + + end if + + end subroutine quicksort + + subroutine partition(ilow,ihigh,ipivot) + + !! Partition the array, based on the + !! lexical ivecing comparison. + + integer(ip),intent(in) :: ilow + integer(ip),intent(in) :: ihigh + integer(ip),intent(out) :: ipivot + + integer(ip) :: i,ii + + call swap(ivec(ilow),ivec((ilow+ihigh)/2)) + ii = ilow + do i = ilow + 1, ihigh + if ( ivec(i)%ivertex < ivec(ilow)%ivertex ) then + ii = ii + 1 + call swap(ivec(ii),ivec(i)) + end if + end do + call swap(ivec(ilow),ivec(ii)) + ipivot = ii + + end subroutine partition -!******************************************************************************* - end module dag_module -!******************************************************************************* + end subroutine sort_ascending +!******************************************************************************* + +!******************************************************************************* +!> +! Swap two [[edge]] values. + + pure elemental subroutine swap(i1,i2) + + type(edge),intent(inout) :: i1 + type(edge),intent(inout) :: i2 + + type(edge) :: tmp + + tmp = i1 + i1 = i2 + i2 = tmp + + end subroutine swap +!******************************************************************************* + +!******************************************************************************* + end module dag_module +!******************************************************************************* diff --git a/src/dag_module.F90 b/src/dag_module.F90 index 0c43648..b40c524 100644 --- a/src/dag_module.F90 +++ b/src/dag_module.F90 @@ -71,6 +71,7 @@ module dag_module procedure,public :: set_vertices => dag_set_vertices generic,public :: set_edges => dag_set_edges_no_atts, & dag_set_edges_vector_atts + procedure,public :: add_edge => dag_add_edge procedure,public :: remove_edge => dag_remove_edge procedure,public :: remove_vertex => dag_remove_node procedure,public :: set_vertex_info => dag_set_vertex_info @@ -393,6 +394,26 @@ function dag_get_vertex(me,i) result(v) end function dag_get_vertex !******************************************************************************* +!******************************************************************************* +!> +! Add an edge to a dag. + + subroutine dag_add_edge(me,ivertex,iedge,label,attributes) + + class(dag),intent(inout) :: me + integer(ip),intent(in) :: ivertex !! vertex number + integer(ip),intent(in) :: iedge !! the vertex to connect to `ivertex` + character(len=*),intent(in),optional :: label !! edge label + character(len=*),intent(in),optional :: attributes !! other attributes when + !! saving as a diagraph. + + call me%vertices(ivertex)%set_edges(iedge,& + label=label,& + attributes=attributes) + + end subroutine dag_add_edge +!******************************************************************************* + !******************************************************************************* !> ! set the edges for a vertex in a dag diff --git a/tipuesearch/tipuesearch_content.js b/tipuesearch/tipuesearch_content.js index 7ed916d..37aaf99 100644 --- a/tipuesearch/tipuesearch_content.js +++ b/tipuesearch/tipuesearch_content.js @@ -1 +1 @@ -var tipuesearch = {"pages":[{"title":" daglib ","text":"daglib Overview DAGLIB is a modern Fortran module for creating and manipulating directed acyclic graphs (DAGs). It includes a toposort feature, and also the ability to generate files in the GraphViz \"dot\" notation. Building A Fortran Package Manager manifest file is included, so that the library and tests cases can be compiled with FPM. For example: fpm build --profile release\nfpm test --profile release By default, the library is built with single precision ( int32 ) integer values. Explicitly specifying the integer kind can be done using the following processor flag: Preprocessor flag Kind Number of bytes INT8 integer(kind=int8) 1 INT16 integer(kind=int16) 2 INT32 integer(kind=int32) 4 INT64 integer(kind=int64) 8 For example, to build a long integer version of the library: fpm build --profile release --flag \"-DINT64\" Example A simple example is shown below: program dag_example use dag_module implicit none type ( dag ) :: d integer , dimension (:), allocatable :: order integer :: istat integer :: i integer , parameter :: n_nodes = 6 character ( len =* ), parameter :: filetype = 'pdf' ! create a dag: call d % set_vertices ( n_nodes ) call d % set_edges ( 2 ,[ 1 ]) ! 2 depends on 1 call d % set_edges ( 3 ,[ 5 , 1 ]) ! 3 depends on 5 and 1 call d % set_edges ( 4 ,[ 5 ]) ! 4 depends on 5 call d % set_edges ( 5 ,[ 2 ]) ! 5 depends on 2 call d % set_edges ( 6 ,[ 2 , 4 ]) ! 6 depends on 2 and 4 ! toposort: call d % toposort ( order , istat ) ! define some styles for the GraphViz output: do i = 1 , n_nodes if ( i == 3 . or . i == 6 ) then call d % set_vertex_info ( i , attributes = 'shape=square,fillcolor=\"SlateGray1\",style=filled' ) else call d % set_vertex_info ( i , attributes = 'shape=circle,fillcolor=\"cornsilk\",style=filled' ) end if end do ! generate the GraphViz output: call d % save_digraph ( 'test.dot' , 'RL' , 300 ) call d % destroy () call execute_command_line ( 'dot -Tpdf -o test.pdf test.dot' ) end program dag_example This program produces the toposort order: order = [1, 2, 5, 3, 4, 6] and the image file: Documentation The API documentation for the current master branch can be found here . This is generated by processing the source files with FORD . License This library is released under a BSD-3 license . See also dag (a fork of this project) Developer Info Jacob Williams","tags":"home","loc":"index.html"},{"title":"edge – daglib ","text":"type, private :: edge the \"to\" vertex that defines an edge. This is part of\nthe array of vertices contained without the \"from\" vertex type.\nan edge can also have optional attrubutes for graphviz. Inherited by type~~edge~~InheritedByGraph type~edge edge type~vertex vertex type~vertex->type~edge edges type~dag dag type~dag->type~vertex vertices Help × Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial integer(kind=ip), public :: ivertex = 0 vertex number (the index in the dag vertices array) character(len=:), public, allocatable :: label used for diagraph character(len=:), public, allocatable :: attributes used for diagraph Constructor private interface edge constructor for an edge type. private pure elemental function edge_constructor (ivertex, label, attributes) result(e) Constructor for edge type. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in), optional :: ivertex character(len=*), intent(in), optional :: label character(len=*), intent(in), optional :: attributes Return Value type( edge ) Source Code type :: edge !! the \"to\" vertex that defines an edge. This is part of !! the array of vertices contained without the \"from\" [[vertex]] type. !! an edge can also have optional attrubutes for graphviz. integer ( ip ) :: ivertex = 0 !! vertex number (the index in the [[dag]] `vertices` array) character ( len = :), allocatable :: label !! used for diagraph character ( len = :), allocatable :: attributes !! used for diagraph end type edge","tags":"","loc":"type/edge.html"},{"title":"vertex – daglib ","text":"type, private :: vertex a vertex (or node) of a directed acyclic graph (DAG) Inherits type~~vertex~~InheritsGraph type~vertex vertex type~edge edge type~vertex->type~edge edges Help × Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Inherited by type~~vertex~~InheritedByGraph type~vertex vertex type~dag dag type~dag->type~vertex vertices Help × Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial type( edge ), private, dimension(:), allocatable :: edges these are the vertices that this vertex\ndepends on. (edges of the graph). integer(kind=ip), private :: ivertex = 0 vertex number (the index in the dag vertices array) logical, private :: checking = .false. used for toposort logical, private :: marked = .false. used for toposort character(len=:), private, allocatable :: label used for diagraph character(len=:), private, allocatable :: attributes used for diagraph Type-Bound Procedures generic, private :: set_edges => set_edge_vector_vector , add_edge private subroutine set_edge_vector_vector (me, edges, label, attributes) specify the edge indices for this vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in), dimension(:) :: edges character(len=*), intent(in), optional, dimension(:) :: label character(len=*), intent(in), optional, dimension(:) :: attributes other attributes when\nsaving as a diagraph. private subroutine add_edge (me, e, label, attributes) add an edge index for this vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in) :: e character(len=*), intent(in), optional :: label character(len=*), intent(in), optional :: attributes other attributes when\nsaving as a diagraph. procedure, private :: add_edge private subroutine add_edge (me, e, label, attributes) add an edge index for this vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in) :: e character(len=*), intent(in), optional :: label character(len=*), intent(in), optional :: attributes other attributes when\nsaving as a diagraph. procedure, private :: set_edge_vector_vector private subroutine set_edge_vector_vector (me, edges, label, attributes) specify the edge indices for this vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in), dimension(:) :: edges character(len=*), intent(in), optional, dimension(:) :: label character(len=*), intent(in), optional, dimension(:) :: attributes other attributes when\nsaving as a diagraph. procedure, private :: remove_edge private subroutine remove_edge (me, e) remove an edge index from this vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in) :: e Source Code type :: vertex !! a vertex (or node) of a directed acyclic graph (DAG) private type ( edge ), dimension (:), allocatable :: edges !! these are the vertices that this vertex !! depends on. (edges of the graph). integer ( ip ) :: ivertex = 0 !! vertex number (the index in the [[dag]] `vertices` array) logical :: checking = . false . !! used for toposort logical :: marked = . false . !! used for toposort character ( len = :), allocatable :: label !! used for diagraph character ( len = :), allocatable :: attributes !! used for diagraph contains private generic :: set_edges => set_edge_vector_vector , add_edge procedure :: set_edge_vector_vector , add_edge procedure :: remove_edge end type vertex","tags":"","loc":"type/vertex.html"},{"title":"dag – daglib ","text":"type, public :: dag a directed acyclic graph (DAG).\na collection of vertices (nodes) that are connected to other vertices. Inherits type~~dag~~InheritsGraph type~dag dag type~vertex vertex type~dag->type~vertex vertices type~edge edge type~vertex->type~edge edges Help × Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial integer(kind=ip), private :: n = 0 number of vertices (size of vertices array) type( vertex ), private, dimension(:), allocatable :: vertices the vertices in the DAG. The index in\nthis array if the vertex number. Type-Bound Procedures procedure, public :: vertex => dag_get_vertex not very useful for now, since\nall vertex attributes are private private function dag_get_vertex (me, i) result(v) Get the i th vertex. Read more… Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: i vertex number Return Value type( vertex ) procedure, public :: number_of_vertices => dag_get_number_of_vertices private pure function dag_get_number_of_vertices (me) result(nvertices) Returns the number of vertices (nodes) in the dag. Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me Return Value integer(kind=ip) number of vertices procedure, public :: set_vertices => dag_set_vertices private subroutine dag_set_vertices (me, nvertices, labels) set the number of vertices (nodes) in the dag. Read more… Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: nvertices number of vertices character(len=*), intent(in), optional, dimension(nvertices) :: labels vertex name strings generic, public :: set_edges => dag_set_edges_no_atts , dag_set_edges_vector_atts private subroutine dag_set_edges_no_atts (me, ivertex, edges) set the edges for a vertex in a dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in), dimension(:) :: edges private subroutine dag_set_edges_vector_atts (me, ivertex, edges, attributes, label) set the edges for a vertex in a dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in), dimension(:) :: edges character(len=*), intent(in), dimension(:) :: attributes other attributes when\nsaving as a diagraph. character(len=*), intent(in), optional, dimension(:) :: label procedure, public :: remove_edge => dag_remove_edge private subroutine dag_remove_edge (me, ivertex, iedge) Remove an edge from a dag. Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in) :: iedge the edge to remove procedure, public :: remove_vertex => dag_remove_node private subroutine dag_remove_node (me, ivertex) Remove a node from a dag. Will also remove any edges connected to it. Read more… Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex the node to remove procedure, public :: set_vertex_info => dag_set_vertex_info private subroutine dag_set_vertex_info (me, ivertex, label, attributes) set info about a vertex in a dag. Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number character(len=*), intent(in), optional :: label if a label is not set,\nthen the integer vertex\nnumber is used. character(len=*), intent(in), optional :: attributes other attributes when\nsaving as a diagraph. procedure, public :: toposort => dag_toposort private subroutine dag_toposort (me, order, istat) Main toposort routine Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(out), dimension(:), allocatable :: order the toposort order integer(kind=ip), intent(out) :: istat Status flag: Read more… procedure, public :: generate_digraph => dag_generate_digraph private function dag_generate_digraph (me, rankdir, dpi) result(str) Generate a Graphviz digraph structure for the DAG. Read more… Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me character(len=*), intent(in), optional :: rankdir right to left orientation (e.g. 'RL') integer(kind=ip), intent(in), optional :: dpi resolution (e.g. 300) Return Value character(len=:), allocatable procedure, public :: generate_dependency_matrix => dag_generate_dependency_matrix private subroutine dag_generate_dependency_matrix (me, mat) Generate the dependency matrix for the DAG. Read more… Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me logical, intent(out), dimension(:,:), allocatable :: mat dependency matrix procedure, public :: save_digraph => dag_save_digraph private subroutine dag_save_digraph (me, filename, rankdir, dpi) Generate a Graphviz digraph structure for the DAG and write it to a file. Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me character(len=*), intent(in), optional :: filename file name for diagraph character(len=*), intent(in), optional :: rankdir right to left orientation (e.g. 'RL') integer(kind=ip), intent(in), optional :: dpi resolution (e.g. 300) procedure, public :: get_edges => dag_get_edges private pure function dag_get_edges (me, ivertex) result(edges) get the edges for the vertex (all of the vertices\nthat this vertex depends on). Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me integer(kind=ip), intent(in) :: ivertex Return Value integer(kind=ip), dimension(:), allocatable procedure, public :: get_dependencies => dag_get_dependencies private pure function dag_get_dependencies (me, ivertex) result(dep) get all the vertices that depend on this vertex. Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me integer(kind=ip), intent(in) :: ivertex Return Value integer(kind=ip), dimension(:), allocatable the set of all vertices\nthan depend on ivertex procedure, public :: destroy => dag_destroy private subroutine dag_destroy (me) Destroy the dag . Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me procedure, private :: init_internal_vars private routine to initialize some internal variables private subroutine init_internal_vars (me) Initialize the internal private variables used for graph traversal. Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me procedure, private :: dag_set_edges_vector_atts private subroutine dag_set_edges_vector_atts (me, ivertex, edges, attributes, label) set the edges for a vertex in a dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in), dimension(:) :: edges character(len=*), intent(in), dimension(:) :: attributes other attributes when\nsaving as a diagraph. character(len=*), intent(in), optional, dimension(:) :: label procedure, private :: dag_set_edges_no_atts private subroutine dag_set_edges_no_atts (me, ivertex, edges) set the edges for a vertex in a dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in), dimension(:) :: edges Source Code type , public :: dag !! a directed acyclic graph (DAG). !! a collection of vertices (nodes) that are connected to other vertices. private integer ( ip ) :: n = 0 !! number of vertices (size of `vertices` array) type ( vertex ), dimension (:), allocatable :: vertices !! the vertices in the DAG. The index in !! this array if the vertex number. contains private procedure , public :: vertex => dag_get_vertex !! not very useful for now, since !! all vertex attributes are private procedure , public :: number_of_vertices => dag_get_number_of_vertices procedure , public :: set_vertices => dag_set_vertices generic , public :: set_edges => dag_set_edges_no_atts , & dag_set_edges_vector_atts procedure , public :: remove_edge => dag_remove_edge procedure , public :: remove_vertex => dag_remove_node procedure , public :: set_vertex_info => dag_set_vertex_info procedure , public :: toposort => dag_toposort procedure , public :: generate_digraph => dag_generate_digraph procedure , public :: generate_dependency_matrix => dag_generate_dependency_matrix procedure , public :: save_digraph => dag_save_digraph procedure , public :: get_edges => dag_get_edges procedure , public :: get_dependencies => dag_get_dependencies procedure , public :: destroy => dag_destroy procedure :: init_internal_vars !! private routine to initialize some internal variables procedure :: dag_set_edges_no_atts , dag_set_edges_vector_atts end type dag","tags":"","loc":"type/dag.html"},{"title":"edge_constructor – daglib","text":"private pure elemental function edge_constructor(ivertex, label, attributes) result(e) Constructor for edge type. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in), optional :: ivertex character(len=*), intent(in), optional :: label character(len=*), intent(in), optional :: attributes Return Value type( edge ) Called by proc~~edge_constructor~~CalledByGraph proc~edge_constructor dag_module::edge_constructor interface~edge dag_module::edge interface~edge->proc~edge_constructor Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure elemental function edge_constructor ( ivertex , label , attributes ) result ( e ) integer ( ip ), intent ( in ), optional :: ivertex character ( len =* ), intent ( in ), optional :: label character ( len =* ), intent ( in ), optional :: attributes type ( edge ) :: e e % ivertex = ivertex if ( present ( label )) e % label = label if ( present ( attributes )) e % attributes = attributes end function edge_constructor","tags":"","loc":"proc/edge_constructor.html"},{"title":"dag_get_edges – daglib","text":"private pure function dag_get_edges(me, ivertex) result(edges) get the edges for the vertex (all of the vertices\nthat this vertex depends on). Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me integer(kind=ip), intent(in) :: ivertex Return Value integer(kind=ip), dimension(:), allocatable Source Code pure function dag_get_edges ( me , ivertex ) result ( edges ) class ( dag ), intent ( in ) :: me integer ( ip ), intent ( in ) :: ivertex integer ( ip ), dimension (:), allocatable :: edges if ( ivertex > 0 . and . ivertex <= me % n ) then edges = me % vertices ( ivertex )% edges % ivertex ! auto LHS allocation end if end function dag_get_edges","tags":"","loc":"proc/dag_get_edges.html"},{"title":"dag_get_dependencies – daglib","text":"private pure function dag_get_dependencies(me, ivertex) result(dep) get all the vertices that depend on this vertex. Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me integer(kind=ip), intent(in) :: ivertex Return Value integer(kind=ip), dimension(:), allocatable the set of all vertices\nthan depend on ivertex Source Code pure function dag_get_dependencies ( me , ivertex ) result ( dep ) class ( dag ), intent ( in ) :: me integer ( ip ), intent ( in ) :: ivertex integer ( ip ), dimension (:), allocatable :: dep !! the set of all vertices !! than depend on `ivertex` integer ( ip ) :: i !! vertex counter if ( ivertex > 0 . and . ivertex <= me % n ) then ! have to check all the vertices: do i = 1 , me % n if ( allocated ( me % vertices ( i )% edges )) then if ( any ( me % vertices ( i )% edges % ivertex == ivertex )) then if ( allocated ( dep )) then dep = [ dep , i ] ! auto LHS allocation else dep = [ i ] ! auto LHS allocation end if end if end if end do end if end function dag_get_dependencies","tags":"","loc":"proc/dag_get_dependencies.html"},{"title":"dag_get_number_of_vertices – daglib","text":"private pure function dag_get_number_of_vertices(me) result(nvertices) Returns the number of vertices (nodes) in the dag. Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me Return Value integer(kind=ip) number of vertices Source Code pure function dag_get_number_of_vertices ( me ) result ( nvertices ) class ( dag ), intent ( in ) :: me integer ( ip ) :: nvertices !! number of vertices nvertices = me % n end function dag_get_number_of_vertices","tags":"","loc":"proc/dag_get_number_of_vertices.html"},{"title":"dag_get_vertex – daglib","text":"private function dag_get_vertex(me, i) result(v) Get the i th vertex. The program will stop if vertex i does not exist. Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: i vertex number Return Value type( vertex ) Source Code function dag_get_vertex ( me , i ) result ( v ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: i !! vertex number type ( vertex ) :: v if ( i < 0 . or . i > me % n ) then error stop 'Error in dag_get_vertex: invalid vertex number' else v = me % vertices ( i ) end if end function dag_get_vertex","tags":"","loc":"proc/dag_get_vertex.html"},{"title":"dag_generate_digraph – daglib","text":"private function dag_generate_digraph(me, rankdir, dpi) result(str) Generate a Graphviz digraph structure for the DAG. Example To convert this to a PDF using dot : dot -Tpdf -o test.pdf test.dot ,\n where test.dot is str written to a file. Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me character(len=*), intent(in), optional :: rankdir right to left orientation (e.g. 'RL') integer(kind=ip), intent(in), optional :: dpi resolution (e.g. 300) Return Value character(len=:), allocatable Calls proc~~dag_generate_digraph~~CallsGraph proc~dag_generate_digraph dag_module::dag%dag_generate_digraph proc~integer_to_string dag_module::integer_to_string proc~dag_generate_digraph->proc~integer_to_string Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dag_generate_digraph~~CalledByGraph proc~dag_generate_digraph dag_module::dag%dag_generate_digraph proc~dag_save_digraph dag_module::dag%dag_save_digraph proc~dag_save_digraph->proc~dag_generate_digraph Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code function dag_generate_digraph ( me , rankdir , dpi ) result ( str ) class ( dag ), intent ( in ) :: me character ( len = :), allocatable :: str character ( len =* ), intent ( in ), optional :: rankdir !! right to left orientation (e.g. 'RL') integer ( ip ), intent ( in ), optional :: dpi !! resolution (e.g. 300) integer ( ip ) :: i , j !! counter integer ( ip ) :: n_edges !! number of edges character ( len = :), allocatable :: attributes !! full attributes string for node or edge logical :: compress !! if we can write all the edges on one line character ( len =* ), parameter :: tab = ' ' !! for indenting character ( len =* ), parameter :: newline = new_line ( ' ' ) !! line break character if ( me % n == 0 ) return str = 'digraph G {' // newline // newline if ( present ( rankdir )) & str = str // tab // 'rankdir=' // rankdir // newline // newline if ( present ( dpi )) & str = str // tab // 'graph [ dpi = ' // integer_to_string ( dpi ) // ' ]' // newline // newline ! define the vertices: do i = 1 , me % n attributes = get_attributes_string ( me % vertices ( i )% label , & me % vertices ( i )% attributes ) str = str // tab // integer_to_string ( i ) // ' ' // attributes // newline if ( i == me % n ) str = str // newline end do ! define the dependencies: do i = 1 , me % n if ( allocated ( me % vertices ( i )% edges )) then n_edges = size ( me % vertices ( i )% edges ) ! if none of the edges have attributes, ! then we can write them all on one line ! otherwise, write them line by line compress = . true . do j = 1 , n_edges if ( allocated ( me % vertices ( i )% edges ( j )% label ) . or . & allocated ( me % vertices ( i )% edges ( j )% attributes )) then compress = . false . exit end if end do if (. not . compress ) then ! Example: 1 -> 2 [penwidth=2, arrowhead=none] do j = 1 , n_edges attributes = get_attributes_string ( me % vertices ( i )% edges ( j )% label , & me % vertices ( i )% edges ( j )% attributes ) str = str // tab // integer_to_string ( i ) // ' -> ' // & integer_to_string ( me % vertices ( i )% edges ( j )% ivertex ) // ' ' // attributes // newline end do else ! Example: 1 -> 2,5,10 str = str // tab // integer_to_string ( i ) // merge ( ' -> ' , ' ' , n_edges /= 0 ) do j = 1 , n_edges ! comma-separated list: str = str // integer_to_string ( me % vertices ( i )% edges ( j )% ivertex ) if ( n_edges > 1 . and . j < n_edges ) str = str // ',' end do str = str // ';' // newline end if end if end do str = str // newline // '}' contains function get_attributes_string ( label , attributes ) result ( str ) !! create the full attributes string for an edge or node. character ( len = :), allocatable , intent ( in ) :: label !! if not allocated or blank, then not used character ( len = :), allocatable , intent ( in ) :: attributes !! if not allocated or blank, then not used character ( len = :), allocatable :: str !! the attributes string, enclosed in brackets character ( len = :), allocatable :: tmp_label logical :: has_label , has_attributes has_label = allocated ( label ) if ( has_label ) has_label = label /= '' if ( has_label ) tmp_label = 'label=\"' // trim ( adjustl ( label )) // '\"' has_attributes = allocated ( attributes ) if ( has_attributes ) has_attributes = attributes /= '' if ( has_label . and . has_attributes ) then str = '[' // trim ( adjustl ( attributes )) // ',' // tmp_label // ']' elseif ( has_label . and . . not . has_attributes ) then str = '[' // tmp_label // ']' elseif (. not . has_label . and . has_attributes ) then str = '[' // trim ( adjustl ( attributes )) // ']' else ! neither str = '' end if end function get_attributes_string end function dag_generate_digraph","tags":"","loc":"proc/dag_generate_digraph.html"},{"title":"integer_to_string – daglib","text":"private pure function integer_to_string(i) result(s) Integer to allocatable string. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in) :: i Return Value character(len=:), allocatable Called by proc~~integer_to_string~~CalledByGraph proc~integer_to_string dag_module::integer_to_string proc~dag_generate_digraph dag_module::dag%dag_generate_digraph proc~dag_generate_digraph->proc~integer_to_string proc~dag_set_vertices dag_module::dag%dag_set_vertices proc~dag_set_vertices->proc~integer_to_string proc~dag_save_digraph dag_module::dag%dag_save_digraph proc~dag_save_digraph->proc~dag_generate_digraph Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function integer_to_string ( i ) result ( s ) integer ( ip ), intent ( in ) :: i character ( len = :), allocatable :: s integer ( ip ) :: istat allocate ( character ( len = MAX_INT_STR_LEN ) :: s ) ! should be big enough write ( s , fmt = '(ss,I0)' , iostat = istat ) i if ( istat == 0 ) then s = trim ( adjustl ( s )) else s = '***' end if end function integer_to_string","tags":"","loc":"proc/integer_to_string.html"},{"title":"unique – daglib","text":"private function unique(vec) result(vec_unique) Return only the unique values from vec .\nThe result is also sorted by ascending value. Arguments Type Intent Optional Attributes Name type( edge ), intent(in), dimension(:) :: vec Return Value type( edge ), dimension(:), allocatable only the unique elements of vec Calls proc~~unique~~CallsGraph proc~unique dag_module::unique proc~sort_ascending dag_module::sort_ascending proc~unique->proc~sort_ascending proc~swap dag_module::swap proc~sort_ascending->proc~swap Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code function unique ( vec ) result ( vec_unique ) type ( edge ), dimension (:), intent ( in ) :: vec type ( edge ), dimension (:), allocatable :: vec_unique !! only the unique elements of `vec` integer ( ip ) :: i !! counter integer ( ip ) :: n !! size of `vec` logical , dimension (:), allocatable :: mask !! for flagging the unique values n = size ( vec ) vec_unique = vec ! make a copy if ( n <= 1 ) return ! get the unique elements by sorting the array ! and then excluding any that are the same as the previous element. call sort_ascending ( vec_unique ) allocate ( mask ( n )); mask ( 1 ) = . true . do i = 2 , n mask ( i ) = ( vec_unique ( i )% ivertex /= vec_unique ( i - 1 )% ivertex ) end do vec_unique = pack ( vec_unique , mask ) end function unique","tags":"","loc":"proc/unique.html"},{"title":"dag_destroy – daglib","text":"private subroutine dag_destroy(me) Destroy the dag . Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me Source Code subroutine dag_destroy ( me ) class ( dag ), intent ( inout ) :: me me % n = 0 if ( allocated ( me % vertices )) deallocate ( me % vertices ) end subroutine dag_destroy","tags":"","loc":"proc/dag_destroy.html"},{"title":"set_edge_vector_vector – daglib","text":"private subroutine set_edge_vector_vector(me, edges, label, attributes) specify the edge indices for this vertex Type Bound vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in), dimension(:) :: edges character(len=*), intent(in), optional, dimension(:) :: label character(len=*), intent(in), optional, dimension(:) :: attributes other attributes when\nsaving as a diagraph. Calls proc~~set_edge_vector_vector~~CallsGraph proc~set_edge_vector_vector dag_module::vertex%set_edge_vector_vector proc~add_edge dag_module::vertex%add_edge proc~set_edge_vector_vector->proc~add_edge proc~sort_ascending dag_module::sort_ascending proc~add_edge->proc~sort_ascending proc~swap dag_module::swap proc~sort_ascending->proc~swap Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~set_edge_vector_vector~~CalledByGraph proc~set_edge_vector_vector dag_module::vertex%set_edge_vector_vector none~set_edges dag_module::vertex%set_edges none~set_edges->proc~set_edge_vector_vector proc~dag_set_edges_no_atts dag_module::dag%dag_set_edges_no_atts proc~dag_set_edges_no_atts->none~set_edges proc~dag_set_edges_vector_atts dag_module::dag%dag_set_edges_vector_atts proc~dag_set_edges_vector_atts->none~set_edges Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine set_edge_vector_vector ( me , edges , label , attributes ) class ( vertex ), intent ( inout ) :: me integer ( ip ), dimension (:), intent ( in ) :: edges character ( len =* ), dimension (:), intent ( in ), optional :: label character ( len =* ), dimension (:), intent ( in ), optional :: attributes !! other attributes when !! saving as a diagraph. integer ( ip ) :: i !! counter do i = 1 , size ( edges ) if ( present ( label ) . and . present ( attributes )) then call me % add_edge ( edges ( i ), label = label ( i ), attributes = attributes ( i )) else if (. not . present ( label ) . and . present ( attributes )) then call me % add_edge ( edges ( i ), attributes = attributes ( i )) else if ( present ( label ) . and . . not . present ( attributes )) then call me % add_edge ( edges ( i ), label = label ( i )) else call me % add_edge ( edges ( i )) end if end do end subroutine set_edge_vector_vector","tags":"","loc":"proc/set_edge_vector_vector.html"},{"title":"add_edge – daglib","text":"private subroutine add_edge(me, e, label, attributes) add an edge index for this vertex Type Bound vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in) :: e character(len=*), intent(in), optional :: label character(len=*), intent(in), optional :: attributes other attributes when\nsaving as a diagraph. Calls proc~~add_edge~~CallsGraph proc~add_edge dag_module::vertex%add_edge proc~sort_ascending dag_module::sort_ascending proc~add_edge->proc~sort_ascending proc~swap dag_module::swap proc~sort_ascending->proc~swap Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~add_edge~~CalledByGraph proc~add_edge dag_module::vertex%add_edge none~set_edges dag_module::vertex%set_edges none~set_edges->proc~add_edge proc~set_edge_vector_vector dag_module::vertex%set_edge_vector_vector none~set_edges->proc~set_edge_vector_vector proc~set_edge_vector_vector->proc~add_edge proc~dag_set_edges_no_atts dag_module::dag%dag_set_edges_no_atts proc~dag_set_edges_no_atts->none~set_edges proc~dag_set_edges_vector_atts dag_module::dag%dag_set_edges_vector_atts proc~dag_set_edges_vector_atts->none~set_edges Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine add_edge ( me , e , label , attributes ) class ( vertex ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: e character ( len =* ), intent ( in ), optional :: label character ( len =* ), intent ( in ), optional :: attributes !! other attributes when !! saving as a diagraph. if ( allocated ( me % edges )) then if (. not . any ( e == me % edges % ivertex )) then ! don't add if already there me % edges = [ me % edges , edge ( e , label = label , attributes = attributes )] call sort_ascending ( me % edges ) end if else me % edges = [ edge ( e , label = label , attributes = attributes )] end if end subroutine add_edge","tags":"","loc":"proc/add_edge.html"},{"title":"remove_edge – daglib","text":"private subroutine remove_edge(me, e) remove an edge index from this vertex Type Bound vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in) :: e Called by proc~~remove_edge~~CalledByGraph proc~remove_edge dag_module::vertex%remove_edge proc~dag_remove_edge dag_module::dag%dag_remove_edge proc~dag_remove_edge->proc~remove_edge proc~dag_remove_node dag_module::dag%dag_remove_node proc~dag_remove_node->proc~remove_edge Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine remove_edge ( me , e ) class ( vertex ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: e integer ( ip ), dimension ( 1 ) :: idx type ( edge ), dimension (:), allocatable :: tmp if ( allocated ( me % edges )) then idx = findloc ( me % edges % ivertex , e ) if ( idx ( 1 ) > 0 ) then ! the edge is in the list associate ( i => idx ( 1 ), n => size ( me % edges )) if ( n == 1 ) then deallocate ( me % edges ) ! it's the only one there else allocate ( tmp ( n - 1 )) if ( i > 1 ) tmp ( 1 : i - 1 ) = me % edges ( 1 : i - 1 ) if ( i < n ) tmp ( i : n - 1 ) = me % edges ( i + 1 : n ) call move_alloc ( tmp , me % edges ) end if end associate end if end if end subroutine remove_edge","tags":"","loc":"proc/remove_edge.html"},{"title":"dag_remove_node – daglib","text":"private subroutine dag_remove_node(me, ivertex) Remove a node from a dag. Will also remove any edges connected to it. This will renumber the nodes and edges internally.\nNote that any default integer labels generated in dag_set_vertices would then be questionable. Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex the node to remove Calls proc~~dag_remove_node~~CallsGraph proc~dag_remove_node dag_module::dag%dag_remove_node proc~remove_edge dag_module::vertex%remove_edge proc~dag_remove_node->proc~remove_edge Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dag_remove_node ( me , ivertex ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! the node to remove integer ( ip ) :: i !! counter type ( vertex ), dimension (:), allocatable :: tmp !! for resizing `me%vertices` if ( allocated ( me % vertices )) then associate ( n => size ( me % vertices )) do i = 1 , n ! first remove any edges: call me % vertices ( i )% remove_edge ( ivertex ) ! next, renumber the existing edges so they will be ! correct after ivertex is deleted ! Example (removing 2): 1 [2] 3 4 ==> 1 2 3 if ( allocated ( me % vertices ( i )% edges )) then where ( me % vertices ( i )% edges % ivertex > ivertex ) me % vertices ( i )% edges % ivertex = me % vertices ( i )% edges % ivertex - 1 end where end if end do ! now, remove the node: allocate ( tmp ( n - 1 )) if ( ivertex > 1 ) tmp ( 1 : ivertex - 1 ) = me % vertices ( 1 : ivertex - 1 ) if ( ivertex < n ) tmp ( ivertex : n - 1 ) = me % vertices ( ivertex + 1 : n ) call move_alloc ( tmp , me % vertices ) end associate end if me % n = size ( me % vertices ) if ( me % n == 0 ) deallocate ( me % vertices ) end subroutine dag_remove_node","tags":"","loc":"proc/dag_remove_node.html"},{"title":"dag_set_vertices – daglib","text":"private subroutine dag_set_vertices(me, nvertices, labels) set the number of vertices (nodes) in the dag. See also dag_remove_node which can be used to remove a vertex. dag_set_vertex_info which can be used to set/change\n the labels and other attributes. Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: nvertices number of vertices character(len=*), intent(in), optional, dimension(nvertices) :: labels vertex name strings Calls proc~~dag_set_vertices~~CallsGraph proc~dag_set_vertices dag_module::dag%dag_set_vertices proc~integer_to_string dag_module::integer_to_string proc~dag_set_vertices->proc~integer_to_string Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dag_set_vertices ( me , nvertices , labels ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: nvertices !! number of vertices character ( len =* ), dimension ( nvertices ), intent ( in ), optional :: labels !! vertex name strings integer ( ip ) :: i !! counter if ( nvertices <= 0 ) error stop 'error: nvertices must be >= 1' if ( allocated ( me % vertices )) deallocate ( me % vertices ) me % n = nvertices allocate ( me % vertices ( nvertices )) me % vertices % ivertex = [( i , i = 1 , nvertices )] if ( present ( labels )) then do i = 1 , nvertices me % vertices ( i )% label = trim ( adjustl ( labels ( i ))) end do else ! just use the vertex number do i = 1 , nvertices me % vertices ( i )% label = integer_to_string ( i ) end do end if end subroutine dag_set_vertices","tags":"","loc":"proc/dag_set_vertices.html"},{"title":"dag_set_vertex_info – daglib","text":"private subroutine dag_set_vertex_info(me, ivertex, label, attributes) set info about a vertex in a dag. Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number character(len=*), intent(in), optional :: label if a label is not set,\nthen the integer vertex\nnumber is used. character(len=*), intent(in), optional :: attributes other attributes when\nsaving as a diagraph. Source Code subroutine dag_set_vertex_info ( me , ivertex , label , attributes ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! vertex number character ( len =* ), intent ( in ), optional :: label !! if a label is not set, !! then the integer vertex !! number is used. character ( len =* ), intent ( in ), optional :: attributes !! other attributes when !! saving as a diagraph. if ( present ( label )) me % vertices ( ivertex )% label = label if ( present ( attributes )) me % vertices ( ivertex )% attributes = attributes end subroutine dag_set_vertex_info","tags":"","loc":"proc/dag_set_vertex_info.html"},{"title":"dag_set_edges_no_atts – daglib","text":"private subroutine dag_set_edges_no_atts(me, ivertex, edges) set the edges for a vertex in a dag Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in), dimension(:) :: edges Calls proc~~dag_set_edges_no_atts~~CallsGraph proc~dag_set_edges_no_atts dag_module::dag%dag_set_edges_no_atts none~set_edges dag_module::vertex%set_edges proc~dag_set_edges_no_atts->none~set_edges proc~add_edge dag_module::vertex%add_edge none~set_edges->proc~add_edge proc~set_edge_vector_vector dag_module::vertex%set_edge_vector_vector none~set_edges->proc~set_edge_vector_vector proc~sort_ascending dag_module::sort_ascending proc~add_edge->proc~sort_ascending proc~set_edge_vector_vector->proc~add_edge proc~swap dag_module::swap proc~sort_ascending->proc~swap Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dag_set_edges_no_atts ( me , ivertex , edges ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! vertex number integer ( ip ), dimension (:), intent ( in ) :: edges call me % vertices ( ivertex )% set_edges ( edges ) end subroutine dag_set_edges_no_atts","tags":"","loc":"proc/dag_set_edges_no_atts.html"},{"title":"dag_remove_edge – daglib","text":"private subroutine dag_remove_edge(me, ivertex, iedge) Remove an edge from a dag. Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in) :: iedge the edge to remove Calls proc~~dag_remove_edge~~CallsGraph proc~dag_remove_edge dag_module::dag%dag_remove_edge proc~remove_edge dag_module::vertex%remove_edge proc~dag_remove_edge->proc~remove_edge Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dag_remove_edge ( me , ivertex , iedge ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! vertex number integer ( ip ), intent ( in ) :: iedge !! the edge to remove call me % vertices ( ivertex )% remove_edge ( iedge ) end subroutine dag_remove_edge","tags":"","loc":"proc/dag_remove_edge.html"},{"title":"dag_set_edges_vector_atts – daglib","text":"private subroutine dag_set_edges_vector_atts(me, ivertex, edges, attributes, label) set the edges for a vertex in a dag Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in), dimension(:) :: edges character(len=*), intent(in), dimension(:) :: attributes other attributes when\nsaving as a diagraph. character(len=*), intent(in), optional, dimension(:) :: label Calls proc~~dag_set_edges_vector_atts~~CallsGraph proc~dag_set_edges_vector_atts dag_module::dag%dag_set_edges_vector_atts none~set_edges dag_module::vertex%set_edges proc~dag_set_edges_vector_atts->none~set_edges proc~add_edge dag_module::vertex%add_edge none~set_edges->proc~add_edge proc~set_edge_vector_vector dag_module::vertex%set_edge_vector_vector none~set_edges->proc~set_edge_vector_vector proc~sort_ascending dag_module::sort_ascending proc~add_edge->proc~sort_ascending proc~set_edge_vector_vector->proc~add_edge proc~swap dag_module::swap proc~sort_ascending->proc~swap Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dag_set_edges_vector_atts ( me , ivertex , edges , attributes , label ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! vertex number integer ( ip ), dimension (:), intent ( in ) :: edges character ( len =* ), dimension (:), intent ( in ) :: attributes !! other attributes when !! saving as a diagraph. character ( len =* ), dimension (:), intent ( in ), optional :: label call me % vertices ( ivertex )% set_edges ( edges , label = label , attributes = attributes ) end subroutine dag_set_edges_vector_atts","tags":"","loc":"proc/dag_set_edges_vector_atts.html"},{"title":"init_internal_vars – daglib","text":"private subroutine init_internal_vars(me) Initialize the internal private variables used for graph traversal. Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me Called by proc~~init_internal_vars~~CalledByGraph proc~init_internal_vars dag_module::dag%init_internal_vars proc~dag_toposort dag_module::dag%dag_toposort proc~dag_toposort->proc~init_internal_vars Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine init_internal_vars ( me ) class ( dag ), intent ( inout ) :: me integer ( ip ) :: i !! counter do i = 1 , me % n me % vertices ( i )% marked = . false . me % vertices ( i )% checking = . false . end do end subroutine init_internal_vars","tags":"","loc":"proc/init_internal_vars.html"},{"title":"dag_toposort – daglib","text":"private subroutine dag_toposort(me, order, istat) Main toposort routine Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(out), dimension(:), allocatable :: order the toposort order integer(kind=ip), intent(out) :: istat Status flag: 0 if no errors -1 if circular dependency\n (in this case, order will not be allocated) Calls proc~~dag_toposort~~CallsGraph proc~dag_toposort dag_module::dag%dag_toposort proc~init_internal_vars dag_module::dag%init_internal_vars proc~dag_toposort->proc~init_internal_vars Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dag_toposort ( me , order , istat ) class ( dag ), intent ( inout ) :: me integer ( ip ), dimension (:), allocatable , intent ( out ) :: order !! the toposort order integer ( ip ), intent ( out ) :: istat !! Status flag: !! !! * 0 if no errors !! * -1 if circular dependency !! (in this case, `order` will not be allocated) integer ( ip ) :: i , iorder if ( me % n == 0 ) return ! initialize internal variables, in case ! we have called this routine before. call me % init_internal_vars () allocate ( order ( me % n )) iorder = 0 ! index in order array istat = 0 ! no errors so far do i = 1 , me % n if (. not . me % vertices ( i )% marked ) call dfs ( me % vertices ( i )) if ( istat ==- 1 ) exit end do if ( istat ==- 1 ) deallocate ( order ) contains recursive subroutine dfs ( v ) !! depth-first graph traversal type ( vertex ), intent ( inout ) :: v integer ( ip ) :: j if ( istat ==- 1 ) return if ( v % checking ) then ! error: circular dependency istat = - 1 else if (. not . v % marked ) then v % checking = . true . if ( allocated ( v % edges )) then do j = 1 , size ( v % edges ) call dfs ( me % vertices ( v % edges ( j )% ivertex )) if ( istat ==- 1 ) return end do end if v % checking = . false . v % marked = . true . iorder = iorder + 1 order ( iorder ) = v % ivertex end if end if end subroutine dfs end subroutine dag_toposort","tags":"","loc":"proc/dag_toposort.html"},{"title":"dag_generate_dependency_matrix – daglib","text":"private subroutine dag_generate_dependency_matrix(me, mat) Generate the dependency matrix for the DAG. This is an matrix with elements ,\nsuch that is true if vertex depends on vertex . Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me logical, intent(out), dimension(:,:), allocatable :: mat dependency matrix Source Code subroutine dag_generate_dependency_matrix ( me , mat ) class ( dag ), intent ( in ) :: me logical , dimension (:,:), intent ( out ), allocatable :: mat !! dependency matrix integer ( ip ) :: i !! vertex counter integer ( ip ) :: j !! edge counter if ( me % n > 0 ) then allocate ( mat ( me % n , me % n )) mat = . false . do i = 1 , me % n if ( allocated ( me % vertices ( i )% edges )) then do j = 1 , size ( me % vertices ( i )% edges ) mat ( i , me % vertices ( i )% edges ( j )% ivertex ) = . true . end do end if end do end if end subroutine dag_generate_dependency_matrix","tags":"","loc":"proc/dag_generate_dependency_matrix.html"},{"title":"dag_save_digraph – daglib","text":"private subroutine dag_save_digraph(me, filename, rankdir, dpi) Generate a Graphviz digraph structure for the DAG and write it to a file. Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me character(len=*), intent(in), optional :: filename file name for diagraph character(len=*), intent(in), optional :: rankdir right to left orientation (e.g. 'RL') integer(kind=ip), intent(in), optional :: dpi resolution (e.g. 300) Calls proc~~dag_save_digraph~~CallsGraph proc~dag_save_digraph dag_module::dag%dag_save_digraph proc~dag_generate_digraph dag_module::dag%dag_generate_digraph proc~dag_save_digraph->proc~dag_generate_digraph proc~integer_to_string dag_module::integer_to_string proc~dag_generate_digraph->proc~integer_to_string Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dag_save_digraph ( me , filename , rankdir , dpi ) class ( dag ), intent ( in ) :: me character ( len =* ), intent ( in ), optional :: filename !! file name for diagraph character ( len =* ), intent ( in ), optional :: rankdir !! right to left orientation (e.g. 'RL') integer ( ip ), intent ( in ), optional :: dpi !! resolution (e.g. 300) integer ( ip ) :: iunit , istat character ( len = :), allocatable :: diagraph diagraph = me % generate_digraph ( rankdir , dpi ) open ( newunit = iunit , file = filename , status = 'REPLACE' , iostat = istat ) if ( istat == 0 ) then write ( iunit , fmt = '(A)' , iostat = istat ) diagraph else write ( * , * ) 'error opening ' // trim ( filename ) end if close ( iunit , iostat = istat ) end subroutine dag_save_digraph","tags":"","loc":"proc/dag_save_digraph.html"},{"title":"sort_ascending – daglib","text":"private subroutine sort_ascending(ivec) Sorts an edge array ivec in increasing order by vertex number.\nUses a basic recursive quicksort\n(with insertion sort for partitions with 20 elements). Arguments Type Intent Optional Attributes Name type( edge ), intent(inout), dimension(:) :: ivec Calls proc~~sort_ascending~~CallsGraph proc~sort_ascending dag_module::sort_ascending proc~swap dag_module::swap proc~sort_ascending->proc~swap Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~sort_ascending~~CalledByGraph proc~sort_ascending dag_module::sort_ascending proc~add_edge dag_module::vertex%add_edge proc~add_edge->proc~sort_ascending proc~unique dag_module::unique proc~unique->proc~sort_ascending none~set_edges dag_module::vertex%set_edges none~set_edges->proc~add_edge proc~set_edge_vector_vector dag_module::vertex%set_edge_vector_vector none~set_edges->proc~set_edge_vector_vector proc~set_edge_vector_vector->proc~add_edge proc~dag_set_edges_no_atts dag_module::dag%dag_set_edges_no_atts proc~dag_set_edges_no_atts->none~set_edges proc~dag_set_edges_vector_atts dag_module::dag%dag_set_edges_vector_atts proc~dag_set_edges_vector_atts->none~set_edges Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine sort_ascending ( ivec ) type ( edge ), dimension (:), intent ( inout ) :: ivec integer ( ip ), parameter :: max_size_for_insertion_sort = 20_ip !! max size for using insertion sort. call quicksort ( 1_ip , size ( ivec , kind = ip )) contains recursive subroutine quicksort ( ilow , ihigh ) !! Sort the array integer ( ip ), intent ( in ) :: ilow integer ( ip ), intent ( in ) :: ihigh integer ( ip ) :: ipivot !! pivot element integer ( ip ) :: i !! counter integer ( ip ) :: j !! counter if ( ihigh - ilow <= max_size_for_insertion_sort . and . ihigh > ilow ) then ! do insertion sort: do i = ilow + 1 , ihigh do j = i , ilow + 1 , - 1 if ( ivec ( j )% ivertex < ivec ( j - 1 )% ivertex ) then call swap ( ivec ( j ), ivec ( j - 1 )) else exit end if end do end do elseif ( ihigh - ilow > max_size_for_insertion_sort ) then ! do the normal quicksort: call partition ( ilow , ihigh , ipivot ) call quicksort ( ilow , ipivot - 1_ip ) call quicksort ( ipivot + 1_ip , ihigh ) end if end subroutine quicksort subroutine partition ( ilow , ihigh , ipivot ) !! Partition the array, based on the !! lexical ivecing comparison. integer ( ip ), intent ( in ) :: ilow integer ( ip ), intent ( in ) :: ihigh integer ( ip ), intent ( out ) :: ipivot integer ( ip ) :: i , ii call swap ( ivec ( ilow ), ivec (( ilow + ihigh ) / 2 )) ii = ilow do i = ilow + 1 , ihigh if ( ivec ( i )% ivertex < ivec ( ilow )% ivertex ) then ii = ii + 1 call swap ( ivec ( ii ), ivec ( i )) end if end do call swap ( ivec ( ilow ), ivec ( ii )) ipivot = ii end subroutine partition end subroutine sort_ascending","tags":"","loc":"proc/sort_ascending.html"},{"title":"swap – daglib","text":"private pure elemental subroutine swap(i1, i2) Swap two edge values. Arguments Type Intent Optional Attributes Name type( edge ), intent(inout) :: i1 type( edge ), intent(inout) :: i2 Called by proc~~swap~~CalledByGraph proc~swap dag_module::swap proc~sort_ascending dag_module::sort_ascending proc~sort_ascending->proc~swap proc~add_edge dag_module::vertex%add_edge proc~add_edge->proc~sort_ascending proc~unique dag_module::unique proc~unique->proc~sort_ascending none~set_edges dag_module::vertex%set_edges none~set_edges->proc~add_edge proc~set_edge_vector_vector dag_module::vertex%set_edge_vector_vector none~set_edges->proc~set_edge_vector_vector proc~set_edge_vector_vector->proc~add_edge proc~dag_set_edges_no_atts dag_module::dag%dag_set_edges_no_atts proc~dag_set_edges_no_atts->none~set_edges proc~dag_set_edges_vector_atts dag_module::dag%dag_set_edges_vector_atts proc~dag_set_edges_vector_atts->none~set_edges Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure elemental subroutine swap ( i1 , i2 ) type ( edge ), intent ( inout ) :: i1 type ( edge ), intent ( inout ) :: i2 type ( edge ) :: tmp tmp = i1 i1 = i2 i2 = tmp end subroutine swap","tags":"","loc":"proc/swap.html"},{"title":"edge – daglib","text":"private interface edge constructor for an edge type. Calls interface~~edge~~CallsGraph interface~edge dag_module::edge proc~edge_constructor dag_module::edge_constructor interface~edge->proc~edge_constructor Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Module Procedures private pure elemental function edge_constructor (ivertex, label, attributes) result(e) Constructor for edge type. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in), optional :: ivertex character(len=*), intent(in), optional :: label character(len=*), intent(in), optional :: attributes Return Value type( edge )","tags":"","loc":"interface/edge.html"},{"title":"dag_module – daglib","text":"DAG Module. Uses iso_fortran_env module~~dag_module~~UsesGraph module~dag_module dag_module iso_fortran_env iso_fortran_env module~dag_module->iso_fortran_env Help × Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Variables Type Visibility Attributes Name Initial integer, public, parameter :: daglib_ip = int32 Integer working precision if not specified [4 bytes] integer, private, parameter :: ip = daglib_ip local copy of daglib_ip with a shorter name integer(kind=ip), private, parameter :: MAX_INT_STR_LEN = 64 maximum length of an integer string Interfaces private interface edge constructor for an edge type. private pure elemental function edge_constructor (ivertex, label, attributes) result(e) Constructor for edge type. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in), optional :: ivertex character(len=*), intent(in), optional :: label character(len=*), intent(in), optional :: attributes Return Value type( edge ) Derived Types type, private :: edge the \"to\" vertex that defines an edge. This is part of\nthe array of vertices contained without the \"from\" vertex type.\nan edge can also have optional attrubutes for graphviz. Components Type Visibility Attributes Name Initial integer(kind=ip), public :: ivertex = 0 vertex number (the index in the dag vertices array) character(len=:), public, allocatable :: label used for diagraph character(len=:), public, allocatable :: attributes used for diagraph Constructor constructor for an edge type. private\n\n pure, elemental\n function edge_constructor (ivertex, label, attributes) Constructor for edge type. type, private :: vertex a vertex (or node) of a directed acyclic graph (DAG) Components Type Visibility Attributes Name Initial type( edge ), private, dimension(:), allocatable :: edges these are the vertices that this vertex\ndepends on. (edges of the graph). integer(kind=ip), private :: ivertex = 0 vertex number (the index in the dag vertices array) logical, private :: checking = .false. used for toposort logical, private :: marked = .false. used for toposort character(len=:), private, allocatable :: label used for diagraph character(len=:), private, allocatable :: attributes used for diagraph Type-Bound Procedures generic, private :: set_edges => set_edge_vector_vector , add_edge procedure, private :: add_edge procedure, private :: set_edge_vector_vector procedure, private :: remove_edge type, public :: dag a directed acyclic graph (DAG).\na collection of vertices (nodes) that are connected to other vertices. Components Type Visibility Attributes Name Initial integer(kind=ip), private :: n = 0 number of vertices (size of vertices array) type( vertex ), private, dimension(:), allocatable :: vertices the vertices in the DAG. The index in\nthis array if the vertex number. Type-Bound Procedures procedure, public :: vertex => dag_get_vertex not very useful for now, since\nall vertex attributes are private procedure, public :: number_of_vertices => dag_get_number_of_vertices procedure, public :: set_vertices => dag_set_vertices generic, public :: set_edges => dag_set_edges_no_atts , dag_set_edges_vector_atts procedure, public :: remove_edge => dag_remove_edge procedure, public :: remove_vertex => dag_remove_node procedure, public :: set_vertex_info => dag_set_vertex_info procedure, public :: toposort => dag_toposort procedure, public :: generate_digraph => dag_generate_digraph procedure, public :: generate_dependency_matrix => dag_generate_dependency_matrix procedure, public :: save_digraph => dag_save_digraph procedure, public :: get_edges => dag_get_edges procedure, public :: get_dependencies => dag_get_dependencies procedure, public :: destroy => dag_destroy procedure, private :: init_internal_vars private routine to initialize some internal variables procedure, private :: dag_set_edges_vector_atts procedure, private :: dag_set_edges_no_atts Functions private pure elemental function edge_constructor (ivertex, label, attributes) result(e) Constructor for edge type. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in), optional :: ivertex character(len=*), intent(in), optional :: label character(len=*), intent(in), optional :: attributes Return Value type( edge ) private pure function dag_get_edges (me, ivertex) result(edges) get the edges for the vertex (all of the vertices\nthat this vertex depends on). Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me integer(kind=ip), intent(in) :: ivertex Return Value integer(kind=ip), dimension(:), allocatable private pure function dag_get_dependencies (me, ivertex) result(dep) get all the vertices that depend on this vertex. Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me integer(kind=ip), intent(in) :: ivertex Return Value integer(kind=ip), dimension(:), allocatable the set of all vertices\nthan depend on ivertex private pure function dag_get_number_of_vertices (me) result(nvertices) Returns the number of vertices (nodes) in the dag. Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me Return Value integer(kind=ip) number of vertices private function dag_get_vertex (me, i) result(v) Get the i th vertex. Read more… Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: i vertex number Return Value type( vertex ) private function dag_generate_digraph (me, rankdir, dpi) result(str) Generate a Graphviz digraph structure for the DAG. Read more… Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me character(len=*), intent(in), optional :: rankdir right to left orientation (e.g. 'RL') integer(kind=ip), intent(in), optional :: dpi resolution (e.g. 300) Return Value character(len=:), allocatable private pure function integer_to_string (i) result(s) Integer to allocatable string. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in) :: i Return Value character(len=:), allocatable private function unique (vec) result(vec_unique) Return only the unique values from vec .\nThe result is also sorted by ascending value. Arguments Type Intent Optional Attributes Name type( edge ), intent(in), dimension(:) :: vec Return Value type( edge ), dimension(:), allocatable only the unique elements of vec Subroutines private subroutine dag_destroy (me) Destroy the dag . Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me private subroutine set_edge_vector_vector (me, edges, label, attributes) specify the edge indices for this vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in), dimension(:) :: edges character(len=*), intent(in), optional, dimension(:) :: label character(len=*), intent(in), optional, dimension(:) :: attributes other attributes when\nsaving as a diagraph. private subroutine add_edge (me, e, label, attributes) add an edge index for this vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in) :: e character(len=*), intent(in), optional :: label character(len=*), intent(in), optional :: attributes other attributes when\nsaving as a diagraph. private subroutine remove_edge (me, e) remove an edge index from this vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in) :: e private subroutine dag_remove_node (me, ivertex) Remove a node from a dag. Will also remove any edges connected to it. Read more… Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex the node to remove private subroutine dag_set_vertices (me, nvertices, labels) set the number of vertices (nodes) in the dag. Read more… Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: nvertices number of vertices character(len=*), intent(in), optional, dimension(nvertices) :: labels vertex name strings private subroutine dag_set_vertex_info (me, ivertex, label, attributes) set info about a vertex in a dag. Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number character(len=*), intent(in), optional :: label if a label is not set,\nthen the integer vertex\nnumber is used. character(len=*), intent(in), optional :: attributes other attributes when\nsaving as a diagraph. private subroutine dag_set_edges_no_atts (me, ivertex, edges) set the edges for a vertex in a dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in), dimension(:) :: edges private subroutine dag_remove_edge (me, ivertex, iedge) Remove an edge from a dag. Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in) :: iedge the edge to remove private subroutine dag_set_edges_vector_atts (me, ivertex, edges, attributes, label) set the edges for a vertex in a dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in), dimension(:) :: edges character(len=*), intent(in), dimension(:) :: attributes other attributes when\nsaving as a diagraph. character(len=*), intent(in), optional, dimension(:) :: label private subroutine init_internal_vars (me) Initialize the internal private variables used for graph traversal. Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me private subroutine dag_toposort (me, order, istat) Main toposort routine Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(out), dimension(:), allocatable :: order the toposort order integer(kind=ip), intent(out) :: istat Status flag: Read more… private subroutine dag_generate_dependency_matrix (me, mat) Generate the dependency matrix for the DAG. Read more… Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me logical, intent(out), dimension(:,:), allocatable :: mat dependency matrix private subroutine dag_save_digraph (me, filename, rankdir, dpi) Generate a Graphviz digraph structure for the DAG and write it to a file. Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me character(len=*), intent(in), optional :: filename file name for diagraph character(len=*), intent(in), optional :: rankdir right to left orientation (e.g. 'RL') integer(kind=ip), intent(in), optional :: dpi resolution (e.g. 300) private subroutine sort_ascending (ivec) Sorts an edge array ivec in increasing order by vertex number.\nUses a basic recursive quicksort\n(with insertion sort for partitions with 20 elements). Arguments Type Intent Optional Attributes Name type( edge ), intent(inout), dimension(:) :: ivec private pure elemental subroutine swap (i1, i2) Swap two edge values. Arguments Type Intent Optional Attributes Name type( edge ), intent(inout) :: i1 type( edge ), intent(inout) :: i2","tags":"","loc":"module/dag_module.html"},{"title":"dag_module.F90 – daglib","text":"Source Code !******************************************************************************* !> ! DAG Module. module dag_module use iso_fortran_env implicit none private #ifdef INT8 integer , parameter , public :: daglib_ip = int8 !! Integer working precision [1 byte] #elif INT16 integer , parameter , public :: daglib_ip = int16 !! Integer working precision [2 bytes] #elif INT32 integer , parameter , public :: daglib_ip = int32 !! Integer working precision [4 bytes] #elif INT64 integer , parameter , public :: daglib_ip = int64 !! Integer working precision [8 bytes] #else integer , parameter , public :: daglib_ip = int32 !! Integer working precision if not specified [4 bytes] #endif integer , parameter :: ip = daglib_ip !! local copy of `daglib_ip` with a shorter name integer ( ip ), parameter :: MAX_INT_STR_LEN = 64 !! maximum length of an integer string type :: edge !! the \"to\" vertex that defines an edge. This is part of !! the array of vertices contained without the \"from\" [[vertex]] type. !! an edge can also have optional attrubutes for graphviz. integer ( ip ) :: ivertex = 0 !! vertex number (the index in the [[dag]] `vertices` array) character ( len = :), allocatable :: label !! used for diagraph character ( len = :), allocatable :: attributes !! used for diagraph end type edge interface edge !! constructor for an [[edge]] type. procedure :: edge_constructor end interface edge type :: vertex !! a vertex (or node) of a directed acyclic graph (DAG) private type ( edge ), dimension (:), allocatable :: edges !! these are the vertices that this vertex !! depends on. (edges of the graph). integer ( ip ) :: ivertex = 0 !! vertex number (the index in the [[dag]] `vertices` array) logical :: checking = . false . !! used for toposort logical :: marked = . false . !! used for toposort character ( len = :), allocatable :: label !! used for diagraph character ( len = :), allocatable :: attributes !! used for diagraph contains private generic :: set_edges => set_edge_vector_vector , add_edge procedure :: set_edge_vector_vector , add_edge procedure :: remove_edge end type vertex type , public :: dag !! a directed acyclic graph (DAG). !! a collection of vertices (nodes) that are connected to other vertices. private integer ( ip ) :: n = 0 !! number of vertices (size of `vertices` array) type ( vertex ), dimension (:), allocatable :: vertices !! the vertices in the DAG. The index in !! this array if the vertex number. contains private procedure , public :: vertex => dag_get_vertex !! not very useful for now, since !! all vertex attributes are private procedure , public :: number_of_vertices => dag_get_number_of_vertices procedure , public :: set_vertices => dag_set_vertices generic , public :: set_edges => dag_set_edges_no_atts , & dag_set_edges_vector_atts procedure , public :: remove_edge => dag_remove_edge procedure , public :: remove_vertex => dag_remove_node procedure , public :: set_vertex_info => dag_set_vertex_info procedure , public :: toposort => dag_toposort procedure , public :: generate_digraph => dag_generate_digraph procedure , public :: generate_dependency_matrix => dag_generate_dependency_matrix procedure , public :: save_digraph => dag_save_digraph procedure , public :: get_edges => dag_get_edges procedure , public :: get_dependencies => dag_get_dependencies procedure , public :: destroy => dag_destroy procedure :: init_internal_vars !! private routine to initialize some internal variables procedure :: dag_set_edges_no_atts , dag_set_edges_vector_atts end type dag contains !******************************************************************************* !******************************************************************************* !> ! Constructor for [[edge]] type. pure elemental function edge_constructor ( ivertex , label , attributes ) result ( e ) integer ( ip ), intent ( in ), optional :: ivertex character ( len =* ), intent ( in ), optional :: label character ( len =* ), intent ( in ), optional :: attributes type ( edge ) :: e e % ivertex = ivertex if ( present ( label )) e % label = label if ( present ( attributes )) e % attributes = attributes end function edge_constructor !******************************************************************************* !******************************************************************************* !> ! Destroy the `dag`. subroutine dag_destroy ( me ) class ( dag ), intent ( inout ) :: me me % n = 0 if ( allocated ( me % vertices )) deallocate ( me % vertices ) end subroutine dag_destroy !******************************************************************************* !******************************************************************************* !> ! specify the edge indices for this vertex subroutine set_edge_vector_vector ( me , edges , label , attributes ) class ( vertex ), intent ( inout ) :: me integer ( ip ), dimension (:), intent ( in ) :: edges character ( len =* ), dimension (:), intent ( in ), optional :: label character ( len =* ), dimension (:), intent ( in ), optional :: attributes !! other attributes when !! saving as a diagraph. integer ( ip ) :: i !! counter do i = 1 , size ( edges ) if ( present ( label ) . and . present ( attributes )) then call me % add_edge ( edges ( i ), label = label ( i ), attributes = attributes ( i )) else if (. not . present ( label ) . and . present ( attributes )) then call me % add_edge ( edges ( i ), attributes = attributes ( i )) else if ( present ( label ) . and . . not . present ( attributes )) then call me % add_edge ( edges ( i ), label = label ( i )) else call me % add_edge ( edges ( i )) end if end do end subroutine set_edge_vector_vector !******************************************************************************* !******************************************************************************* !> ! add an edge index for this vertex subroutine add_edge ( me , e , label , attributes ) class ( vertex ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: e character ( len =* ), intent ( in ), optional :: label character ( len =* ), intent ( in ), optional :: attributes !! other attributes when !! saving as a diagraph. if ( allocated ( me % edges )) then if (. not . any ( e == me % edges % ivertex )) then ! don't add if already there me % edges = [ me % edges , edge ( e , label = label , attributes = attributes )] call sort_ascending ( me % edges ) end if else me % edges = [ edge ( e , label = label , attributes = attributes )] end if end subroutine add_edge !******************************************************************************* !******************************************************************************* !> ! remove an edge index from this vertex subroutine remove_edge ( me , e ) class ( vertex ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: e integer ( ip ), dimension ( 1 ) :: idx type ( edge ), dimension (:), allocatable :: tmp if ( allocated ( me % edges )) then idx = findloc ( me % edges % ivertex , e ) if ( idx ( 1 ) > 0 ) then ! the edge is in the list associate ( i => idx ( 1 ), n => size ( me % edges )) if ( n == 1 ) then deallocate ( me % edges ) ! it's the only one there else allocate ( tmp ( n - 1 )) if ( i > 1 ) tmp ( 1 : i - 1 ) = me % edges ( 1 : i - 1 ) if ( i < n ) tmp ( i : n - 1 ) = me % edges ( i + 1 : n ) call move_alloc ( tmp , me % edges ) end if end associate end if end if end subroutine remove_edge !******************************************************************************* !******************************************************************************* !> ! Remove a node from a dag. Will also remove any edges connected to it. ! ! This will renumber the nodes and edges internally. ! Note that any default integer labels generated in ! [[dag_set_vertices]] would then be questionable. subroutine dag_remove_node ( me , ivertex ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! the node to remove integer ( ip ) :: i !! counter type ( vertex ), dimension (:), allocatable :: tmp !! for resizing `me%vertices` if ( allocated ( me % vertices )) then associate ( n => size ( me % vertices )) do i = 1 , n ! first remove any edges: call me % vertices ( i )% remove_edge ( ivertex ) ! next, renumber the existing edges so they will be ! correct after ivertex is deleted ! Example (removing 2): 1 [2] 3 4 ==> 1 2 3 if ( allocated ( me % vertices ( i )% edges )) then where ( me % vertices ( i )% edges % ivertex > ivertex ) me % vertices ( i )% edges % ivertex = me % vertices ( i )% edges % ivertex - 1 end where end if end do ! now, remove the node: allocate ( tmp ( n - 1 )) if ( ivertex > 1 ) tmp ( 1 : ivertex - 1 ) = me % vertices ( 1 : ivertex - 1 ) if ( ivertex < n ) tmp ( ivertex : n - 1 ) = me % vertices ( ivertex + 1 : n ) call move_alloc ( tmp , me % vertices ) end associate end if me % n = size ( me % vertices ) if ( me % n == 0 ) deallocate ( me % vertices ) end subroutine dag_remove_node !******************************************************************************* !******************************************************************************* !> ! get the edges for the vertex (all of the vertices ! that this vertex depends on). pure function dag_get_edges ( me , ivertex ) result ( edges ) class ( dag ), intent ( in ) :: me integer ( ip ), intent ( in ) :: ivertex integer ( ip ), dimension (:), allocatable :: edges if ( ivertex > 0 . and . ivertex <= me % n ) then edges = me % vertices ( ivertex )% edges % ivertex ! auto LHS allocation end if end function dag_get_edges !******************************************************************************* !******************************************************************************* !> ! get all the vertices that depend on this vertex. pure function dag_get_dependencies ( me , ivertex ) result ( dep ) class ( dag ), intent ( in ) :: me integer ( ip ), intent ( in ) :: ivertex integer ( ip ), dimension (:), allocatable :: dep !! the set of all vertices !! than depend on `ivertex` integer ( ip ) :: i !! vertex counter if ( ivertex > 0 . and . ivertex <= me % n ) then ! have to check all the vertices: do i = 1 , me % n if ( allocated ( me % vertices ( i )% edges )) then if ( any ( me % vertices ( i )% edges % ivertex == ivertex )) then if ( allocated ( dep )) then dep = [ dep , i ] ! auto LHS allocation else dep = [ i ] ! auto LHS allocation end if end if end if end do end if end function dag_get_dependencies !******************************************************************************* !******************************************************************************* !> ! set the number of vertices (nodes) in the dag. ! !### See also ! * [[dag_remove_node]] which can be used to remove a vertex. ! * [[dag_set_vertex_info]] which can be used to set/change ! the labels and other attributes. subroutine dag_set_vertices ( me , nvertices , labels ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: nvertices !! number of vertices character ( len =* ), dimension ( nvertices ), intent ( in ), optional :: labels !! vertex name strings integer ( ip ) :: i !! counter if ( nvertices <= 0 ) error stop 'error: nvertices must be >= 1' if ( allocated ( me % vertices )) deallocate ( me % vertices ) me % n = nvertices allocate ( me % vertices ( nvertices )) me % vertices % ivertex = [( i , i = 1 , nvertices )] if ( present ( labels )) then do i = 1 , nvertices me % vertices ( i )% label = trim ( adjustl ( labels ( i ))) end do else ! just use the vertex number do i = 1 , nvertices me % vertices ( i )% label = integer_to_string ( i ) end do end if end subroutine dag_set_vertices !******************************************************************************* !******************************************************************************* !> ! Returns the number of vertices (nodes) in the dag. pure function dag_get_number_of_vertices ( me ) result ( nvertices ) class ( dag ), intent ( in ) :: me integer ( ip ) :: nvertices !! number of vertices nvertices = me % n end function dag_get_number_of_vertices !******************************************************************************* !******************************************************************************* !> ! set info about a vertex in a dag. subroutine dag_set_vertex_info ( me , ivertex , label , attributes ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! vertex number character ( len =* ), intent ( in ), optional :: label !! if a label is not set, !! then the integer vertex !! number is used. character ( len =* ), intent ( in ), optional :: attributes !! other attributes when !! saving as a diagraph. if ( present ( label )) me % vertices ( ivertex )% label = label if ( present ( attributes )) me % vertices ( ivertex )% attributes = attributes end subroutine dag_set_vertex_info !******************************************************************************* !******************************************************************************* !> ! Get the `i`th vertex. ! ! The program will stop if vertex `i` does not exist. function dag_get_vertex ( me , i ) result ( v ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: i !! vertex number type ( vertex ) :: v if ( i < 0 . or . i > me % n ) then error stop 'Error in dag_get_vertex: invalid vertex number' else v = me % vertices ( i ) end if end function dag_get_vertex !******************************************************************************* !******************************************************************************* !> ! set the edges for a vertex in a dag subroutine dag_set_edges_no_atts ( me , ivertex , edges ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! vertex number integer ( ip ), dimension (:), intent ( in ) :: edges call me % vertices ( ivertex )% set_edges ( edges ) end subroutine dag_set_edges_no_atts !******************************************************************************* !******************************************************************************* !> ! Remove an edge from a dag. subroutine dag_remove_edge ( me , ivertex , iedge ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! vertex number integer ( ip ), intent ( in ) :: iedge !! the edge to remove call me % vertices ( ivertex )% remove_edge ( iedge ) end subroutine dag_remove_edge !******************************************************************************* !******************************************************************************* !> ! set the edges for a vertex in a dag subroutine dag_set_edges_vector_atts ( me , ivertex , edges , attributes , label ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! vertex number integer ( ip ), dimension (:), intent ( in ) :: edges character ( len =* ), dimension (:), intent ( in ) :: attributes !! other attributes when !! saving as a diagraph. character ( len =* ), dimension (:), intent ( in ), optional :: label call me % vertices ( ivertex )% set_edges ( edges , label = label , attributes = attributes ) end subroutine dag_set_edges_vector_atts !******************************************************************************* !******************************************************************************* !> ! Initialize the internal private variables used for graph traversal. subroutine init_internal_vars ( me ) class ( dag ), intent ( inout ) :: me integer ( ip ) :: i !! counter do i = 1 , me % n me % vertices ( i )% marked = . false . me % vertices ( i )% checking = . false . end do end subroutine init_internal_vars !******************************************************************************* !******************************************************************************* !> ! Main toposort routine subroutine dag_toposort ( me , order , istat ) class ( dag ), intent ( inout ) :: me integer ( ip ), dimension (:), allocatable , intent ( out ) :: order !! the toposort order integer ( ip ), intent ( out ) :: istat !! Status flag: !! !! * 0 if no errors !! * -1 if circular dependency !! (in this case, `order` will not be allocated) integer ( ip ) :: i , iorder if ( me % n == 0 ) return ! initialize internal variables, in case ! we have called this routine before. call me % init_internal_vars () allocate ( order ( me % n )) iorder = 0 ! index in order array istat = 0 ! no errors so far do i = 1 , me % n if (. not . me % vertices ( i )% marked ) call dfs ( me % vertices ( i )) if ( istat ==- 1 ) exit end do if ( istat ==- 1 ) deallocate ( order ) contains recursive subroutine dfs ( v ) !! depth-first graph traversal type ( vertex ), intent ( inout ) :: v integer ( ip ) :: j if ( istat ==- 1 ) return if ( v % checking ) then ! error: circular dependency istat = - 1 else if (. not . v % marked ) then v % checking = . true . if ( allocated ( v % edges )) then do j = 1 , size ( v % edges ) call dfs ( me % vertices ( v % edges ( j )% ivertex )) if ( istat ==- 1 ) return end do end if v % checking = . false . v % marked = . true . iorder = iorder + 1 order ( iorder ) = v % ivertex end if end if end subroutine dfs end subroutine dag_toposort !******************************************************************************* !******************************************************************************* !> ! Generate a Graphviz digraph structure for the DAG. ! !### Example ! * To convert this to a PDF using `dot`: `dot -Tpdf -o test.pdf test.dot`, ! where `test.dot` is `str` written to a file. function dag_generate_digraph ( me , rankdir , dpi ) result ( str ) class ( dag ), intent ( in ) :: me character ( len = :), allocatable :: str character ( len =* ), intent ( in ), optional :: rankdir !! right to left orientation (e.g. 'RL') integer ( ip ), intent ( in ), optional :: dpi !! resolution (e.g. 300) integer ( ip ) :: i , j !! counter integer ( ip ) :: n_edges !! number of edges character ( len = :), allocatable :: attributes !! full attributes string for node or edge logical :: compress !! if we can write all the edges on one line character ( len =* ), parameter :: tab = ' ' !! for indenting character ( len =* ), parameter :: newline = new_line ( ' ' ) !! line break character if ( me % n == 0 ) return str = 'digraph G {' // newline // newline if ( present ( rankdir )) & str = str // tab // 'rankdir=' // rankdir // newline // newline if ( present ( dpi )) & str = str // tab // 'graph [ dpi = ' // integer_to_string ( dpi ) // ' ]' // newline // newline ! define the vertices: do i = 1 , me % n attributes = get_attributes_string ( me % vertices ( i )% label , & me % vertices ( i )% attributes ) str = str // tab // integer_to_string ( i ) // ' ' // attributes // newline if ( i == me % n ) str = str // newline end do ! define the dependencies: do i = 1 , me % n if ( allocated ( me % vertices ( i )% edges )) then n_edges = size ( me % vertices ( i )% edges ) ! if none of the edges have attributes, ! then we can write them all on one line ! otherwise, write them line by line compress = . true . do j = 1 , n_edges if ( allocated ( me % vertices ( i )% edges ( j )% label ) . or . & allocated ( me % vertices ( i )% edges ( j )% attributes )) then compress = . false . exit end if end do if (. not . compress ) then ! Example: 1 -> 2 [penwidth=2, arrowhead=none] do j = 1 , n_edges attributes = get_attributes_string ( me % vertices ( i )% edges ( j )% label , & me % vertices ( i )% edges ( j )% attributes ) str = str // tab // integer_to_string ( i ) // ' -> ' // & integer_to_string ( me % vertices ( i )% edges ( j )% ivertex ) // ' ' // attributes // newline end do else ! Example: 1 -> 2,5,10 str = str // tab // integer_to_string ( i ) // merge ( ' -> ' , ' ' , n_edges /= 0 ) do j = 1 , n_edges ! comma-separated list: str = str // integer_to_string ( me % vertices ( i )% edges ( j )% ivertex ) if ( n_edges > 1 . and . j < n_edges ) str = str // ',' end do str = str // ';' // newline end if end if end do str = str // newline // '}' contains function get_attributes_string ( label , attributes ) result ( str ) !! create the full attributes string for an edge or node. character ( len = :), allocatable , intent ( in ) :: label !! if not allocated or blank, then not used character ( len = :), allocatable , intent ( in ) :: attributes !! if not allocated or blank, then not used character ( len = :), allocatable :: str !! the attributes string, enclosed in brackets character ( len = :), allocatable :: tmp_label logical :: has_label , has_attributes has_label = allocated ( label ) if ( has_label ) has_label = label /= '' if ( has_label ) tmp_label = 'label=\"' // trim ( adjustl ( label )) // '\"' has_attributes = allocated ( attributes ) if ( has_attributes ) has_attributes = attributes /= '' if ( has_label . and . has_attributes ) then str = '[' // trim ( adjustl ( attributes )) // ',' // tmp_label // ']' elseif ( has_label . and . . not . has_attributes ) then str = '[' // tmp_label // ']' elseif (. not . has_label . and . has_attributes ) then str = '[' // trim ( adjustl ( attributes )) // ']' else ! neither str = '' end if end function get_attributes_string end function dag_generate_digraph !******************************************************************************* !******************************************************************************* !> ! Generate the dependency matrix for the DAG. ! ! This is an n \\times n matrix with elements A_{ij}, ! such that A_{ij} is true if vertex i depends on vertex j. subroutine dag_generate_dependency_matrix ( me , mat ) class ( dag ), intent ( in ) :: me logical , dimension (:,:), intent ( out ), allocatable :: mat !! dependency matrix integer ( ip ) :: i !! vertex counter integer ( ip ) :: j !! edge counter if ( me % n > 0 ) then allocate ( mat ( me % n , me % n )) mat = . false . do i = 1 , me % n if ( allocated ( me % vertices ( i )% edges )) then do j = 1 , size ( me % vertices ( i )% edges ) mat ( i , me % vertices ( i )% edges ( j )% ivertex ) = . true . end do end if end do end if end subroutine dag_generate_dependency_matrix !******************************************************************************* !******************************************************************************* !> ! Generate a Graphviz digraph structure for the DAG and write it to a file. subroutine dag_save_digraph ( me , filename , rankdir , dpi ) class ( dag ), intent ( in ) :: me character ( len =* ), intent ( in ), optional :: filename !! file name for diagraph character ( len =* ), intent ( in ), optional :: rankdir !! right to left orientation (e.g. 'RL') integer ( ip ), intent ( in ), optional :: dpi !! resolution (e.g. 300) integer ( ip ) :: iunit , istat character ( len = :), allocatable :: diagraph diagraph = me % generate_digraph ( rankdir , dpi ) open ( newunit = iunit , file = filename , status = 'REPLACE' , iostat = istat ) if ( istat == 0 ) then write ( iunit , fmt = '(A)' , iostat = istat ) diagraph else write ( * , * ) 'error opening ' // trim ( filename ) end if close ( iunit , iostat = istat ) end subroutine dag_save_digraph !******************************************************************************* !******************************************************************************* !> ! Integer to allocatable string. pure function integer_to_string ( i ) result ( s ) integer ( ip ), intent ( in ) :: i character ( len = :), allocatable :: s integer ( ip ) :: istat allocate ( character ( len = MAX_INT_STR_LEN ) :: s ) ! should be big enough write ( s , fmt = '(ss,I0)' , iostat = istat ) i if ( istat == 0 ) then s = trim ( adjustl ( s )) else s = '***' end if end function integer_to_string !******************************************************************************* !******************************************************************************* !> ! Return only the unique values from `vec`. ! The result is also sorted by ascending value. function unique ( vec ) result ( vec_unique ) type ( edge ), dimension (:), intent ( in ) :: vec type ( edge ), dimension (:), allocatable :: vec_unique !! only the unique elements of `vec` integer ( ip ) :: i !! counter integer ( ip ) :: n !! size of `vec` logical , dimension (:), allocatable :: mask !! for flagging the unique values n = size ( vec ) vec_unique = vec ! make a copy if ( n <= 1 ) return ! get the unique elements by sorting the array ! and then excluding any that are the same as the previous element. call sort_ascending ( vec_unique ) allocate ( mask ( n )); mask ( 1 ) = . true . do i = 2 , n mask ( i ) = ( vec_unique ( i )% ivertex /= vec_unique ( i - 1 )% ivertex ) end do vec_unique = pack ( vec_unique , mask ) end function unique !******************************************************************************* !******************************************************************************* !> ! Sorts an [[edge]] array `ivec` in increasing order by vertex number. ! Uses a basic recursive quicksort ! (with insertion sort for partitions with \\le 20 elements). subroutine sort_ascending ( ivec ) type ( edge ), dimension (:), intent ( inout ) :: ivec integer ( ip ), parameter :: max_size_for_insertion_sort = 20_ip !! max size for using insertion sort. call quicksort ( 1_ip , size ( ivec , kind = ip )) contains recursive subroutine quicksort ( ilow , ihigh ) !! Sort the array integer ( ip ), intent ( in ) :: ilow integer ( ip ), intent ( in ) :: ihigh integer ( ip ) :: ipivot !! pivot element integer ( ip ) :: i !! counter integer ( ip ) :: j !! counter if ( ihigh - ilow <= max_size_for_insertion_sort . and . ihigh > ilow ) then ! do insertion sort: do i = ilow + 1 , ihigh do j = i , ilow + 1 , - 1 if ( ivec ( j )% ivertex < ivec ( j - 1 )% ivertex ) then call swap ( ivec ( j ), ivec ( j - 1 )) else exit end if end do end do elseif ( ihigh - ilow > max_size_for_insertion_sort ) then ! do the normal quicksort: call partition ( ilow , ihigh , ipivot ) call quicksort ( ilow , ipivot - 1_ip ) call quicksort ( ipivot + 1_ip , ihigh ) end if end subroutine quicksort subroutine partition ( ilow , ihigh , ipivot ) !! Partition the array, based on the !! lexical ivecing comparison. integer ( ip ), intent ( in ) :: ilow integer ( ip ), intent ( in ) :: ihigh integer ( ip ), intent ( out ) :: ipivot integer ( ip ) :: i , ii call swap ( ivec ( ilow ), ivec (( ilow + ihigh ) / 2 )) ii = ilow do i = ilow + 1 , ihigh if ( ivec ( i )% ivertex < ivec ( ilow )% ivertex ) then ii = ii + 1 call swap ( ivec ( ii ), ivec ( i )) end if end do call swap ( ivec ( ilow ), ivec ( ii )) ipivot = ii end subroutine partition end subroutine sort_ascending !******************************************************************************* !******************************************************************************* !> ! Swap two [[edge]] values. pure elemental subroutine swap ( i1 , i2 ) type ( edge ), intent ( inout ) :: i1 type ( edge ), intent ( inout ) :: i2 type ( edge ) :: tmp tmp = i1 i1 = i2 i2 = tmp end subroutine swap !******************************************************************************* !******************************************************************************* end module dag_module !*******************************************************************************","tags":"","loc":"sourcefile/dag_module.f90.html"}]} \ No newline at end of file +var tipuesearch = {"pages":[{"title":" daglib ","text":"daglib Overview DAGLIB is a modern Fortran module for creating and manipulating directed acyclic graphs (DAGs). It includes a toposort feature, and also the ability to generate files in the GraphViz \"dot\" notation. Building A Fortran Package Manager manifest file is included, so that the library and tests cases can be compiled with FPM. For example: fpm build --profile release\nfpm test --profile release By default, the library is built with single precision ( int32 ) integer values. Explicitly specifying the integer kind can be done using the following processor flag: Preprocessor flag Kind Number of bytes INT8 integer(kind=int8) 1 INT16 integer(kind=int16) 2 INT32 integer(kind=int32) 4 INT64 integer(kind=int64) 8 For example, to build a long integer version of the library: fpm build --profile release --flag \"-DINT64\" Example A simple example is shown below: program dag_example use dag_module implicit none type ( dag ) :: d integer , dimension (:), allocatable :: order integer :: istat integer :: i integer , parameter :: n_nodes = 6 character ( len =* ), parameter :: filetype = 'pdf' ! create a dag: call d % set_vertices ( n_nodes ) call d % set_edges ( 2 ,[ 1 ]) ! 2 depends on 1 call d % set_edges ( 3 ,[ 5 , 1 ]) ! 3 depends on 5 and 1 call d % set_edges ( 4 ,[ 5 ]) ! 4 depends on 5 call d % set_edges ( 5 ,[ 2 ]) ! 5 depends on 2 call d % set_edges ( 6 ,[ 2 , 4 ]) ! 6 depends on 2 and 4 ! toposort: call d % toposort ( order , istat ) ! define some styles for the GraphViz output: do i = 1 , n_nodes if ( i == 3 . or . i == 6 ) then call d % set_vertex_info ( i , attributes = 'shape=square,fillcolor=\"SlateGray1\",style=filled' ) else call d % set_vertex_info ( i , attributes = 'shape=circle,fillcolor=\"cornsilk\",style=filled' ) end if end do ! generate the GraphViz output: call d % save_digraph ( 'test.dot' , 'RL' , 300 ) call d % destroy () call execute_command_line ( 'dot -Tpdf -o test.pdf test.dot' ) end program dag_example This program produces the toposort order: order = [1, 2, 5, 3, 4, 6] and the image file: Documentation The API documentation for the current master branch can be found here . This is generated by processing the source files with FORD . License This library is released under a BSD-3 license . See also dag (a fork of this project) Developer Info Jacob Williams","tags":"home","loc":"index.html"},{"title":"edge – daglib ","text":"type, private :: edge the \"to\" vertex that defines an edge. This is part of\nthe array of vertices contained without the \"from\" vertex type.\nan edge can also have optional attrubutes for graphviz. Inherited by type~~edge~~InheritedByGraph type~edge edge type~vertex vertex type~vertex->type~edge edges type~dag dag type~dag->type~vertex vertices Help × Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial integer(kind=ip), public :: ivertex = 0 vertex number (the index in the dag vertices array) character(len=:), public, allocatable :: label used for diagraph character(len=:), public, allocatable :: attributes used for diagraph Constructor private interface edge constructor for an edge type. private pure elemental function edge_constructor (ivertex, label, attributes) result(e) Constructor for edge type. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in), optional :: ivertex character(len=*), intent(in), optional :: label character(len=*), intent(in), optional :: attributes Return Value type( edge ) Source Code type :: edge !! the \"to\" vertex that defines an edge. This is part of !! the array of vertices contained without the \"from\" [[vertex]] type. !! an edge can also have optional attrubutes for graphviz. integer ( ip ) :: ivertex = 0 !! vertex number (the index in the [[dag]] `vertices` array) character ( len = :), allocatable :: label !! used for diagraph character ( len = :), allocatable :: attributes !! used for diagraph end type edge","tags":"","loc":"type/edge.html"},{"title":"vertex – daglib ","text":"type, private :: vertex a vertex (or node) of a directed acyclic graph (DAG) Inherits type~~vertex~~InheritsGraph type~vertex vertex type~edge edge type~vertex->type~edge edges Help × Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Inherited by type~~vertex~~InheritedByGraph type~vertex vertex type~dag dag type~dag->type~vertex vertices Help × Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial type( edge ), private, dimension(:), allocatable :: edges these are the vertices that this vertex\ndepends on. (edges of the graph). integer(kind=ip), private :: ivertex = 0 vertex number (the index in the dag vertices array) logical, private :: checking = .false. used for toposort logical, private :: marked = .false. used for toposort character(len=:), private, allocatable :: label used for diagraph character(len=:), private, allocatable :: attributes used for diagraph Type-Bound Procedures generic, private :: set_edges => set_edge_vector_vector , add_edge private subroutine set_edge_vector_vector (me, edges, label, attributes) specify the edge indices for this vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in), dimension(:) :: edges character(len=*), intent(in), optional, dimension(:) :: label character(len=*), intent(in), optional, dimension(:) :: attributes other attributes when\nsaving as a diagraph. private subroutine add_edge (me, e, label, attributes) add an edge index for this vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in) :: e character(len=*), intent(in), optional :: label character(len=*), intent(in), optional :: attributes other attributes when\nsaving as a diagraph. procedure, private :: add_edge private subroutine add_edge (me, e, label, attributes) add an edge index for this vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in) :: e character(len=*), intent(in), optional :: label character(len=*), intent(in), optional :: attributes other attributes when\nsaving as a diagraph. procedure, private :: set_edge_vector_vector private subroutine set_edge_vector_vector (me, edges, label, attributes) specify the edge indices for this vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in), dimension(:) :: edges character(len=*), intent(in), optional, dimension(:) :: label character(len=*), intent(in), optional, dimension(:) :: attributes other attributes when\nsaving as a diagraph. procedure, private :: remove_edge private subroutine remove_edge (me, e) remove an edge index from this vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in) :: e Source Code type :: vertex !! a vertex (or node) of a directed acyclic graph (DAG) private type ( edge ), dimension (:), allocatable :: edges !! these are the vertices that this vertex !! depends on. (edges of the graph). integer ( ip ) :: ivertex = 0 !! vertex number (the index in the [[dag]] `vertices` array) logical :: checking = . false . !! used for toposort logical :: marked = . false . !! used for toposort character ( len = :), allocatable :: label !! used for diagraph character ( len = :), allocatable :: attributes !! used for diagraph contains private generic :: set_edges => set_edge_vector_vector , add_edge procedure :: set_edge_vector_vector , add_edge procedure :: remove_edge end type vertex","tags":"","loc":"type/vertex.html"},{"title":"dag – daglib ","text":"type, public :: dag a directed acyclic graph (DAG).\na collection of vertices (nodes) that are connected to other vertices. Inherits type~~dag~~InheritsGraph type~dag dag type~vertex vertex type~dag->type~vertex vertices type~edge edge type~vertex->type~edge edges Help × Graph Key Nodes of different colours represent the following: Graph Key Type Type This Page's Entity This Page's Entity Solid arrows point from a derived type to the parent type which it\nextends. Dashed arrows point from a derived type to the other\ntypes it contains as a components, with a label listing the name(s) of\nsaid component(s). Components Type Visibility Attributes Name Initial integer(kind=ip), private :: n = 0 number of vertices (size of vertices array) type( vertex ), private, dimension(:), allocatable :: vertices the vertices in the DAG. The index in\nthis array if the vertex number. Type-Bound Procedures procedure, public :: vertex => dag_get_vertex not very useful for now, since\nall vertex attributes are private private function dag_get_vertex (me, i) result(v) Get the i th vertex. Read more… Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: i vertex number Return Value type( vertex ) procedure, public :: number_of_vertices => dag_get_number_of_vertices private pure function dag_get_number_of_vertices (me) result(nvertices) Returns the number of vertices (nodes) in the dag. Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me Return Value integer(kind=ip) number of vertices procedure, public :: set_vertices => dag_set_vertices private subroutine dag_set_vertices (me, nvertices, labels) set the number of vertices (nodes) in the dag. Read more… Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: nvertices number of vertices character(len=*), intent(in), optional, dimension(nvertices) :: labels vertex name strings generic, public :: set_edges => dag_set_edges_no_atts , dag_set_edges_vector_atts private subroutine dag_set_edges_no_atts (me, ivertex, edges) set the edges for a vertex in a dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in), dimension(:) :: edges private subroutine dag_set_edges_vector_atts (me, ivertex, edges, attributes, label) set the edges for a vertex in a dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in), dimension(:) :: edges character(len=*), intent(in), dimension(:) :: attributes other attributes when\nsaving as a diagraph. character(len=*), intent(in), optional, dimension(:) :: label procedure, public :: add_edge => dag_add_edge private subroutine dag_add_edge (me, ivertex, iedge, label, attributes) Add an edge to a dag. Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in) :: iedge the vertex to connect to ivertex character(len=*), intent(in), optional :: label edge label character(len=*), intent(in), optional :: attributes other attributes when\nsaving as a diagraph. procedure, public :: remove_edge => dag_remove_edge private subroutine dag_remove_edge (me, ivertex, iedge) Remove an edge from a dag. Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in) :: iedge the edge to remove procedure, public :: remove_vertex => dag_remove_node private subroutine dag_remove_node (me, ivertex) Remove a node from a dag. Will also remove any edges connected to it. Read more… Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex the node to remove procedure, public :: set_vertex_info => dag_set_vertex_info private subroutine dag_set_vertex_info (me, ivertex, label, attributes) set info about a vertex in a dag. Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number character(len=*), intent(in), optional :: label if a label is not set,\nthen the integer vertex\nnumber is used. character(len=*), intent(in), optional :: attributes other attributes when\nsaving as a diagraph. procedure, public :: toposort => dag_toposort private subroutine dag_toposort (me, order, istat) Main toposort routine Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(out), dimension(:), allocatable :: order the toposort order integer(kind=ip), intent(out) :: istat Status flag: Read more… procedure, public :: generate_digraph => dag_generate_digraph private function dag_generate_digraph (me, rankdir, dpi) result(str) Generate a Graphviz digraph structure for the DAG. Read more… Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me character(len=*), intent(in), optional :: rankdir right to left orientation (e.g. 'RL') integer(kind=ip), intent(in), optional :: dpi resolution (e.g. 300) Return Value character(len=:), allocatable procedure, public :: generate_dependency_matrix => dag_generate_dependency_matrix private subroutine dag_generate_dependency_matrix (me, mat) Generate the dependency matrix for the DAG. Read more… Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me logical, intent(out), dimension(:,:), allocatable :: mat dependency matrix procedure, public :: save_digraph => dag_save_digraph private subroutine dag_save_digraph (me, filename, rankdir, dpi) Generate a Graphviz digraph structure for the DAG and write it to a file. Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me character(len=*), intent(in), optional :: filename file name for diagraph character(len=*), intent(in), optional :: rankdir right to left orientation (e.g. 'RL') integer(kind=ip), intent(in), optional :: dpi resolution (e.g. 300) procedure, public :: get_edges => dag_get_edges private pure function dag_get_edges (me, ivertex) result(edges) get the edges for the vertex (all of the vertices\nthat this vertex depends on). Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me integer(kind=ip), intent(in) :: ivertex Return Value integer(kind=ip), dimension(:), allocatable procedure, public :: get_dependencies => dag_get_dependencies private pure function dag_get_dependencies (me, ivertex) result(dep) get all the vertices that depend on this vertex. Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me integer(kind=ip), intent(in) :: ivertex Return Value integer(kind=ip), dimension(:), allocatable the set of all vertices\nthan depend on ivertex procedure, public :: destroy => dag_destroy private subroutine dag_destroy (me) Destroy the dag . Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me procedure, private :: init_internal_vars private routine to initialize some internal variables private subroutine init_internal_vars (me) Initialize the internal private variables used for graph traversal. Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me procedure, private :: dag_set_edges_vector_atts private subroutine dag_set_edges_vector_atts (me, ivertex, edges, attributes, label) set the edges for a vertex in a dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in), dimension(:) :: edges character(len=*), intent(in), dimension(:) :: attributes other attributes when\nsaving as a diagraph. character(len=*), intent(in), optional, dimension(:) :: label procedure, private :: dag_set_edges_no_atts private subroutine dag_set_edges_no_atts (me, ivertex, edges) set the edges for a vertex in a dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in), dimension(:) :: edges Source Code type , public :: dag !! a directed acyclic graph (DAG). !! a collection of vertices (nodes) that are connected to other vertices. private integer ( ip ) :: n = 0 !! number of vertices (size of `vertices` array) type ( vertex ), dimension (:), allocatable :: vertices !! the vertices in the DAG. The index in !! this array if the vertex number. contains private procedure , public :: vertex => dag_get_vertex !! not very useful for now, since !! all vertex attributes are private procedure , public :: number_of_vertices => dag_get_number_of_vertices procedure , public :: set_vertices => dag_set_vertices generic , public :: set_edges => dag_set_edges_no_atts , & dag_set_edges_vector_atts procedure , public :: add_edge => dag_add_edge procedure , public :: remove_edge => dag_remove_edge procedure , public :: remove_vertex => dag_remove_node procedure , public :: set_vertex_info => dag_set_vertex_info procedure , public :: toposort => dag_toposort procedure , public :: generate_digraph => dag_generate_digraph procedure , public :: generate_dependency_matrix => dag_generate_dependency_matrix procedure , public :: save_digraph => dag_save_digraph procedure , public :: get_edges => dag_get_edges procedure , public :: get_dependencies => dag_get_dependencies procedure , public :: destroy => dag_destroy procedure :: init_internal_vars !! private routine to initialize some internal variables procedure :: dag_set_edges_no_atts , dag_set_edges_vector_atts end type dag","tags":"","loc":"type/dag.html"},{"title":"edge_constructor – daglib","text":"private pure elemental function edge_constructor(ivertex, label, attributes) result(e) Constructor for edge type. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in), optional :: ivertex character(len=*), intent(in), optional :: label character(len=*), intent(in), optional :: attributes Return Value type( edge ) Called by proc~~edge_constructor~~CalledByGraph proc~edge_constructor dag_module::edge_constructor interface~edge dag_module::edge interface~edge->proc~edge_constructor Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure elemental function edge_constructor ( ivertex , label , attributes ) result ( e ) integer ( ip ), intent ( in ), optional :: ivertex character ( len =* ), intent ( in ), optional :: label character ( len =* ), intent ( in ), optional :: attributes type ( edge ) :: e e % ivertex = ivertex if ( present ( label )) e % label = label if ( present ( attributes )) e % attributes = attributes end function edge_constructor","tags":"","loc":"proc/edge_constructor.html"},{"title":"dag_get_edges – daglib","text":"private pure function dag_get_edges(me, ivertex) result(edges) get the edges for the vertex (all of the vertices\nthat this vertex depends on). Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me integer(kind=ip), intent(in) :: ivertex Return Value integer(kind=ip), dimension(:), allocatable Source Code pure function dag_get_edges ( me , ivertex ) result ( edges ) class ( dag ), intent ( in ) :: me integer ( ip ), intent ( in ) :: ivertex integer ( ip ), dimension (:), allocatable :: edges if ( ivertex > 0 . and . ivertex <= me % n ) then edges = me % vertices ( ivertex )% edges % ivertex ! auto LHS allocation end if end function dag_get_edges","tags":"","loc":"proc/dag_get_edges.html"},{"title":"dag_get_dependencies – daglib","text":"private pure function dag_get_dependencies(me, ivertex) result(dep) get all the vertices that depend on this vertex. Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me integer(kind=ip), intent(in) :: ivertex Return Value integer(kind=ip), dimension(:), allocatable the set of all vertices\nthan depend on ivertex Source Code pure function dag_get_dependencies ( me , ivertex ) result ( dep ) class ( dag ), intent ( in ) :: me integer ( ip ), intent ( in ) :: ivertex integer ( ip ), dimension (:), allocatable :: dep !! the set of all vertices !! than depend on `ivertex` integer ( ip ) :: i !! vertex counter if ( ivertex > 0 . and . ivertex <= me % n ) then ! have to check all the vertices: do i = 1 , me % n if ( allocated ( me % vertices ( i )% edges )) then if ( any ( me % vertices ( i )% edges % ivertex == ivertex )) then if ( allocated ( dep )) then dep = [ dep , i ] ! auto LHS allocation else dep = [ i ] ! auto LHS allocation end if end if end if end do end if end function dag_get_dependencies","tags":"","loc":"proc/dag_get_dependencies.html"},{"title":"dag_get_number_of_vertices – daglib","text":"private pure function dag_get_number_of_vertices(me) result(nvertices) Returns the number of vertices (nodes) in the dag. Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me Return Value integer(kind=ip) number of vertices Source Code pure function dag_get_number_of_vertices ( me ) result ( nvertices ) class ( dag ), intent ( in ) :: me integer ( ip ) :: nvertices !! number of vertices nvertices = me % n end function dag_get_number_of_vertices","tags":"","loc":"proc/dag_get_number_of_vertices.html"},{"title":"dag_get_vertex – daglib","text":"private function dag_get_vertex(me, i) result(v) Get the i th vertex. The program will stop if vertex i does not exist. Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: i vertex number Return Value type( vertex ) Source Code function dag_get_vertex ( me , i ) result ( v ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: i !! vertex number type ( vertex ) :: v if ( i < 0 . or . i > me % n ) then error stop 'Error in dag_get_vertex: invalid vertex number' else v = me % vertices ( i ) end if end function dag_get_vertex","tags":"","loc":"proc/dag_get_vertex.html"},{"title":"dag_generate_digraph – daglib","text":"private function dag_generate_digraph(me, rankdir, dpi) result(str) Generate a Graphviz digraph structure for the DAG. Example To convert this to a PDF using dot : dot -Tpdf -o test.pdf test.dot ,\n where test.dot is str written to a file. Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me character(len=*), intent(in), optional :: rankdir right to left orientation (e.g. 'RL') integer(kind=ip), intent(in), optional :: dpi resolution (e.g. 300) Return Value character(len=:), allocatable Calls proc~~dag_generate_digraph~~CallsGraph proc~dag_generate_digraph dag_module::dag%dag_generate_digraph proc~integer_to_string dag_module::integer_to_string proc~dag_generate_digraph->proc~integer_to_string Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~dag_generate_digraph~~CalledByGraph proc~dag_generate_digraph dag_module::dag%dag_generate_digraph proc~dag_save_digraph dag_module::dag%dag_save_digraph proc~dag_save_digraph->proc~dag_generate_digraph Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code function dag_generate_digraph ( me , rankdir , dpi ) result ( str ) class ( dag ), intent ( in ) :: me character ( len = :), allocatable :: str character ( len =* ), intent ( in ), optional :: rankdir !! right to left orientation (e.g. 'RL') integer ( ip ), intent ( in ), optional :: dpi !! resolution (e.g. 300) integer ( ip ) :: i , j !! counter integer ( ip ) :: n_edges !! number of edges character ( len = :), allocatable :: attributes !! full attributes string for node or edge logical :: compress !! if we can write all the edges on one line character ( len =* ), parameter :: tab = ' ' !! for indenting character ( len =* ), parameter :: newline = new_line ( ' ' ) !! line break character if ( me % n == 0 ) return str = 'digraph G {' // newline // newline if ( present ( rankdir )) & str = str // tab // 'rankdir=' // rankdir // newline // newline if ( present ( dpi )) & str = str // tab // 'graph [ dpi = ' // integer_to_string ( dpi ) // ' ]' // newline // newline ! define the vertices: do i = 1 , me % n attributes = get_attributes_string ( me % vertices ( i )% label , & me % vertices ( i )% attributes ) str = str // tab // integer_to_string ( i ) // ' ' // attributes // newline if ( i == me % n ) str = str // newline end do ! define the dependencies: do i = 1 , me % n if ( allocated ( me % vertices ( i )% edges )) then n_edges = size ( me % vertices ( i )% edges ) ! if none of the edges have attributes, ! then we can write them all on one line ! otherwise, write them line by line compress = . true . do j = 1 , n_edges if ( allocated ( me % vertices ( i )% edges ( j )% label ) . or . & allocated ( me % vertices ( i )% edges ( j )% attributes )) then compress = . false . exit end if end do if (. not . compress ) then ! Example: 1 -> 2 [penwidth=2, arrowhead=none] do j = 1 , n_edges attributes = get_attributes_string ( me % vertices ( i )% edges ( j )% label , & me % vertices ( i )% edges ( j )% attributes ) str = str // tab // integer_to_string ( i ) // ' -> ' // & integer_to_string ( me % vertices ( i )% edges ( j )% ivertex ) // ' ' // attributes // newline end do else ! Example: 1 -> 2,5,10 str = str // tab // integer_to_string ( i ) // merge ( ' -> ' , ' ' , n_edges /= 0 ) do j = 1 , n_edges ! comma-separated list: str = str // integer_to_string ( me % vertices ( i )% edges ( j )% ivertex ) if ( n_edges > 1 . and . j < n_edges ) str = str // ',' end do str = str // ';' // newline end if end if end do str = str // newline // '}' contains function get_attributes_string ( label , attributes ) result ( str ) !! create the full attributes string for an edge or node. character ( len = :), allocatable , intent ( in ) :: label !! if not allocated or blank, then not used character ( len = :), allocatable , intent ( in ) :: attributes !! if not allocated or blank, then not used character ( len = :), allocatable :: str !! the attributes string, enclosed in brackets character ( len = :), allocatable :: tmp_label logical :: has_label , has_attributes has_label = allocated ( label ) if ( has_label ) has_label = label /= '' if ( has_label ) tmp_label = 'label=\"' // trim ( adjustl ( label )) // '\"' has_attributes = allocated ( attributes ) if ( has_attributes ) has_attributes = attributes /= '' if ( has_label . and . has_attributes ) then str = '[' // trim ( adjustl ( attributes )) // ',' // tmp_label // ']' elseif ( has_label . and . . not . has_attributes ) then str = '[' // tmp_label // ']' elseif (. not . has_label . and . has_attributes ) then str = '[' // trim ( adjustl ( attributes )) // ']' else ! neither str = '' end if end function get_attributes_string end function dag_generate_digraph","tags":"","loc":"proc/dag_generate_digraph.html"},{"title":"integer_to_string – daglib","text":"private pure function integer_to_string(i) result(s) Integer to allocatable string. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in) :: i Return Value character(len=:), allocatable Called by proc~~integer_to_string~~CalledByGraph proc~integer_to_string dag_module::integer_to_string proc~dag_generate_digraph dag_module::dag%dag_generate_digraph proc~dag_generate_digraph->proc~integer_to_string proc~dag_set_vertices dag_module::dag%dag_set_vertices proc~dag_set_vertices->proc~integer_to_string proc~dag_save_digraph dag_module::dag%dag_save_digraph proc~dag_save_digraph->proc~dag_generate_digraph Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure function integer_to_string ( i ) result ( s ) integer ( ip ), intent ( in ) :: i character ( len = :), allocatable :: s integer ( ip ) :: istat allocate ( character ( len = MAX_INT_STR_LEN ) :: s ) ! should be big enough write ( s , fmt = '(ss,I0)' , iostat = istat ) i if ( istat == 0 ) then s = trim ( adjustl ( s )) else s = '***' end if end function integer_to_string","tags":"","loc":"proc/integer_to_string.html"},{"title":"unique – daglib","text":"private function unique(vec) result(vec_unique) Return only the unique values from vec .\nThe result is also sorted by ascending value. Arguments Type Intent Optional Attributes Name type( edge ), intent(in), dimension(:) :: vec Return Value type( edge ), dimension(:), allocatable only the unique elements of vec Calls proc~~unique~~CallsGraph proc~unique dag_module::unique proc~sort_ascending dag_module::sort_ascending proc~unique->proc~sort_ascending proc~swap dag_module::swap proc~sort_ascending->proc~swap Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code function unique ( vec ) result ( vec_unique ) type ( edge ), dimension (:), intent ( in ) :: vec type ( edge ), dimension (:), allocatable :: vec_unique !! only the unique elements of `vec` integer ( ip ) :: i !! counter integer ( ip ) :: n !! size of `vec` logical , dimension (:), allocatable :: mask !! for flagging the unique values n = size ( vec ) vec_unique = vec ! make a copy if ( n <= 1 ) return ! get the unique elements by sorting the array ! and then excluding any that are the same as the previous element. call sort_ascending ( vec_unique ) allocate ( mask ( n )); mask ( 1 ) = . true . do i = 2 , n mask ( i ) = ( vec_unique ( i )% ivertex /= vec_unique ( i - 1 )% ivertex ) end do vec_unique = pack ( vec_unique , mask ) end function unique","tags":"","loc":"proc/unique.html"},{"title":"dag_destroy – daglib","text":"private subroutine dag_destroy(me) Destroy the dag . Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me Source Code subroutine dag_destroy ( me ) class ( dag ), intent ( inout ) :: me me % n = 0 if ( allocated ( me % vertices )) deallocate ( me % vertices ) end subroutine dag_destroy","tags":"","loc":"proc/dag_destroy.html"},{"title":"set_edge_vector_vector – daglib","text":"private subroutine set_edge_vector_vector(me, edges, label, attributes) specify the edge indices for this vertex Type Bound vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in), dimension(:) :: edges character(len=*), intent(in), optional, dimension(:) :: label character(len=*), intent(in), optional, dimension(:) :: attributes other attributes when\nsaving as a diagraph. Calls proc~~set_edge_vector_vector~~CallsGraph proc~set_edge_vector_vector dag_module::vertex%set_edge_vector_vector proc~add_edge dag_module::vertex%add_edge proc~set_edge_vector_vector->proc~add_edge proc~sort_ascending dag_module::sort_ascending proc~add_edge->proc~sort_ascending proc~swap dag_module::swap proc~sort_ascending->proc~swap Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~set_edge_vector_vector~~CalledByGraph proc~set_edge_vector_vector dag_module::vertex%set_edge_vector_vector none~set_edges dag_module::vertex%set_edges none~set_edges->proc~set_edge_vector_vector proc~dag_add_edge dag_module::dag%dag_add_edge proc~dag_add_edge->none~set_edges proc~dag_set_edges_no_atts dag_module::dag%dag_set_edges_no_atts proc~dag_set_edges_no_atts->none~set_edges proc~dag_set_edges_vector_atts dag_module::dag%dag_set_edges_vector_atts proc~dag_set_edges_vector_atts->none~set_edges Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine set_edge_vector_vector ( me , edges , label , attributes ) class ( vertex ), intent ( inout ) :: me integer ( ip ), dimension (:), intent ( in ) :: edges character ( len =* ), dimension (:), intent ( in ), optional :: label character ( len =* ), dimension (:), intent ( in ), optional :: attributes !! other attributes when !! saving as a diagraph. integer ( ip ) :: i !! counter do i = 1 , size ( edges ) if ( present ( label ) . and . present ( attributes )) then call me % add_edge ( edges ( i ), label = label ( i ), attributes = attributes ( i )) else if (. not . present ( label ) . and . present ( attributes )) then call me % add_edge ( edges ( i ), attributes = attributes ( i )) else if ( present ( label ) . and . . not . present ( attributes )) then call me % add_edge ( edges ( i ), label = label ( i )) else call me % add_edge ( edges ( i )) end if end do end subroutine set_edge_vector_vector","tags":"","loc":"proc/set_edge_vector_vector.html"},{"title":"add_edge – daglib","text":"private subroutine add_edge(me, e, label, attributes) add an edge index for this vertex Type Bound vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in) :: e character(len=*), intent(in), optional :: label character(len=*), intent(in), optional :: attributes other attributes when\nsaving as a diagraph. Calls proc~~add_edge~~CallsGraph proc~add_edge dag_module::vertex%add_edge proc~sort_ascending dag_module::sort_ascending proc~add_edge->proc~sort_ascending proc~swap dag_module::swap proc~sort_ascending->proc~swap Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~add_edge~~CalledByGraph proc~add_edge dag_module::vertex%add_edge none~set_edges dag_module::vertex%set_edges none~set_edges->proc~add_edge proc~set_edge_vector_vector dag_module::vertex%set_edge_vector_vector none~set_edges->proc~set_edge_vector_vector proc~set_edge_vector_vector->proc~add_edge proc~dag_add_edge dag_module::dag%dag_add_edge proc~dag_add_edge->none~set_edges proc~dag_set_edges_no_atts dag_module::dag%dag_set_edges_no_atts proc~dag_set_edges_no_atts->none~set_edges proc~dag_set_edges_vector_atts dag_module::dag%dag_set_edges_vector_atts proc~dag_set_edges_vector_atts->none~set_edges Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine add_edge ( me , e , label , attributes ) class ( vertex ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: e character ( len =* ), intent ( in ), optional :: label character ( len =* ), intent ( in ), optional :: attributes !! other attributes when !! saving as a diagraph. if ( allocated ( me % edges )) then if (. not . any ( e == me % edges % ivertex )) then ! don't add if already there me % edges = [ me % edges , edge ( e , label = label , attributes = attributes )] call sort_ascending ( me % edges ) end if else me % edges = [ edge ( e , label = label , attributes = attributes )] end if end subroutine add_edge","tags":"","loc":"proc/add_edge.html"},{"title":"remove_edge – daglib","text":"private subroutine remove_edge(me, e) remove an edge index from this vertex Type Bound vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in) :: e Called by proc~~remove_edge~~CalledByGraph proc~remove_edge dag_module::vertex%remove_edge proc~dag_remove_edge dag_module::dag%dag_remove_edge proc~dag_remove_edge->proc~remove_edge proc~dag_remove_node dag_module::dag%dag_remove_node proc~dag_remove_node->proc~remove_edge Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine remove_edge ( me , e ) class ( vertex ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: e integer ( ip ), dimension ( 1 ) :: idx type ( edge ), dimension (:), allocatable :: tmp if ( allocated ( me % edges )) then idx = findloc ( me % edges % ivertex , e ) if ( idx ( 1 ) > 0 ) then ! the edge is in the list associate ( i => idx ( 1 ), n => size ( me % edges )) if ( n == 1 ) then deallocate ( me % edges ) ! it's the only one there else allocate ( tmp ( n - 1 )) if ( i > 1 ) tmp ( 1 : i - 1 ) = me % edges ( 1 : i - 1 ) if ( i < n ) tmp ( i : n - 1 ) = me % edges ( i + 1 : n ) call move_alloc ( tmp , me % edges ) end if end associate end if end if end subroutine remove_edge","tags":"","loc":"proc/remove_edge.html"},{"title":"dag_remove_node – daglib","text":"private subroutine dag_remove_node(me, ivertex) Remove a node from a dag. Will also remove any edges connected to it. This will renumber the nodes and edges internally.\nNote that any default integer labels generated in dag_set_vertices would then be questionable. Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex the node to remove Calls proc~~dag_remove_node~~CallsGraph proc~dag_remove_node dag_module::dag%dag_remove_node proc~remove_edge dag_module::vertex%remove_edge proc~dag_remove_node->proc~remove_edge Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dag_remove_node ( me , ivertex ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! the node to remove integer ( ip ) :: i !! counter type ( vertex ), dimension (:), allocatable :: tmp !! for resizing `me%vertices` if ( allocated ( me % vertices )) then associate ( n => size ( me % vertices )) do i = 1 , n ! first remove any edges: call me % vertices ( i )% remove_edge ( ivertex ) ! next, renumber the existing edges so they will be ! correct after ivertex is deleted ! Example (removing 2): 1 [2] 3 4 ==> 1 2 3 if ( allocated ( me % vertices ( i )% edges )) then where ( me % vertices ( i )% edges % ivertex > ivertex ) me % vertices ( i )% edges % ivertex = me % vertices ( i )% edges % ivertex - 1 end where end if end do ! now, remove the node: allocate ( tmp ( n - 1 )) if ( ivertex > 1 ) tmp ( 1 : ivertex - 1 ) = me % vertices ( 1 : ivertex - 1 ) if ( ivertex < n ) tmp ( ivertex : n - 1 ) = me % vertices ( ivertex + 1 : n ) call move_alloc ( tmp , me % vertices ) end associate end if me % n = size ( me % vertices ) if ( me % n == 0 ) deallocate ( me % vertices ) end subroutine dag_remove_node","tags":"","loc":"proc/dag_remove_node.html"},{"title":"dag_set_vertices – daglib","text":"private subroutine dag_set_vertices(me, nvertices, labels) set the number of vertices (nodes) in the dag. See also dag_remove_node which can be used to remove a vertex. dag_set_vertex_info which can be used to set/change\n the labels and other attributes. Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: nvertices number of vertices character(len=*), intent(in), optional, dimension(nvertices) :: labels vertex name strings Calls proc~~dag_set_vertices~~CallsGraph proc~dag_set_vertices dag_module::dag%dag_set_vertices proc~integer_to_string dag_module::integer_to_string proc~dag_set_vertices->proc~integer_to_string Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dag_set_vertices ( me , nvertices , labels ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: nvertices !! number of vertices character ( len =* ), dimension ( nvertices ), intent ( in ), optional :: labels !! vertex name strings integer ( ip ) :: i !! counter if ( nvertices <= 0 ) error stop 'error: nvertices must be >= 1' if ( allocated ( me % vertices )) deallocate ( me % vertices ) me % n = nvertices allocate ( me % vertices ( nvertices )) me % vertices % ivertex = [( i , i = 1 , nvertices )] if ( present ( labels )) then do i = 1 , nvertices me % vertices ( i )% label = trim ( adjustl ( labels ( i ))) end do else ! just use the vertex number do i = 1 , nvertices me % vertices ( i )% label = integer_to_string ( i ) end do end if end subroutine dag_set_vertices","tags":"","loc":"proc/dag_set_vertices.html"},{"title":"dag_set_vertex_info – daglib","text":"private subroutine dag_set_vertex_info(me, ivertex, label, attributes) set info about a vertex in a dag. Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number character(len=*), intent(in), optional :: label if a label is not set,\nthen the integer vertex\nnumber is used. character(len=*), intent(in), optional :: attributes other attributes when\nsaving as a diagraph. Source Code subroutine dag_set_vertex_info ( me , ivertex , label , attributes ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! vertex number character ( len =* ), intent ( in ), optional :: label !! if a label is not set, !! then the integer vertex !! number is used. character ( len =* ), intent ( in ), optional :: attributes !! other attributes when !! saving as a diagraph. if ( present ( label )) me % vertices ( ivertex )% label = label if ( present ( attributes )) me % vertices ( ivertex )% attributes = attributes end subroutine dag_set_vertex_info","tags":"","loc":"proc/dag_set_vertex_info.html"},{"title":"dag_add_edge – daglib","text":"private subroutine dag_add_edge(me, ivertex, iedge, label, attributes) Add an edge to a dag. Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in) :: iedge the vertex to connect to ivertex character(len=*), intent(in), optional :: label edge label character(len=*), intent(in), optional :: attributes other attributes when\nsaving as a diagraph. Calls proc~~dag_add_edge~~CallsGraph proc~dag_add_edge dag_module::dag%dag_add_edge none~set_edges dag_module::vertex%set_edges proc~dag_add_edge->none~set_edges proc~add_edge dag_module::vertex%add_edge none~set_edges->proc~add_edge proc~set_edge_vector_vector dag_module::vertex%set_edge_vector_vector none~set_edges->proc~set_edge_vector_vector proc~sort_ascending dag_module::sort_ascending proc~add_edge->proc~sort_ascending proc~set_edge_vector_vector->proc~add_edge proc~swap dag_module::swap proc~sort_ascending->proc~swap Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dag_add_edge ( me , ivertex , iedge , label , attributes ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! vertex number integer ( ip ), intent ( in ) :: iedge !! the vertex to connect to `ivertex` character ( len =* ), intent ( in ), optional :: label !! edge label character ( len =* ), intent ( in ), optional :: attributes !! other attributes when !! saving as a diagraph. call me % vertices ( ivertex )% set_edges ( iedge ,& label = label ,& attributes = attributes ) end subroutine dag_add_edge","tags":"","loc":"proc/dag_add_edge.html"},{"title":"dag_set_edges_no_atts – daglib","text":"private subroutine dag_set_edges_no_atts(me, ivertex, edges) set the edges for a vertex in a dag Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in), dimension(:) :: edges Calls proc~~dag_set_edges_no_atts~~CallsGraph proc~dag_set_edges_no_atts dag_module::dag%dag_set_edges_no_atts none~set_edges dag_module::vertex%set_edges proc~dag_set_edges_no_atts->none~set_edges proc~add_edge dag_module::vertex%add_edge none~set_edges->proc~add_edge proc~set_edge_vector_vector dag_module::vertex%set_edge_vector_vector none~set_edges->proc~set_edge_vector_vector proc~sort_ascending dag_module::sort_ascending proc~add_edge->proc~sort_ascending proc~set_edge_vector_vector->proc~add_edge proc~swap dag_module::swap proc~sort_ascending->proc~swap Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dag_set_edges_no_atts ( me , ivertex , edges ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! vertex number integer ( ip ), dimension (:), intent ( in ) :: edges call me % vertices ( ivertex )% set_edges ( edges ) end subroutine dag_set_edges_no_atts","tags":"","loc":"proc/dag_set_edges_no_atts.html"},{"title":"dag_remove_edge – daglib","text":"private subroutine dag_remove_edge(me, ivertex, iedge) Remove an edge from a dag. Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in) :: iedge the edge to remove Calls proc~~dag_remove_edge~~CallsGraph proc~dag_remove_edge dag_module::dag%dag_remove_edge proc~remove_edge dag_module::vertex%remove_edge proc~dag_remove_edge->proc~remove_edge Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dag_remove_edge ( me , ivertex , iedge ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! vertex number integer ( ip ), intent ( in ) :: iedge !! the edge to remove call me % vertices ( ivertex )% remove_edge ( iedge ) end subroutine dag_remove_edge","tags":"","loc":"proc/dag_remove_edge.html"},{"title":"dag_set_edges_vector_atts – daglib","text":"private subroutine dag_set_edges_vector_atts(me, ivertex, edges, attributes, label) set the edges for a vertex in a dag Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in), dimension(:) :: edges character(len=*), intent(in), dimension(:) :: attributes other attributes when\nsaving as a diagraph. character(len=*), intent(in), optional, dimension(:) :: label Calls proc~~dag_set_edges_vector_atts~~CallsGraph proc~dag_set_edges_vector_atts dag_module::dag%dag_set_edges_vector_atts none~set_edges dag_module::vertex%set_edges proc~dag_set_edges_vector_atts->none~set_edges proc~add_edge dag_module::vertex%add_edge none~set_edges->proc~add_edge proc~set_edge_vector_vector dag_module::vertex%set_edge_vector_vector none~set_edges->proc~set_edge_vector_vector proc~sort_ascending dag_module::sort_ascending proc~add_edge->proc~sort_ascending proc~set_edge_vector_vector->proc~add_edge proc~swap dag_module::swap proc~sort_ascending->proc~swap Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dag_set_edges_vector_atts ( me , ivertex , edges , attributes , label ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! vertex number integer ( ip ), dimension (:), intent ( in ) :: edges character ( len =* ), dimension (:), intent ( in ) :: attributes !! other attributes when !! saving as a diagraph. character ( len =* ), dimension (:), intent ( in ), optional :: label call me % vertices ( ivertex )% set_edges ( edges , label = label , attributes = attributes ) end subroutine dag_set_edges_vector_atts","tags":"","loc":"proc/dag_set_edges_vector_atts.html"},{"title":"init_internal_vars – daglib","text":"private subroutine init_internal_vars(me) Initialize the internal private variables used for graph traversal. Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me Called by proc~~init_internal_vars~~CalledByGraph proc~init_internal_vars dag_module::dag%init_internal_vars proc~dag_toposort dag_module::dag%dag_toposort proc~dag_toposort->proc~init_internal_vars Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine init_internal_vars ( me ) class ( dag ), intent ( inout ) :: me integer ( ip ) :: i !! counter do i = 1 , me % n me % vertices ( i )% marked = . false . me % vertices ( i )% checking = . false . end do end subroutine init_internal_vars","tags":"","loc":"proc/init_internal_vars.html"},{"title":"dag_toposort – daglib","text":"private subroutine dag_toposort(me, order, istat) Main toposort routine Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(out), dimension(:), allocatable :: order the toposort order integer(kind=ip), intent(out) :: istat Status flag: 0 if no errors -1 if circular dependency\n (in this case, order will not be allocated) Calls proc~~dag_toposort~~CallsGraph proc~dag_toposort dag_module::dag%dag_toposort proc~init_internal_vars dag_module::dag%init_internal_vars proc~dag_toposort->proc~init_internal_vars Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dag_toposort ( me , order , istat ) class ( dag ), intent ( inout ) :: me integer ( ip ), dimension (:), allocatable , intent ( out ) :: order !! the toposort order integer ( ip ), intent ( out ) :: istat !! Status flag: !! !! * 0 if no errors !! * -1 if circular dependency !! (in this case, `order` will not be allocated) integer ( ip ) :: i , iorder if ( me % n == 0 ) return ! initialize internal variables, in case ! we have called this routine before. call me % init_internal_vars () allocate ( order ( me % n )) iorder = 0 ! index in order array istat = 0 ! no errors so far do i = 1 , me % n if (. not . me % vertices ( i )% marked ) call dfs ( me % vertices ( i )) if ( istat ==- 1 ) exit end do if ( istat ==- 1 ) deallocate ( order ) contains recursive subroutine dfs ( v ) !! depth-first graph traversal type ( vertex ), intent ( inout ) :: v integer ( ip ) :: j if ( istat ==- 1 ) return if ( v % checking ) then ! error: circular dependency istat = - 1 else if (. not . v % marked ) then v % checking = . true . if ( allocated ( v % edges )) then do j = 1 , size ( v % edges ) call dfs ( me % vertices ( v % edges ( j )% ivertex )) if ( istat ==- 1 ) return end do end if v % checking = . false . v % marked = . true . iorder = iorder + 1 order ( iorder ) = v % ivertex end if end if end subroutine dfs end subroutine dag_toposort","tags":"","loc":"proc/dag_toposort.html"},{"title":"dag_generate_dependency_matrix – daglib","text":"private subroutine dag_generate_dependency_matrix(me, mat) Generate the dependency matrix for the DAG. This is an matrix with elements ,\nsuch that is true if vertex depends on vertex . Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me logical, intent(out), dimension(:,:), allocatable :: mat dependency matrix Source Code subroutine dag_generate_dependency_matrix ( me , mat ) class ( dag ), intent ( in ) :: me logical , dimension (:,:), intent ( out ), allocatable :: mat !! dependency matrix integer ( ip ) :: i !! vertex counter integer ( ip ) :: j !! edge counter if ( me % n > 0 ) then allocate ( mat ( me % n , me % n )) mat = . false . do i = 1 , me % n if ( allocated ( me % vertices ( i )% edges )) then do j = 1 , size ( me % vertices ( i )% edges ) mat ( i , me % vertices ( i )% edges ( j )% ivertex ) = . true . end do end if end do end if end subroutine dag_generate_dependency_matrix","tags":"","loc":"proc/dag_generate_dependency_matrix.html"},{"title":"dag_save_digraph – daglib","text":"private subroutine dag_save_digraph(me, filename, rankdir, dpi) Generate a Graphviz digraph structure for the DAG and write it to a file. Type Bound dag Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me character(len=*), intent(in), optional :: filename file name for diagraph character(len=*), intent(in), optional :: rankdir right to left orientation (e.g. 'RL') integer(kind=ip), intent(in), optional :: dpi resolution (e.g. 300) Calls proc~~dag_save_digraph~~CallsGraph proc~dag_save_digraph dag_module::dag%dag_save_digraph proc~dag_generate_digraph dag_module::dag%dag_generate_digraph proc~dag_save_digraph->proc~dag_generate_digraph proc~integer_to_string dag_module::integer_to_string proc~dag_generate_digraph->proc~integer_to_string Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine dag_save_digraph ( me , filename , rankdir , dpi ) class ( dag ), intent ( in ) :: me character ( len =* ), intent ( in ), optional :: filename !! file name for diagraph character ( len =* ), intent ( in ), optional :: rankdir !! right to left orientation (e.g. 'RL') integer ( ip ), intent ( in ), optional :: dpi !! resolution (e.g. 300) integer ( ip ) :: iunit , istat character ( len = :), allocatable :: diagraph diagraph = me % generate_digraph ( rankdir , dpi ) open ( newunit = iunit , file = filename , status = 'REPLACE' , iostat = istat ) if ( istat == 0 ) then write ( iunit , fmt = '(A)' , iostat = istat ) diagraph else write ( * , * ) 'error opening ' // trim ( filename ) end if close ( iunit , iostat = istat ) end subroutine dag_save_digraph","tags":"","loc":"proc/dag_save_digraph.html"},{"title":"sort_ascending – daglib","text":"private subroutine sort_ascending(ivec) Sorts an edge array ivec in increasing order by vertex number.\nUses a basic recursive quicksort\n(with insertion sort for partitions with 20 elements). Arguments Type Intent Optional Attributes Name type( edge ), intent(inout), dimension(:) :: ivec Calls proc~~sort_ascending~~CallsGraph proc~sort_ascending dag_module::sort_ascending proc~swap dag_module::swap proc~sort_ascending->proc~swap Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Called by proc~~sort_ascending~~CalledByGraph proc~sort_ascending dag_module::sort_ascending proc~add_edge dag_module::vertex%add_edge proc~add_edge->proc~sort_ascending proc~unique dag_module::unique proc~unique->proc~sort_ascending none~set_edges dag_module::vertex%set_edges none~set_edges->proc~add_edge proc~set_edge_vector_vector dag_module::vertex%set_edge_vector_vector none~set_edges->proc~set_edge_vector_vector proc~set_edge_vector_vector->proc~add_edge proc~dag_add_edge dag_module::dag%dag_add_edge proc~dag_add_edge->none~set_edges proc~dag_set_edges_no_atts dag_module::dag%dag_set_edges_no_atts proc~dag_set_edges_no_atts->none~set_edges proc~dag_set_edges_vector_atts dag_module::dag%dag_set_edges_vector_atts proc~dag_set_edges_vector_atts->none~set_edges Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code subroutine sort_ascending ( ivec ) type ( edge ), dimension (:), intent ( inout ) :: ivec integer ( ip ), parameter :: max_size_for_insertion_sort = 20_ip !! max size for using insertion sort. call quicksort ( 1_ip , size ( ivec , kind = ip )) contains recursive subroutine quicksort ( ilow , ihigh ) !! Sort the array integer ( ip ), intent ( in ) :: ilow integer ( ip ), intent ( in ) :: ihigh integer ( ip ) :: ipivot !! pivot element integer ( ip ) :: i !! counter integer ( ip ) :: j !! counter if ( ihigh - ilow <= max_size_for_insertion_sort . and . ihigh > ilow ) then ! do insertion sort: do i = ilow + 1 , ihigh do j = i , ilow + 1 , - 1 if ( ivec ( j )% ivertex < ivec ( j - 1 )% ivertex ) then call swap ( ivec ( j ), ivec ( j - 1 )) else exit end if end do end do elseif ( ihigh - ilow > max_size_for_insertion_sort ) then ! do the normal quicksort: call partition ( ilow , ihigh , ipivot ) call quicksort ( ilow , ipivot - 1_ip ) call quicksort ( ipivot + 1_ip , ihigh ) end if end subroutine quicksort subroutine partition ( ilow , ihigh , ipivot ) !! Partition the array, based on the !! lexical ivecing comparison. integer ( ip ), intent ( in ) :: ilow integer ( ip ), intent ( in ) :: ihigh integer ( ip ), intent ( out ) :: ipivot integer ( ip ) :: i , ii call swap ( ivec ( ilow ), ivec (( ilow + ihigh ) / 2 )) ii = ilow do i = ilow + 1 , ihigh if ( ivec ( i )% ivertex < ivec ( ilow )% ivertex ) then ii = ii + 1 call swap ( ivec ( ii ), ivec ( i )) end if end do call swap ( ivec ( ilow ), ivec ( ii )) ipivot = ii end subroutine partition end subroutine sort_ascending","tags":"","loc":"proc/sort_ascending.html"},{"title":"swap – daglib","text":"private pure elemental subroutine swap(i1, i2) Swap two edge values. Arguments Type Intent Optional Attributes Name type( edge ), intent(inout) :: i1 type( edge ), intent(inout) :: i2 Called by proc~~swap~~CalledByGraph proc~swap dag_module::swap proc~sort_ascending dag_module::sort_ascending proc~sort_ascending->proc~swap proc~add_edge dag_module::vertex%add_edge proc~add_edge->proc~sort_ascending proc~unique dag_module::unique proc~unique->proc~sort_ascending none~set_edges dag_module::vertex%set_edges none~set_edges->proc~add_edge proc~set_edge_vector_vector dag_module::vertex%set_edge_vector_vector none~set_edges->proc~set_edge_vector_vector proc~set_edge_vector_vector->proc~add_edge proc~dag_add_edge dag_module::dag%dag_add_edge proc~dag_add_edge->none~set_edges proc~dag_set_edges_no_atts dag_module::dag%dag_set_edges_no_atts proc~dag_set_edges_no_atts->none~set_edges proc~dag_set_edges_vector_atts dag_module::dag%dag_set_edges_vector_atts proc~dag_set_edges_vector_atts->none~set_edges Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Source Code pure elemental subroutine swap ( i1 , i2 ) type ( edge ), intent ( inout ) :: i1 type ( edge ), intent ( inout ) :: i2 type ( edge ) :: tmp tmp = i1 i1 = i2 i2 = tmp end subroutine swap","tags":"","loc":"proc/swap.html"},{"title":"edge – daglib","text":"private interface edge constructor for an edge type. Calls interface~~edge~~CallsGraph interface~edge dag_module::edge proc~edge_constructor dag_module::edge_constructor interface~edge->proc~edge_constructor Help × Graph Key Nodes of different colours represent the following: Graph Key Subroutine Subroutine Function Function Interface Interface Type Bound Procedure Type Bound Procedure Unknown Procedure Type Unknown Procedure Type Program Program This Page's Entity This Page's Entity Solid arrows point from a procedure to one which it calls. Dashed \narrows point from an interface to procedures which implement that interface.\nThis could include the module procedures in a generic interface or the\nimplementation in a submodule of an interface in a parent module. Module Procedures private pure elemental function edge_constructor (ivertex, label, attributes) result(e) Constructor for edge type. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in), optional :: ivertex character(len=*), intent(in), optional :: label character(len=*), intent(in), optional :: attributes Return Value type( edge )","tags":"","loc":"interface/edge.html"},{"title":"dag_module – daglib","text":"DAG Module. Uses iso_fortran_env module~~dag_module~~UsesGraph module~dag_module dag_module iso_fortran_env iso_fortran_env module~dag_module->iso_fortran_env Help × Graph Key Nodes of different colours represent the following: Graph Key Module Module Submodule Submodule Subroutine Subroutine Function Function Program Program This Page's Entity This Page's Entity Solid arrows point from a submodule to the (sub)module which it is\ndescended from. Dashed arrows point from a module or program unit to \nmodules which it uses. Variables Type Visibility Attributes Name Initial integer, public, parameter :: daglib_ip = int32 Integer working precision if not specified [4 bytes] integer, private, parameter :: ip = daglib_ip local copy of daglib_ip with a shorter name integer(kind=ip), private, parameter :: MAX_INT_STR_LEN = 64 maximum length of an integer string Interfaces private interface edge constructor for an edge type. private pure elemental function edge_constructor (ivertex, label, attributes) result(e) Constructor for edge type. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in), optional :: ivertex character(len=*), intent(in), optional :: label character(len=*), intent(in), optional :: attributes Return Value type( edge ) Derived Types type, private :: edge the \"to\" vertex that defines an edge. This is part of\nthe array of vertices contained without the \"from\" vertex type.\nan edge can also have optional attrubutes for graphviz. Components Type Visibility Attributes Name Initial integer(kind=ip), public :: ivertex = 0 vertex number (the index in the dag vertices array) character(len=:), public, allocatable :: label used for diagraph character(len=:), public, allocatable :: attributes used for diagraph Constructor constructor for an edge type. private\n\n pure, elemental\n function edge_constructor (ivertex, label, attributes) Constructor for edge type. type, private :: vertex a vertex (or node) of a directed acyclic graph (DAG) Components Type Visibility Attributes Name Initial type( edge ), private, dimension(:), allocatable :: edges these are the vertices that this vertex\ndepends on. (edges of the graph). integer(kind=ip), private :: ivertex = 0 vertex number (the index in the dag vertices array) logical, private :: checking = .false. used for toposort logical, private :: marked = .false. used for toposort character(len=:), private, allocatable :: label used for diagraph character(len=:), private, allocatable :: attributes used for diagraph Type-Bound Procedures generic, private :: set_edges => set_edge_vector_vector , add_edge procedure, private :: add_edge procedure, private :: set_edge_vector_vector procedure, private :: remove_edge type, public :: dag a directed acyclic graph (DAG).\na collection of vertices (nodes) that are connected to other vertices. Components Type Visibility Attributes Name Initial integer(kind=ip), private :: n = 0 number of vertices (size of vertices array) type( vertex ), private, dimension(:), allocatable :: vertices the vertices in the DAG. The index in\nthis array if the vertex number. Type-Bound Procedures procedure, public :: vertex => dag_get_vertex not very useful for now, since\nall vertex attributes are private procedure, public :: number_of_vertices => dag_get_number_of_vertices procedure, public :: set_vertices => dag_set_vertices generic, public :: set_edges => dag_set_edges_no_atts , dag_set_edges_vector_atts procedure, public :: add_edge => dag_add_edge procedure, public :: remove_edge => dag_remove_edge procedure, public :: remove_vertex => dag_remove_node procedure, public :: set_vertex_info => dag_set_vertex_info procedure, public :: toposort => dag_toposort procedure, public :: generate_digraph => dag_generate_digraph procedure, public :: generate_dependency_matrix => dag_generate_dependency_matrix procedure, public :: save_digraph => dag_save_digraph procedure, public :: get_edges => dag_get_edges procedure, public :: get_dependencies => dag_get_dependencies procedure, public :: destroy => dag_destroy procedure, private :: init_internal_vars private routine to initialize some internal variables procedure, private :: dag_set_edges_vector_atts procedure, private :: dag_set_edges_no_atts Functions private pure elemental function edge_constructor (ivertex, label, attributes) result(e) Constructor for edge type. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in), optional :: ivertex character(len=*), intent(in), optional :: label character(len=*), intent(in), optional :: attributes Return Value type( edge ) private pure function dag_get_edges (me, ivertex) result(edges) get the edges for the vertex (all of the vertices\nthat this vertex depends on). Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me integer(kind=ip), intent(in) :: ivertex Return Value integer(kind=ip), dimension(:), allocatable private pure function dag_get_dependencies (me, ivertex) result(dep) get all the vertices that depend on this vertex. Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me integer(kind=ip), intent(in) :: ivertex Return Value integer(kind=ip), dimension(:), allocatable the set of all vertices\nthan depend on ivertex private pure function dag_get_number_of_vertices (me) result(nvertices) Returns the number of vertices (nodes) in the dag. Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me Return Value integer(kind=ip) number of vertices private function dag_get_vertex (me, i) result(v) Get the i th vertex. Read more… Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: i vertex number Return Value type( vertex ) private function dag_generate_digraph (me, rankdir, dpi) result(str) Generate a Graphviz digraph structure for the DAG. Read more… Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me character(len=*), intent(in), optional :: rankdir right to left orientation (e.g. 'RL') integer(kind=ip), intent(in), optional :: dpi resolution (e.g. 300) Return Value character(len=:), allocatable private pure function integer_to_string (i) result(s) Integer to allocatable string. Arguments Type Intent Optional Attributes Name integer(kind=ip), intent(in) :: i Return Value character(len=:), allocatable private function unique (vec) result(vec_unique) Return only the unique values from vec .\nThe result is also sorted by ascending value. Arguments Type Intent Optional Attributes Name type( edge ), intent(in), dimension(:) :: vec Return Value type( edge ), dimension(:), allocatable only the unique elements of vec Subroutines private subroutine dag_destroy (me) Destroy the dag . Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me private subroutine set_edge_vector_vector (me, edges, label, attributes) specify the edge indices for this vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in), dimension(:) :: edges character(len=*), intent(in), optional, dimension(:) :: label character(len=*), intent(in), optional, dimension(:) :: attributes other attributes when\nsaving as a diagraph. private subroutine add_edge (me, e, label, attributes) add an edge index for this vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in) :: e character(len=*), intent(in), optional :: label character(len=*), intent(in), optional :: attributes other attributes when\nsaving as a diagraph. private subroutine remove_edge (me, e) remove an edge index from this vertex Arguments Type Intent Optional Attributes Name class( vertex ), intent(inout) :: me integer(kind=ip), intent(in) :: e private subroutine dag_remove_node (me, ivertex) Remove a node from a dag. Will also remove any edges connected to it. Read more… Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex the node to remove private subroutine dag_set_vertices (me, nvertices, labels) set the number of vertices (nodes) in the dag. Read more… Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: nvertices number of vertices character(len=*), intent(in), optional, dimension(nvertices) :: labels vertex name strings private subroutine dag_set_vertex_info (me, ivertex, label, attributes) set info about a vertex in a dag. Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number character(len=*), intent(in), optional :: label if a label is not set,\nthen the integer vertex\nnumber is used. character(len=*), intent(in), optional :: attributes other attributes when\nsaving as a diagraph. private subroutine dag_add_edge (me, ivertex, iedge, label, attributes) Add an edge to a dag. Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in) :: iedge the vertex to connect to ivertex character(len=*), intent(in), optional :: label edge label character(len=*), intent(in), optional :: attributes other attributes when\nsaving as a diagraph. private subroutine dag_set_edges_no_atts (me, ivertex, edges) set the edges for a vertex in a dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in), dimension(:) :: edges private subroutine dag_remove_edge (me, ivertex, iedge) Remove an edge from a dag. Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in) :: iedge the edge to remove private subroutine dag_set_edges_vector_atts (me, ivertex, edges, attributes, label) set the edges for a vertex in a dag Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(in) :: ivertex vertex number integer(kind=ip), intent(in), dimension(:) :: edges character(len=*), intent(in), dimension(:) :: attributes other attributes when\nsaving as a diagraph. character(len=*), intent(in), optional, dimension(:) :: label private subroutine init_internal_vars (me) Initialize the internal private variables used for graph traversal. Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me private subroutine dag_toposort (me, order, istat) Main toposort routine Arguments Type Intent Optional Attributes Name class( dag ), intent(inout) :: me integer(kind=ip), intent(out), dimension(:), allocatable :: order the toposort order integer(kind=ip), intent(out) :: istat Status flag: Read more… private subroutine dag_generate_dependency_matrix (me, mat) Generate the dependency matrix for the DAG. Read more… Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me logical, intent(out), dimension(:,:), allocatable :: mat dependency matrix private subroutine dag_save_digraph (me, filename, rankdir, dpi) Generate a Graphviz digraph structure for the DAG and write it to a file. Arguments Type Intent Optional Attributes Name class( dag ), intent(in) :: me character(len=*), intent(in), optional :: filename file name for diagraph character(len=*), intent(in), optional :: rankdir right to left orientation (e.g. 'RL') integer(kind=ip), intent(in), optional :: dpi resolution (e.g. 300) private subroutine sort_ascending (ivec) Sorts an edge array ivec in increasing order by vertex number.\nUses a basic recursive quicksort\n(with insertion sort for partitions with 20 elements). Arguments Type Intent Optional Attributes Name type( edge ), intent(inout), dimension(:) :: ivec private pure elemental subroutine swap (i1, i2) Swap two edge values. Arguments Type Intent Optional Attributes Name type( edge ), intent(inout) :: i1 type( edge ), intent(inout) :: i2","tags":"","loc":"module/dag_module.html"},{"title":"dag_module.F90 – daglib","text":"Source Code !******************************************************************************* !> ! DAG Module. module dag_module use iso_fortran_env implicit none private #ifdef INT8 integer , parameter , public :: daglib_ip = int8 !! Integer working precision [1 byte] #elif INT16 integer , parameter , public :: daglib_ip = int16 !! Integer working precision [2 bytes] #elif INT32 integer , parameter , public :: daglib_ip = int32 !! Integer working precision [4 bytes] #elif INT64 integer , parameter , public :: daglib_ip = int64 !! Integer working precision [8 bytes] #else integer , parameter , public :: daglib_ip = int32 !! Integer working precision if not specified [4 bytes] #endif integer , parameter :: ip = daglib_ip !! local copy of `daglib_ip` with a shorter name integer ( ip ), parameter :: MAX_INT_STR_LEN = 64 !! maximum length of an integer string type :: edge !! the \"to\" vertex that defines an edge. This is part of !! the array of vertices contained without the \"from\" [[vertex]] type. !! an edge can also have optional attrubutes for graphviz. integer ( ip ) :: ivertex = 0 !! vertex number (the index in the [[dag]] `vertices` array) character ( len = :), allocatable :: label !! used for diagraph character ( len = :), allocatable :: attributes !! used for diagraph end type edge interface edge !! constructor for an [[edge]] type. procedure :: edge_constructor end interface edge type :: vertex !! a vertex (or node) of a directed acyclic graph (DAG) private type ( edge ), dimension (:), allocatable :: edges !! these are the vertices that this vertex !! depends on. (edges of the graph). integer ( ip ) :: ivertex = 0 !! vertex number (the index in the [[dag]] `vertices` array) logical :: checking = . false . !! used for toposort logical :: marked = . false . !! used for toposort character ( len = :), allocatable :: label !! used for diagraph character ( len = :), allocatable :: attributes !! used for diagraph contains private generic :: set_edges => set_edge_vector_vector , add_edge procedure :: set_edge_vector_vector , add_edge procedure :: remove_edge end type vertex type , public :: dag !! a directed acyclic graph (DAG). !! a collection of vertices (nodes) that are connected to other vertices. private integer ( ip ) :: n = 0 !! number of vertices (size of `vertices` array) type ( vertex ), dimension (:), allocatable :: vertices !! the vertices in the DAG. The index in !! this array if the vertex number. contains private procedure , public :: vertex => dag_get_vertex !! not very useful for now, since !! all vertex attributes are private procedure , public :: number_of_vertices => dag_get_number_of_vertices procedure , public :: set_vertices => dag_set_vertices generic , public :: set_edges => dag_set_edges_no_atts , & dag_set_edges_vector_atts procedure , public :: add_edge => dag_add_edge procedure , public :: remove_edge => dag_remove_edge procedure , public :: remove_vertex => dag_remove_node procedure , public :: set_vertex_info => dag_set_vertex_info procedure , public :: toposort => dag_toposort procedure , public :: generate_digraph => dag_generate_digraph procedure , public :: generate_dependency_matrix => dag_generate_dependency_matrix procedure , public :: save_digraph => dag_save_digraph procedure , public :: get_edges => dag_get_edges procedure , public :: get_dependencies => dag_get_dependencies procedure , public :: destroy => dag_destroy procedure :: init_internal_vars !! private routine to initialize some internal variables procedure :: dag_set_edges_no_atts , dag_set_edges_vector_atts end type dag contains !******************************************************************************* !******************************************************************************* !> ! Constructor for [[edge]] type. pure elemental function edge_constructor ( ivertex , label , attributes ) result ( e ) integer ( ip ), intent ( in ), optional :: ivertex character ( len =* ), intent ( in ), optional :: label character ( len =* ), intent ( in ), optional :: attributes type ( edge ) :: e e % ivertex = ivertex if ( present ( label )) e % label = label if ( present ( attributes )) e % attributes = attributes end function edge_constructor !******************************************************************************* !******************************************************************************* !> ! Destroy the `dag`. subroutine dag_destroy ( me ) class ( dag ), intent ( inout ) :: me me % n = 0 if ( allocated ( me % vertices )) deallocate ( me % vertices ) end subroutine dag_destroy !******************************************************************************* !******************************************************************************* !> ! specify the edge indices for this vertex subroutine set_edge_vector_vector ( me , edges , label , attributes ) class ( vertex ), intent ( inout ) :: me integer ( ip ), dimension (:), intent ( in ) :: edges character ( len =* ), dimension (:), intent ( in ), optional :: label character ( len =* ), dimension (:), intent ( in ), optional :: attributes !! other attributes when !! saving as a diagraph. integer ( ip ) :: i !! counter do i = 1 , size ( edges ) if ( present ( label ) . and . present ( attributes )) then call me % add_edge ( edges ( i ), label = label ( i ), attributes = attributes ( i )) else if (. not . present ( label ) . and . present ( attributes )) then call me % add_edge ( edges ( i ), attributes = attributes ( i )) else if ( present ( label ) . and . . not . present ( attributes )) then call me % add_edge ( edges ( i ), label = label ( i )) else call me % add_edge ( edges ( i )) end if end do end subroutine set_edge_vector_vector !******************************************************************************* !******************************************************************************* !> ! add an edge index for this vertex subroutine add_edge ( me , e , label , attributes ) class ( vertex ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: e character ( len =* ), intent ( in ), optional :: label character ( len =* ), intent ( in ), optional :: attributes !! other attributes when !! saving as a diagraph. if ( allocated ( me % edges )) then if (. not . any ( e == me % edges % ivertex )) then ! don't add if already there me % edges = [ me % edges , edge ( e , label = label , attributes = attributes )] call sort_ascending ( me % edges ) end if else me % edges = [ edge ( e , label = label , attributes = attributes )] end if end subroutine add_edge !******************************************************************************* !******************************************************************************* !> ! remove an edge index from this vertex subroutine remove_edge ( me , e ) class ( vertex ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: e integer ( ip ), dimension ( 1 ) :: idx type ( edge ), dimension (:), allocatable :: tmp if ( allocated ( me % edges )) then idx = findloc ( me % edges % ivertex , e ) if ( idx ( 1 ) > 0 ) then ! the edge is in the list associate ( i => idx ( 1 ), n => size ( me % edges )) if ( n == 1 ) then deallocate ( me % edges ) ! it's the only one there else allocate ( tmp ( n - 1 )) if ( i > 1 ) tmp ( 1 : i - 1 ) = me % edges ( 1 : i - 1 ) if ( i < n ) tmp ( i : n - 1 ) = me % edges ( i + 1 : n ) call move_alloc ( tmp , me % edges ) end if end associate end if end if end subroutine remove_edge !******************************************************************************* !******************************************************************************* !> ! Remove a node from a dag. Will also remove any edges connected to it. ! ! This will renumber the nodes and edges internally. ! Note that any default integer labels generated in ! [[dag_set_vertices]] would then be questionable. subroutine dag_remove_node ( me , ivertex ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! the node to remove integer ( ip ) :: i !! counter type ( vertex ), dimension (:), allocatable :: tmp !! for resizing `me%vertices` if ( allocated ( me % vertices )) then associate ( n => size ( me % vertices )) do i = 1 , n ! first remove any edges: call me % vertices ( i )% remove_edge ( ivertex ) ! next, renumber the existing edges so they will be ! correct after ivertex is deleted ! Example (removing 2): 1 [2] 3 4 ==> 1 2 3 if ( allocated ( me % vertices ( i )% edges )) then where ( me % vertices ( i )% edges % ivertex > ivertex ) me % vertices ( i )% edges % ivertex = me % vertices ( i )% edges % ivertex - 1 end where end if end do ! now, remove the node: allocate ( tmp ( n - 1 )) if ( ivertex > 1 ) tmp ( 1 : ivertex - 1 ) = me % vertices ( 1 : ivertex - 1 ) if ( ivertex < n ) tmp ( ivertex : n - 1 ) = me % vertices ( ivertex + 1 : n ) call move_alloc ( tmp , me % vertices ) end associate end if me % n = size ( me % vertices ) if ( me % n == 0 ) deallocate ( me % vertices ) end subroutine dag_remove_node !******************************************************************************* !******************************************************************************* !> ! get the edges for the vertex (all of the vertices ! that this vertex depends on). pure function dag_get_edges ( me , ivertex ) result ( edges ) class ( dag ), intent ( in ) :: me integer ( ip ), intent ( in ) :: ivertex integer ( ip ), dimension (:), allocatable :: edges if ( ivertex > 0 . and . ivertex <= me % n ) then edges = me % vertices ( ivertex )% edges % ivertex ! auto LHS allocation end if end function dag_get_edges !******************************************************************************* !******************************************************************************* !> ! get all the vertices that depend on this vertex. pure function dag_get_dependencies ( me , ivertex ) result ( dep ) class ( dag ), intent ( in ) :: me integer ( ip ), intent ( in ) :: ivertex integer ( ip ), dimension (:), allocatable :: dep !! the set of all vertices !! than depend on `ivertex` integer ( ip ) :: i !! vertex counter if ( ivertex > 0 . and . ivertex <= me % n ) then ! have to check all the vertices: do i = 1 , me % n if ( allocated ( me % vertices ( i )% edges )) then if ( any ( me % vertices ( i )% edges % ivertex == ivertex )) then if ( allocated ( dep )) then dep = [ dep , i ] ! auto LHS allocation else dep = [ i ] ! auto LHS allocation end if end if end if end do end if end function dag_get_dependencies !******************************************************************************* !******************************************************************************* !> ! set the number of vertices (nodes) in the dag. ! !### See also ! * [[dag_remove_node]] which can be used to remove a vertex. ! * [[dag_set_vertex_info]] which can be used to set/change ! the labels and other attributes. subroutine dag_set_vertices ( me , nvertices , labels ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: nvertices !! number of vertices character ( len =* ), dimension ( nvertices ), intent ( in ), optional :: labels !! vertex name strings integer ( ip ) :: i !! counter if ( nvertices <= 0 ) error stop 'error: nvertices must be >= 1' if ( allocated ( me % vertices )) deallocate ( me % vertices ) me % n = nvertices allocate ( me % vertices ( nvertices )) me % vertices % ivertex = [( i , i = 1 , nvertices )] if ( present ( labels )) then do i = 1 , nvertices me % vertices ( i )% label = trim ( adjustl ( labels ( i ))) end do else ! just use the vertex number do i = 1 , nvertices me % vertices ( i )% label = integer_to_string ( i ) end do end if end subroutine dag_set_vertices !******************************************************************************* !******************************************************************************* !> ! Returns the number of vertices (nodes) in the dag. pure function dag_get_number_of_vertices ( me ) result ( nvertices ) class ( dag ), intent ( in ) :: me integer ( ip ) :: nvertices !! number of vertices nvertices = me % n end function dag_get_number_of_vertices !******************************************************************************* !******************************************************************************* !> ! set info about a vertex in a dag. subroutine dag_set_vertex_info ( me , ivertex , label , attributes ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! vertex number character ( len =* ), intent ( in ), optional :: label !! if a label is not set, !! then the integer vertex !! number is used. character ( len =* ), intent ( in ), optional :: attributes !! other attributes when !! saving as a diagraph. if ( present ( label )) me % vertices ( ivertex )% label = label if ( present ( attributes )) me % vertices ( ivertex )% attributes = attributes end subroutine dag_set_vertex_info !******************************************************************************* !******************************************************************************* !> ! Get the `i`th vertex. ! ! The program will stop if vertex `i` does not exist. function dag_get_vertex ( me , i ) result ( v ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: i !! vertex number type ( vertex ) :: v if ( i < 0 . or . i > me % n ) then error stop 'Error in dag_get_vertex: invalid vertex number' else v = me % vertices ( i ) end if end function dag_get_vertex !******************************************************************************* !******************************************************************************* !> ! Add an edge to a dag. subroutine dag_add_edge ( me , ivertex , iedge , label , attributes ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! vertex number integer ( ip ), intent ( in ) :: iedge !! the vertex to connect to `ivertex` character ( len =* ), intent ( in ), optional :: label !! edge label character ( len =* ), intent ( in ), optional :: attributes !! other attributes when !! saving as a diagraph. call me % vertices ( ivertex )% set_edges ( iedge ,& label = label ,& attributes = attributes ) end subroutine dag_add_edge !******************************************************************************* !******************************************************************************* !> ! set the edges for a vertex in a dag subroutine dag_set_edges_no_atts ( me , ivertex , edges ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! vertex number integer ( ip ), dimension (:), intent ( in ) :: edges call me % vertices ( ivertex )% set_edges ( edges ) end subroutine dag_set_edges_no_atts !******************************************************************************* !******************************************************************************* !> ! Remove an edge from a dag. subroutine dag_remove_edge ( me , ivertex , iedge ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! vertex number integer ( ip ), intent ( in ) :: iedge !! the edge to remove call me % vertices ( ivertex )% remove_edge ( iedge ) end subroutine dag_remove_edge !******************************************************************************* !******************************************************************************* !> ! set the edges for a vertex in a dag subroutine dag_set_edges_vector_atts ( me , ivertex , edges , attributes , label ) class ( dag ), intent ( inout ) :: me integer ( ip ), intent ( in ) :: ivertex !! vertex number integer ( ip ), dimension (:), intent ( in ) :: edges character ( len =* ), dimension (:), intent ( in ) :: attributes !! other attributes when !! saving as a diagraph. character ( len =* ), dimension (:), intent ( in ), optional :: label call me % vertices ( ivertex )% set_edges ( edges , label = label , attributes = attributes ) end subroutine dag_set_edges_vector_atts !******************************************************************************* !******************************************************************************* !> ! Initialize the internal private variables used for graph traversal. subroutine init_internal_vars ( me ) class ( dag ), intent ( inout ) :: me integer ( ip ) :: i !! counter do i = 1 , me % n me % vertices ( i )% marked = . false . me % vertices ( i )% checking = . false . end do end subroutine init_internal_vars !******************************************************************************* !******************************************************************************* !> ! Main toposort routine subroutine dag_toposort ( me , order , istat ) class ( dag ), intent ( inout ) :: me integer ( ip ), dimension (:), allocatable , intent ( out ) :: order !! the toposort order integer ( ip ), intent ( out ) :: istat !! Status flag: !! !! * 0 if no errors !! * -1 if circular dependency !! (in this case, `order` will not be allocated) integer ( ip ) :: i , iorder if ( me % n == 0 ) return ! initialize internal variables, in case ! we have called this routine before. call me % init_internal_vars () allocate ( order ( me % n )) iorder = 0 ! index in order array istat = 0 ! no errors so far do i = 1 , me % n if (. not . me % vertices ( i )% marked ) call dfs ( me % vertices ( i )) if ( istat ==- 1 ) exit end do if ( istat ==- 1 ) deallocate ( order ) contains recursive subroutine dfs ( v ) !! depth-first graph traversal type ( vertex ), intent ( inout ) :: v integer ( ip ) :: j if ( istat ==- 1 ) return if ( v % checking ) then ! error: circular dependency istat = - 1 else if (. not . v % marked ) then v % checking = . true . if ( allocated ( v % edges )) then do j = 1 , size ( v % edges ) call dfs ( me % vertices ( v % edges ( j )% ivertex )) if ( istat ==- 1 ) return end do end if v % checking = . false . v % marked = . true . iorder = iorder + 1 order ( iorder ) = v % ivertex end if end if end subroutine dfs end subroutine dag_toposort !******************************************************************************* !******************************************************************************* !> ! Generate a Graphviz digraph structure for the DAG. ! !### Example ! * To convert this to a PDF using `dot`: `dot -Tpdf -o test.pdf test.dot`, ! where `test.dot` is `str` written to a file. function dag_generate_digraph ( me , rankdir , dpi ) result ( str ) class ( dag ), intent ( in ) :: me character ( len = :), allocatable :: str character ( len =* ), intent ( in ), optional :: rankdir !! right to left orientation (e.g. 'RL') integer ( ip ), intent ( in ), optional :: dpi !! resolution (e.g. 300) integer ( ip ) :: i , j !! counter integer ( ip ) :: n_edges !! number of edges character ( len = :), allocatable :: attributes !! full attributes string for node or edge logical :: compress !! if we can write all the edges on one line character ( len =* ), parameter :: tab = ' ' !! for indenting character ( len =* ), parameter :: newline = new_line ( ' ' ) !! line break character if ( me % n == 0 ) return str = 'digraph G {' // newline // newline if ( present ( rankdir )) & str = str // tab // 'rankdir=' // rankdir // newline // newline if ( present ( dpi )) & str = str // tab // 'graph [ dpi = ' // integer_to_string ( dpi ) // ' ]' // newline // newline ! define the vertices: do i = 1 , me % n attributes = get_attributes_string ( me % vertices ( i )% label , & me % vertices ( i )% attributes ) str = str // tab // integer_to_string ( i ) // ' ' // attributes // newline if ( i == me % n ) str = str // newline end do ! define the dependencies: do i = 1 , me % n if ( allocated ( me % vertices ( i )% edges )) then n_edges = size ( me % vertices ( i )% edges ) ! if none of the edges have attributes, ! then we can write them all on one line ! otherwise, write them line by line compress = . true . do j = 1 , n_edges if ( allocated ( me % vertices ( i )% edges ( j )% label ) . or . & allocated ( me % vertices ( i )% edges ( j )% attributes )) then compress = . false . exit end if end do if (. not . compress ) then ! Example: 1 -> 2 [penwidth=2, arrowhead=none] do j = 1 , n_edges attributes = get_attributes_string ( me % vertices ( i )% edges ( j )% label , & me % vertices ( i )% edges ( j )% attributes ) str = str // tab // integer_to_string ( i ) // ' -> ' // & integer_to_string ( me % vertices ( i )% edges ( j )% ivertex ) // ' ' // attributes // newline end do else ! Example: 1 -> 2,5,10 str = str // tab // integer_to_string ( i ) // merge ( ' -> ' , ' ' , n_edges /= 0 ) do j = 1 , n_edges ! comma-separated list: str = str // integer_to_string ( me % vertices ( i )% edges ( j )% ivertex ) if ( n_edges > 1 . and . j < n_edges ) str = str // ',' end do str = str // ';' // newline end if end if end do str = str // newline // '}' contains function get_attributes_string ( label , attributes ) result ( str ) !! create the full attributes string for an edge or node. character ( len = :), allocatable , intent ( in ) :: label !! if not allocated or blank, then not used character ( len = :), allocatable , intent ( in ) :: attributes !! if not allocated or blank, then not used character ( len = :), allocatable :: str !! the attributes string, enclosed in brackets character ( len = :), allocatable :: tmp_label logical :: has_label , has_attributes has_label = allocated ( label ) if ( has_label ) has_label = label /= '' if ( has_label ) tmp_label = 'label=\"' // trim ( adjustl ( label )) // '\"' has_attributes = allocated ( attributes ) if ( has_attributes ) has_attributes = attributes /= '' if ( has_label . and . has_attributes ) then str = '[' // trim ( adjustl ( attributes )) // ',' // tmp_label // ']' elseif ( has_label . and . . not . has_attributes ) then str = '[' // tmp_label // ']' elseif (. not . has_label . and . has_attributes ) then str = '[' // trim ( adjustl ( attributes )) // ']' else ! neither str = '' end if end function get_attributes_string end function dag_generate_digraph !******************************************************************************* !******************************************************************************* !> ! Generate the dependency matrix for the DAG. ! ! This is an n \\times n matrix with elements A_{ij}, ! such that A_{ij} is true if vertex i depends on vertex j. subroutine dag_generate_dependency_matrix ( me , mat ) class ( dag ), intent ( in ) :: me logical , dimension (:,:), intent ( out ), allocatable :: mat !! dependency matrix integer ( ip ) :: i !! vertex counter integer ( ip ) :: j !! edge counter if ( me % n > 0 ) then allocate ( mat ( me % n , me % n )) mat = . false . do i = 1 , me % n if ( allocated ( me % vertices ( i )% edges )) then do j = 1 , size ( me % vertices ( i )% edges ) mat ( i , me % vertices ( i )% edges ( j )% ivertex ) = . true . end do end if end do end if end subroutine dag_generate_dependency_matrix !******************************************************************************* !******************************************************************************* !> ! Generate a Graphviz digraph structure for the DAG and write it to a file. subroutine dag_save_digraph ( me , filename , rankdir , dpi ) class ( dag ), intent ( in ) :: me character ( len =* ), intent ( in ), optional :: filename !! file name for diagraph character ( len =* ), intent ( in ), optional :: rankdir !! right to left orientation (e.g. 'RL') integer ( ip ), intent ( in ), optional :: dpi !! resolution (e.g. 300) integer ( ip ) :: iunit , istat character ( len = :), allocatable :: diagraph diagraph = me % generate_digraph ( rankdir , dpi ) open ( newunit = iunit , file = filename , status = 'REPLACE' , iostat = istat ) if ( istat == 0 ) then write ( iunit , fmt = '(A)' , iostat = istat ) diagraph else write ( * , * ) 'error opening ' // trim ( filename ) end if close ( iunit , iostat = istat ) end subroutine dag_save_digraph !******************************************************************************* !******************************************************************************* !> ! Integer to allocatable string. pure function integer_to_string ( i ) result ( s ) integer ( ip ), intent ( in ) :: i character ( len = :), allocatable :: s integer ( ip ) :: istat allocate ( character ( len = MAX_INT_STR_LEN ) :: s ) ! should be big enough write ( s , fmt = '(ss,I0)' , iostat = istat ) i if ( istat == 0 ) then s = trim ( adjustl ( s )) else s = '***' end if end function integer_to_string !******************************************************************************* !******************************************************************************* !> ! Return only the unique values from `vec`. ! The result is also sorted by ascending value. function unique ( vec ) result ( vec_unique ) type ( edge ), dimension (:), intent ( in ) :: vec type ( edge ), dimension (:), allocatable :: vec_unique !! only the unique elements of `vec` integer ( ip ) :: i !! counter integer ( ip ) :: n !! size of `vec` logical , dimension (:), allocatable :: mask !! for flagging the unique values n = size ( vec ) vec_unique = vec ! make a copy if ( n <= 1 ) return ! get the unique elements by sorting the array ! and then excluding any that are the same as the previous element. call sort_ascending ( vec_unique ) allocate ( mask ( n )); mask ( 1 ) = . true . do i = 2 , n mask ( i ) = ( vec_unique ( i )% ivertex /= vec_unique ( i - 1 )% ivertex ) end do vec_unique = pack ( vec_unique , mask ) end function unique !******************************************************************************* !******************************************************************************* !> ! Sorts an [[edge]] array `ivec` in increasing order by vertex number. ! Uses a basic recursive quicksort ! (with insertion sort for partitions with \\le 20 elements). subroutine sort_ascending ( ivec ) type ( edge ), dimension (:), intent ( inout ) :: ivec integer ( ip ), parameter :: max_size_for_insertion_sort = 20_ip !! max size for using insertion sort. call quicksort ( 1_ip , size ( ivec , kind = ip )) contains recursive subroutine quicksort ( ilow , ihigh ) !! Sort the array integer ( ip ), intent ( in ) :: ilow integer ( ip ), intent ( in ) :: ihigh integer ( ip ) :: ipivot !! pivot element integer ( ip ) :: i !! counter integer ( ip ) :: j !! counter if ( ihigh - ilow <= max_size_for_insertion_sort . and . ihigh > ilow ) then ! do insertion sort: do i = ilow + 1 , ihigh do j = i , ilow + 1 , - 1 if ( ivec ( j )% ivertex < ivec ( j - 1 )% ivertex ) then call swap ( ivec ( j ), ivec ( j - 1 )) else exit end if end do end do elseif ( ihigh - ilow > max_size_for_insertion_sort ) then ! do the normal quicksort: call partition ( ilow , ihigh , ipivot ) call quicksort ( ilow , ipivot - 1_ip ) call quicksort ( ipivot + 1_ip , ihigh ) end if end subroutine quicksort subroutine partition ( ilow , ihigh , ipivot ) !! Partition the array, based on the !! lexical ivecing comparison. integer ( ip ), intent ( in ) :: ilow integer ( ip ), intent ( in ) :: ihigh integer ( ip ), intent ( out ) :: ipivot integer ( ip ) :: i , ii call swap ( ivec ( ilow ), ivec (( ilow + ihigh ) / 2 )) ii = ilow do i = ilow + 1 , ihigh if ( ivec ( i )% ivertex < ivec ( ilow )% ivertex ) then ii = ii + 1 call swap ( ivec ( ii ), ivec ( i )) end if end do call swap ( ivec ( ilow ), ivec ( ii )) ipivot = ii end subroutine partition end subroutine sort_ascending !******************************************************************************* !******************************************************************************* !> ! Swap two [[edge]] values. pure elemental subroutine swap ( i1 , i2 ) type ( edge ), intent ( inout ) :: i1 type ( edge ), intent ( inout ) :: i2 type ( edge ) :: tmp tmp = i1 i1 = i2 i2 = tmp end subroutine swap !******************************************************************************* !******************************************************************************* end module dag_module !*******************************************************************************","tags":"","loc":"sourcefile/dag_module.f90.html"}]} \ No newline at end of file diff --git a/type/dag.html b/type/dag.html index fa8e36c..ff9dc72 100644 --- a/type/dag.html +++ b/type/dag.html @@ -71,7 +71,7 @@

    dag
  • 23 statements + title="

    52.2% of total for derived types.

    Including implementation: 301 statements, 80.7% of total for derived types.">24 statements
  • @@ -143,6 +143,7 @@

    Type-Bound Procedures

    number_of_vertices set_vertices set_edges + add_edge remove_edge remove_vertex set_vertex_info @@ -743,6 +744,121 @@

    Arguments

    +
    • + + + + +
    +
    +
    + +

    + procedure, public :: + add_edge => dag_add_edge + +

    +
    +
      +
    • +

      + private subroutine dag_add_edge(me, ivertex, iedge, label, attributes) +

      + + +

      Add an edge to a dag.

      + +

      Arguments

      + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
      TypeIntentOptional AttributesName
      + + class(dag), + intent(inout) + + ::me + +
      + + integer(kind=ip), + intent(in) + + ::ivertex +

      vertex number

      +
      + + integer(kind=ip), + intent(in) + + ::iedge +

      the vertex to connect to ivertex

      +
      + + character(len=*), + intent(in),optional + + ::label +

      edge label

      +
      + + character(len=*), + intent(in),optional + + ::attributes +

      other attributes when +saving as a diagraph.

      +
      + +
    @@ -1825,6 +1941,7 @@

    Source Code

    procedure,public :: set_vertices => dag_set_vertices generic,public :: set_edges => dag_set_edges_no_atts, & dag_set_edges_vector_atts + procedure,public :: add_edge => dag_add_edge procedure,public :: remove_edge => dag_remove_edge procedure,public :: remove_vertex => dag_remove_node procedure,public :: set_vertex_info => dag_set_vertex_info diff --git a/type/edge.html b/type/edge.html index 54c5889..7a06a16 100644 --- a/type/edge.html +++ b/type/edge.html @@ -71,7 +71,7 @@

    edge
  • 8 statements + title="

    17.4% of total for derived types.

    Including implementation: 5 statements, 1.3% of total for derived types.">8 statements
  • @@ -373,7 +373,7 @@

    Arguments

    - + integer(kind=ip), intent(in), @@ -388,7 +388,7 @@

    Arguments

    - + character(len=*), intent(in), @@ -403,7 +403,7 @@

    Arguments

    - + character(len=*), intent(in), diff --git a/type/vertex.html b/type/vertex.html index 590f749..c1a065f 100644 --- a/type/vertex.html +++ b/type/vertex.html @@ -71,7 +71,7 @@

    vertex
  • 14 statements + title="

    30.4% of total for derived types.

    Including implementation: 67 statements, 18.0% of total for derived types.">14 statements