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 2304 : subroutine LLSetEdgeCount(value)
26 : implicit none
27 : integer,intent(in) :: value
28 2304 : NumEdges=value
29 2304 : end subroutine LLSetEdgeCount
30 :
31 2304 : subroutine LLGetEdgeCount(value)
32 : implicit none
33 : integer,intent(out) :: value
34 2304 : value=NumEdges
35 2304 : 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 2304 : 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 2304 : temp_node => List%first
63 2304 : if (associated(temp_node)) then
64 : ! Find the end of the list
65 31980 : do while(associated(temp_node%next))
66 2304 : temp_node => temp_node%next
67 : end do
68 :
69 2304 : temp_node => temp_node%prev
70 : !Now step back and deallocate all entries
71 31980 : do while(associated(temp_node))
72 29676 : deallocate(temp_node%next)
73 29676 : temp_node => temp_node%prev
74 : end do
75 : end if
76 :
77 2304 : end subroutine LLFree
78 :
79 201252 : 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 201252 : call LLFindEdge(EdgeList,src,dest,eNum,found)
86 201252 : if(.not. found) then
87 31980 : call LLAddEdge(EdgeList,src,dest,eNum)
88 : endif
89 :
90 201252 : end subroutine LLInsertEdge
91 :
92 199156260 : 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 199156260 : found =.FALSE.
102 :
103 199156260 : temp_node => Edge%first
104 2959148283 : do while(associated(temp_node) .and. (.not. found))
105 2959148283 : if((dest .eq. temp_node%dest) .and. (src .eq. temp_node%Src) ) then
106 571776 : found = .TRUE.
107 571776 : id=temp_node%id
108 : else
109 2759420247 : temp_node => temp_node%next
110 : endif
111 : enddo
112 199156260 : end subroutine LLFindEdge
113 :
114 31980 : 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 31980 : temp_node => EdgeList%first
125 31980 : parent => EdgeList%first
126 :
127 243630 : do while(associated(temp_node))
128 211650 : parent => temp_node
129 211650 : temp_node => parent%next
130 : enddo
131 31980 : allocate(new_node)
132 31980 : NumEdges = NumEdges + 1
133 :
134 31980 : new_node%src=src
135 31980 : new_node%dest=dest
136 31980 : new_node%id=NumEdges
137 : NULLIFY(new_node%next)
138 31980 : new_node%prev => parent
139 :
140 31980 : if(associated(EdgeList%first)) then
141 29676 : parent%next => new_node
142 : else
143 2304 : EdgeList%first => new_node
144 : endif
145 31980 : id = NumEdges
146 :
147 31980 : end subroutine LLAddEdge
148 :
149 0 : end module ll_mod
|