dag_module Module Reference

Data Types
type	vertex
type	dag

Functions/Subroutines
subroutine	dag_destroy (me)
subroutine	set_edge_vector (me, edges)
subroutine	add_edge (me, edge)
pure integer function, dimension(:), allocatable	dag_get_edges (me, ivertex)
pure integer function, dimension(:), allocatable	dag_get_dependencies (me, ivertex)
subroutine	dag_set_vertices (me, nvertices)
subroutine	dag_set_vertex_info (me, ivertex, label, attributes)
subroutine	dag_set_edges (me, ivertex, edges)
subroutine	dag_toposort (me, order, istat)
character(len=:) function, allocatable	dag_generate_digraph (me, rankdir, dpi, edge)
subroutine	dag_generate_dependency_matrix (me, mat)
subroutine	dag_save_digraph (me, filename, rankdir, dpi, edge)
pure character(len=:) function, allocatable	integer_to_string (i)

Function/Subroutine Documentation

add_edge()

subroutine dag_module::add_edge ( class(vertex), intent(inout)  me, integer, intent(in)  edge  )

private

Definition at line 88 of file dag_module.f90.

 
    class(vertex),intent(inout) :: me
    integer,intent(in) :: edge
 
    if (allocated(me%edges)) then
        if (.not. any(edge==me%edges)) then
            me%edges = [me%edges, edge]  ! auto lhs reallocation
        end if
    else
        allocate(me%edges(1))
        me%edges = [edge]
    end if
 

Here is the caller graph for this function:

dag_destroy()

subroutine dag_module::dag_destroy

(

class(dag), intent(inout)

me

)

Definition at line 51 of file dag_module.f90.

 
    class(dag),intent(inout) :: me
 
    me%n = 0
    if (allocated(me%vertices)) deallocate(me%vertices)
 

dag_generate_dependency_matrix()

subroutine dag_module::dag_generate_dependency_matrix ( class(dag), intent(in)  me, logical, dimension(:,:), intent(out), allocatable  mat  )

private

Definition at line 365 of file dag_module.f90.

 
    implicit none
 
    class(dag),intent(in) :: me
    logical,dimension(:,:),intent(out),allocatable :: mat !! dependency matrix
 
    integer :: i !! vertex 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
                mat(i,me%vertices(i)%edges) = .true.
            end if
        end do
 
    end if
 

dag_generate_digraph()

character(len=:) function, allocatable dag_module::dag_generate_digraph ( class(dag), intent(in)  me, character(len=*), intent(in), optional  rankdir, integer, intent(in), optional  dpi, character(len=*), intent(in), optional  edge  )

private

Definition at line 293 of file dag_module.f90.

 
    implicit none
 
    class(dag),intent(in) :: me
    character(len=:),allocatable :: str
    character(len=*),intent(in),optional :: rankdir !! right to left orientation (e.g. 'RL')
    integer,intent(in),optional :: dpi !! resolution (e.g. 300)
    character(len=*),intent(in),optional :: edge !! right to left orientation (e.g. 'forward' or 'back)
 
    integer :: i,j     !! counter
    integer :: n_edges !! number of edges
    character(len=:),allocatable :: attributes,label
    logical :: has_label, has_attributes
 
    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 (present(edge)) &
        str = str//tab//'edge [ dir = "'//trim(adjustl(edge))//'" ]'//newline//newline
 
    ! define the vertices:
    do i=1,me%n
        has_label      = allocated(me%vertices(i)%label)
        has_attributes = allocated(me%vertices(i)%attributes)
        if (has_label) label = 'label="'//trim(adjustl(me%vertices(i)%label))//'"'
        if (has_label .and. has_attributes) then
            attributes = '['//trim(adjustl(me%vertices(i)%attributes))//','//label//']'
        elseif (has_label .and. .not. has_attributes) then
            attributes = '['//label//']'
        elseif (.not. has_label .and. has_attributes) then
            attributes = '['//trim(adjustl(me%vertices(i)%attributes))//']'
        else ! neither
            attributes = ''
        end if
        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)
            str = str//tab//integer_to_string(i)//' -> '
            do j=1,n_edges
                ! comma-separated list:
                str = str//integer_to_string(me%vertices(i)%edges(j))
                if (n_edges>1 .and. j<n_edges) str = str//','
            end do
            str = str//';'//newline
        end if
    end do
 
    str = str//newline//'}'
 

Here is the call graph for this function:

dag_get_dependencies()

pure integer function, dimension(:), allocatable dag_module::dag_get_dependencies ( class(dag), intent(in)  me, integer, intent(in)  ivertex  )

private

Definition at line 129 of file dag_module.f90.

 
    implicit none
 
    class(dag),intent(in) :: me
    integer,intent(in) :: ivertex
    integer,dimension(:),allocatable :: dep  !! the set of all vertices
                                             !! than depend on `ivertex`
 
    integer :: 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)) 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
 

dag_get_edges()

pure integer function, dimension(:), allocatable dag_module::dag_get_edges ( class(dag), intent(in)  me, integer, intent(in)  ivertex  )

private

Definition at line 110 of file dag_module.f90.

 
    implicit none
 
    class(dag),intent(in) :: me
    integer,intent(in) :: ivertex
    integer,dimension(:),allocatable :: edges
 
    if (ivertex>0 .and. ivertex <= me%n) then
        edges = me%vertices(ivertex)%edges  ! auto LHS allocation
    end if
 

dag_save_digraph()

subroutine dag_module::dag_save_digraph ( class(dag), intent(in)  me, character(len=*), intent(in), optional  filename, character(len=*), intent(in), optional  rankdir, integer, intent(in), optional  dpi, character(len=*), intent(in), optional  edge  )

private

Definition at line 394 of file dag_module.f90.

 
    implicit none
 
    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,intent(in),optional :: dpi !! resolution (e.g. 300)
    character(len=*),intent(in),optional :: edge !! right to left orientation (e.g. 'forward' or 'back)
 
    integer :: iunit, istat
    character(len=:),allocatable :: diagraph
 
    diagraph = me%generate_digraph(rankdir,dpi,edge)
 
    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)
 

dag_set_edges()

subroutine dag_module::dag_set_edges ( class(dag), intent(inout)  me, integer, intent(in)  ivertex, integer, dimension(:), intent(in)  edges  )

private

Definition at line 210 of file dag_module.f90.

 
    class(dag),intent(inout)        :: me
    integer,intent(in)              :: ivertex !! vertex number
    integer,dimension(:),intent(in) :: edges
 
    call me%vertices(ivertex)%set_edges(edges)
 

dag_set_vertex_info()

subroutine dag_module::dag_set_vertex_info ( class(dag), intent(inout)  me, integer, intent(in)  ivertex, character(len=*), intent(in), optional  label, character(len=*), intent(in), optional  attributes  )

private

Definition at line 182 of file dag_module.f90.

 
    class(dag),intent(inout) :: me
    integer,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)) then
        me%vertices(ivertex)%label = label
    else
        ! just use the vertex number
        me%vertices(ivertex)%label = integer_to_string(ivertex)
    end if
 
    if (present(attributes)) then
        me%vertices(ivertex)%attributes = attributes
    end if
 

Here is the call graph for this function:

dag_set_vertices()

subroutine dag_module::dag_set_vertices ( class(dag), intent(inout)  me, integer, intent(in)  nvertices  )

private

Definition at line 164 of file dag_module.f90.

 
    class(dag),intent(inout) :: me
    integer,intent(in)       :: nvertices !! number of vertices
 
    integer :: i
 
    me%n = nvertices
    allocate(me%vertices(nvertices))
    me%vertices%ivertex = [(i,i=1,nvertices)]
 

dag_toposort()

subroutine dag_module::dag_toposort ( class(dag), intent(inout)  me, integer, dimension(:), intent(out), allocatable  order, integer, intent(out)  istat  )

private

Definition at line 225 of file dag_module.f90.

 
    class(dag),intent(inout) :: me
    integer,dimension(:),allocatable,intent(out) :: order  !! the toposort order
    integer,intent(out) :: istat !! Status flag:
                                 !!
                                 !! * 0 if no errors
                                 !! * -1 if circular dependency
                                 !!  (in this case, `order` will not be allocated)
 
    integer :: i,iorder
 
    if (me%n==0) return
 
    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 :: 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)))
            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
 

Here is the call graph for this function:

integer_to_string()

pure character(len=:) function, allocatable dag_module::integer_to_string ( integer, intent(in)  i )

private

Definition at line 426 of file dag_module.f90.

 
    implicit none
 
    integer,intent(in) :: i
    character(len=:),allocatable :: s
 
    integer :: istat
 
    allocate( character(len=64) :: 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
 

Here is the caller graph for this function:

set_edge_vector()

subroutine dag_module::set_edge_vector ( class(vertex), intent(inout)  me, integer, dimension(:), intent(in)  edges  )

private

Definition at line 65 of file dag_module.f90.

 
    class(vertex),intent(inout)     :: me
    integer,dimension(:),intent(in) :: edges
 
    integer :: i !! counter
 
    if (allocated(me%edges)) then
        do i=1,size(edges)
            call me%add_edge(edges(i))
        end do
    else
        allocate(me%edges(size(edges)))  ! note: not checking for uniqueness here.
        me%edges = edges
    end if
 

Here is the caller graph for this function: