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
|
subroutine mdi
* (n, ia,ja, max,v,l, head,last,next, mark,tag, flag)
clll. optimize
c***********************************************************************
c mdi -- initialization
c***********************************************************************
integer ia(1), ja(1), v(1), l(1), head(1), last(1), next(1),
* mark(1), tag, flag, sfs, vi,dvi, vj
c
c----initialize degrees, element lists, and degree lists
do 1 vi=1,n
mark(vi) = 1
l(vi) = 0
1 head(vi) = 0
sfs = n+1
c
c----create nonzero structure
c----for each nonzero entry a(vi,vj)
do 6 vi=1,n
jmin = ia(vi)
jmax = ia(vi+1) - 1
if (jmin.gt.jmax) go to 6
do 5 j=jmin,jmax
vj = ja(j)
if (vj.lt.vi) go to 2
if (vj.eq.vi) go to 5
go to 4
c
c------if a(vi,vj) is in strict lower triangle
c------check for previous occurrence of a(vj,vi)
2 lvk = vi
kmax = mark(vi) - 1
if (kmax .eq. 0) go to 4
do 3 k=1,kmax
lvk = l(lvk)
if (v(lvk).eq.vj) go to 5
3 continue
c----for unentered entries a(vi,vj)
4 if (sfs.ge.max) go to 101
c
c------enter vj in element list for vi
mark(vi) = mark(vi) + 1
v(sfs) = vj
l(sfs) = l(vi)
l(vi) = sfs
sfs = sfs+1
c
c------enter vi in element list for vj
mark(vj) = mark(vj) + 1
v(sfs) = vi
l(sfs) = l(vj)
l(vj) = sfs
sfs = sfs+1
5 continue
6 continue
c
c----create degree lists and initialize mark vector
do 7 vi=1,n
dvi = mark(vi)
next(vi) = head(dvi)
head(dvi) = vi
last(vi) = -dvi
nextvi = next(vi)
if (nextvi.gt.0) last(nextvi) = vi
7 mark(vi) = tag
c
return
c
c ** error- insufficient storage
101 flag = 9*n + vi
return
end
|
