File: compmat.f

package info (click to toggle)
scilab 4.0-12
  • links: PTS
  • area: non-free
  • in suites: etch, etch-m68k
  • size: 100,640 kB
  • ctags: 57,333
  • sloc: ansic: 377,889; fortran: 242,862; xml: 179,819; tcl: 42,062; sh: 10,593; ml: 9,441; makefile: 4,377; cpp: 1,354; java: 621; csh: 260; yacc: 247; perl: 130; lex: 126; asm: 72; lisp: 30
file content (193 lines) | stat: -rw-r--r-- 5,077 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
      subroutine ta2lpd(tail,head,ma,n,lp,la,ls)
c
c     ta2lpd computes the adjacency vectors lp, la and ls
c            from vectors tail and head for a directed graph
c     NO CHECKING IS MADE on tail, head and n
c     input: tail(ma) = tail nodes
c            head(ma) = head nodes
c            ma = number of edges
c            n = number of nodes
c     output: lp(n+1) = pointer vector
c             la(ma) = vector of arcs
c             ls(ma) = vector of corresponding head nodes
c
      integer tail(ma),head(ma),ma,n
      integer lp(*),la(ma),ls(ma)
c
      integer iarc,inode
c
c     first computation of lp
c     lp(i+1) = number of tail nodes
c             = number of arcs with tail node i+1
c
      do 1,inode=1,n+1
         lp(inode)=0
 1    continue
      do 2,iarc=1,ma
         lp(tail(iarc)+1)=lp(tail(iarc)+1)+1
 2    continue
c
c     second computation of lp
c     lp(i) = pointer to the first arc
c             with tail i in sorted tail
c
      lp(1)=1
      do 3,inode=2,n
         lp(inode)=lp(inode-1)+lp(inode)
 3    continue
c
c     computation of la and ls
c
      do 4,iarc=1,ma
         inode=tail(iarc)
         la(lp(inode))=iarc
         ls(lp(inode))=head(iarc)
         lp(inode)=lp(inode)+1
 4    continue
c
c     last computation of lp
c
      do 5,inode=n,1,-1
         lp(inode+1)=lp(inode)
 5    continue
      lp(1)=1
      end
c
      subroutine ta2lpu(tail,head,ma,n,lp,la,ls)
c
c     ta2lpu computes the adjacency vectors lp, la and ls
c            from vectors tail and head for an undirected graph
c     NO CHECKING IS MADE on tail, head and n
c     input: tail(ma) = tail nodes
c            head(ma) = head nodes
c            ma = number of edges
c            n = number of nodes
c     output: lp(n+1) = pointer vector
c             la(m) = vector of arcs (m=2*ma)
c             ls(m) = vector of corresponding head nodes
c
      integer tail(ma),head(ma),ma,n
      integer lp(*),la(*),ls(*)
c
      integer iarc,inode
c
c     first computation of lp
c     lp(i+1) = number of tail nodes
c             = number of arcs with tail node i+1
c
      do 1,inode=1,n+1
         lp(inode)=0
 1    continue
      do 2,iarc=1,ma
         lp(tail(iarc)+1)=lp(tail(iarc)+1)+1
         lp(head(iarc)+1)=lp(head(iarc)+1)+1
 2    continue
c
c     second computation of lp
c     lp(i) = pointer to the first arc
c             with tail i in sorted (tail,head)
c
      lp(1)=1
      do 3,inode=2,n
         lp(inode)=lp(inode-1)+lp(inode)
 3    continue
c
c     computation of la and ls
c
      do 4,iarc=1,ma
         inode=tail(iarc)
         la(lp(inode))=iarc
         ls(lp(inode))=head(iarc)
         lp(inode)=lp(inode)+1
         inode=head(iarc)
         la(lp(inode))=iarc
         ls(lp(inode))=tail(iarc)
         lp(inode)=lp(inode)+1
 4    continue
c
c     last computation of lp
c
      do 5,inode=n,1,-1
         lp(inode+1)=lp(inode)
 5    continue
      lp(1)=1
      end
c
      subroutine lp2tad(lp,la,ls,n,tail,head)
c
c     lp2tad computes the vectors tail and head
c            from the adjacency vectors lp, la and ls 
c            for a directed graph
c     NO CHECKING IS MADE on lp, la, ls and n
c     input: lp(n+1) = pointer vector
c            la(ma) = vector of arcs
c            ls(ma) = vector of corresponding head nodes
c            n = number of nodes
c     output: tail(ma) = tail nodes
c             head(ma) = head nodes
c
      integer lp(*),la(*),ls(*),n
      integer tail(*),head(*)
c
      do 1 inod=1,n
         do 2 ip=lp(inod),lp(inod+1)-1
            tail(la(ip))=inod
            head(la(ip))=ls(ip)
 2       continue
 1    continue
      end
c
      subroutine lp2tau(lp,la,ls,n,tail,head)
c
c     lp2tad computes the vectors tail and head
c            from the adjacency vectors lp, la and ls 
c            for an undirected graph
c     NO CHECKING IS MADE on lp, la, ls and n
c     input: lp(n+1) = pointer vector
c            la(ma) = vector of arcs
c            ls(ma) = vector of corresponding head nodes
c            n = number of nodes
c     output: tail(ma) = tail nodes
c             head(ma) = head nodes
c
c
      integer lp(*),la(*),ls(*),n
      integer tail(*),head(*)
c
      integer iarc
c
      do 1,inod=1,n
         do 2,ip=lp(inod),lp(inod+1)-1
            iarc=(la(ip)+1)/2
            tail(iarc)=inod
            head(iarc)=ls(ip)
 2       continue
 1    continue
      end
c
      subroutine findiso(tail,head,ma,n,v)
c
c     findiso finds isolated nodes from tail and head description 
c             of a graph
c     NO CHECKING IS MADE on tail, head and n
c     input: tail(ma) = tail nodes
c            head(ma) = head nodes
c            ma = number of edges
c            n = number of nodes
c     output: v(n) = vector of isolated nodes v(i)=1 is i 
c                    is the number of an isolated node, 0
c                    otherwise
c
      integer tail(ma),head(ma),ma,n,v(n)
c
      integer iarc,inode
c
      do 1,inode=1,n
         v(inode)=0
 1    continue
      do 2,iarc=1,ma
         v(tail(iarc))=1
         v(head(iarc))=1
 2    continue
      end