Line data    Source code

       1             : module ll_mod
       2             :   implicit none
       3             :   private
       4             :   type :: node_t
       5             :      integer :: id
       6             :      integer :: Src,Dest
       7             :      type(node_t), pointer :: prev => NULL()
       8             :      type(node_t), pointer :: next => NULL()
       9             :   end type node_t
      10             : 
      11             :   type :: root_t
      12             :      integer     :: number
      13             :      type(node_t), pointer :: first => NULL()
      14             :   end type root_t
      15             :   public :: node_t, root_t
      16             :   integer, public :: NumEdges
      17             : 
      18             :   public :: PrintEdgeList
      19             :   public :: LLAddEdge,LLFindEdge, LLInsertEdge
      20             :   public :: LLSetEdgeCount,LLGetEdgeCount
      21             :   public :: LLFree
      22             : 
      23             : contains
      24             : 
      25        1536 :   subroutine LLSetEdgeCount(value)
      26             :     implicit none
      27             :     integer,intent(in)   :: value
      28        1536 :     NumEdges=value
      29        1536 :   end subroutine LLSetEdgeCount
      30             : 
      31        1536 :   subroutine LLGetEdgeCount(value)
      32             :     implicit none
      33             :     integer,intent(out)  :: value
      34        1536 :     value=NumEdges
      35        1536 :   end subroutine LLGetEdgeCount
      36             : 
      37           0 :   subroutine PrintEdgeList(EdgeList)
      38             : 
      39             :     type(root_t) :: EdgeList(:)
      40             :     type(node_t), pointer :: temp_node
      41             :     integer :: nlist, i
      42           0 :     nlist = SIZE(EdgeList)
      43             : 
      44           0 :     do i=1,nlist
      45           0 :        temp_node => EdgeList(i)%first
      46           0 :        do while(associated(temp_node))
      47           0 :           print *,'Vertex: ',EdgeList(i)%number ,temp_node%Src,'->' ,temp_node%dest, '(',temp_node%id,')'
      48           0 :           temp_node => temp_node%next
      49             :        enddo
      50             :     enddo
      51             : 
      52           0 :   end subroutine PrintEdgeList
      53             : 
      54        1536 :   subroutine LLFree(List)
      55             : 
      56             :     implicit none
      57             :     type(root_t) :: List
      58             :     type(node_t), pointer :: temp_node
      59             :     integer :: nlist,i
      60             : 
      61             : 
      62        1536 :     temp_node => List%first
      63        1536 :     if (associated(temp_node)) then
      64             :       ! Find the end of the list
      65       21320 :       do while(associated(temp_node%next))
      66        1536 :         temp_node => temp_node%next
      67             :       end do
      68             : 
      69        1536 :       temp_node => temp_node%prev
      70             :       !Now step back and deallocate all entries
      71       21320 :       do while(associated(temp_node))
      72       19784 :         deallocate(temp_node%next)
      73       19784 :         temp_node => temp_node%prev
      74             :       end do
      75             :     end if
      76             : 
      77        1536 :   end subroutine LLFree
      78             : 
      79      134168 :   subroutine LLInsertEdge(EdgeList,src,dest,eNum)
      80             :     type (root_t), intent(inout) :: EdgeList
      81             :     integer, intent(in) :: src,dest
      82             :     integer, intent(out) :: eNum
      83             :     logical :: found
      84             : 
      85      134168 :     call LLFindEdge(EdgeList,src,dest,eNum,found)
      86      134168 :     if(.not. found) then
      87       21320 :        call LLAddEdge(EdgeList,src,dest,eNum)
      88             :     endif
      89             : 
      90      134168 :   end subroutine LLInsertEdge
      91             : 
      92   132770840 :   subroutine LLFindEdge(Edge,src,dest,id,found)
      93             : 
      94             :     type (root_t), intent(in) :: Edge
      95             :     integer, intent(in)  :: src,dest
      96             :     integer, intent(out) :: id
      97             :     logical, intent(out) :: found
      98             : 
      99             :     type (node_t), pointer :: temp_node
     100             : 
     101   132770840 :     found =.FALSE.
     102             : 
     103   132770840 :     temp_node => Edge%first
     104  1972765522 :     do while(associated(temp_node) .and. (.not. found))
     105  1972765522 :        if((dest .eq. temp_node%dest) .and. (src .eq. temp_node%Src) ) then
     106      381184 :           found = .TRUE.
     107      381184 :           id=temp_node%id
     108             :        else
     109  1839613498 :           temp_node => temp_node%next
     110             :        endif
     111             :     enddo
     112   132770840 :   end subroutine LLFindEdge
     113             : 
     114       21320 :   subroutine LLAddEdge(EdgeList,src,dest,id)
     115             :     type (root_t), intent(inout) :: EdgeList
     116             :     integer, intent(in)  :: src
     117             :     integer, intent(in)  :: dest
     118             :     integer, intent(out)  :: id
     119             : 
     120             :     type(node_t), pointer :: temp_node
     121             :     type(node_t), pointer  :: new_node
     122             :     type(node_t), pointer :: parent
     123             : 
     124       21320 :     temp_node => EdgeList%first
     125       21320 :     parent    => EdgeList%first
     126             : 
     127      162420 :     do while(associated(temp_node))
     128      141100 :        parent => temp_node
     129      141100 :        temp_node => parent%next
     130             :     enddo
     131       21320 :     allocate(new_node)
     132       21320 :     NumEdges = NumEdges + 1
     133             : 
     134       21320 :     new_node%src=src
     135       21320 :     new_node%dest=dest
     136       21320 :     new_node%id=NumEdges
     137             :     NULLIFY(new_node%next)
     138       21320 :     new_node%prev => parent
     139             : 
     140       21320 :     if(associated(EdgeList%first)) then
     141       19784 :        parent%next => new_node
     142             :     else
     143        1536 :        EdgeList%first => new_node
     144             :     endif
     145       21320 :     id = NumEdges
     146             : 
     147       21320 :   end subroutine LLAddEdge
     148             : 
     149           0 : end module ll_mod