File: bandwr.sci

package info (click to toggle)
scilab 2.6-4
  • links: PTS
  • area: non-free
  • in suites: woody
  • size: 54,632 kB
  • ctags: 40,267
  • sloc: ansic: 267,851; fortran: 166,549; sh: 10,005; makefile: 4,119; tcl: 1,070; cpp: 233; csh: 143; asm: 135; perl: 130; java: 39
file content (120 lines) | stat: -rw-r--r-- 2,934 bytes parent folder | download
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
function [iperm,mrepi,profil,ierr]=bandwr(a,b,c,d)
//case 1 : a is a sparse matrix and b is (option) iopt
//case 2 : a is lp, b is ls, c is n the dimension and d is (option) iopt
[lhs,rhs]=argn(0)
if (rhs>4|rhs<1) then error(39), end;
if (rhs<3) then
  if (rhs == 1) then iopt=0;end;
  if (rhs == 2) then iopt=b;end;
  [ij,v,mn]=spget(a);
  aa=sparse(ij,ones(v),mn);
  if (sum(aa-aa') <> 0) then   
    error('The matrix ""a"" must to be symmetric')
  end
  n=mn(1);
  if (size(diag(a),1) < n) then   
    error('There are null terms on the diagonal')
  end
//
amem=a;
aa=a-speye(a);aa=aa+aa';
mn=size(aa);
u=sum(aa,'r');rownul=find(u==0);
if(rownul <> []) then
ini=rownul;
if(max(rownul) == mn(1)) then ini($)=ini($)-1;end;
pea=sparse([ini' ini'+1], ones(ini'),mn);
a=a+pea+pea';a=triu(a);
[ij,v,mn]=spget(a);
end
// 
  [lp,la,ls]=m6ta2lpd(ij(:,1)',ij(:,2)',n+1,n);
else
  lp=a;ls=b;n=c;
  if (rhs == 3) then iopt=0;end;
  if (rhs == 4) then iopt=d;end;
  v=ones(ls)';n=size(lp,2)-1;
  [ta,he]=m6lp2tad(lp,la,ls,n);
  amem=sparse([ta' he'],v,[n,n]);
end;
if(n < 3) then 
  error('Size too small')
end
if(iopt <> 0) then iopt=1;end;
nz=size(v,'*');
liwork=2*n+2+2*nz+6*n+3+3*n;
iwork=zeros(1,liwork);
lrwork=n*n+1;
// max for lrwork; can be chosen smaller : k*nz with k=10 e.g.;
rwork=zeros(1,lrwork);
iwork(1:(n+1))=lp;
iwork((2*n+2):(2*n+2+nz-1))=ls;
rwork(1:nz)=v';
[iperm,mrepi,profil,ierr]=m6bandred(n,nz,liwork,iwork,lrwork,rwork,iopt);
if(ierr == 0) then
if(iopt == 0) then
[ij,v,mn]=spget(amem(mrepi,mrepi));
pr=max(abs(ij(:,1)-ij(:,2)));
profil(1)=pr;end;
if(iopt==1) then
[ij,v,mn]=spget(amem(mrepi,mrepi));
idia=find(ij(:,1) == ij(:,2));
ind1=idia(1:($-1))+1;
qq=ij(ind1,1)-ij(ind1,2);qq=[0;qq];
profil=[1:mn(1)]'-qq;
end;
return;
else
//
// 3 random sorts
for iisort=1:3;
b=[];a=[1:n];
for i=1:n,k=n+1-i;
ii=int((rand()+1./k)*k);
b=[b a(ii)];a(ii)=[];
end;
[ss,sk]=sort(b);
back=sk($:-1:1);
a=amem+amem';
a=a(b,b);a=triu(a);
aa=a-speye(a);aa=aa+aa';
mn=size(aa);
u=sum(aa,'r');rownul=find(u==0);
[ij,v,mn]=spget(a);
if(rownul <> []) then
ini=rownul;
if(max(rownul) == mn(1)) then ini($)=ini($)-1;end;
pea=sparse([ini' ini'+1], ones(ini'),mn);
a=a+pea+pea';a=triu(a);
[ij,v,mn]=spget(a);
end;
[lp,la,ls]=m6ta2lpd(ij(:,1)',ij(:,2)',n+1,n);
v=ones(ls)';nz=size(v,'*');
liwork=2*n+2+2*nz+6*n+3+3*n;
iwork=zeros(1,liwork);
lrwork=n*n+1;
rwork=zeros(1,lrwork);
iwork(1:(n+1))=lp;
iwork((2*n+2):(2*n+2+nz-1))=ls;
rwork(1:nz)=v';
[iperm,mrepi,profil,ierr]=m6bandred(n,nz,liwork,iwork,lrwork,rwork,iopt);
if(ierr == 0) then 
mrepi=b(mrepi);
iperm=iperm(back);
if(iopt == 0) then
[ij,v,mn]=spget(amem(mrepi,mrepi));
pr=max(abs(ij(:,1)-ij(:,2)));
profil(1)=pr;end;
if(iopt==1) then
[ij,v,mn]=spget(amem(mrepi,mrepi));
idia=find(ij(:,1) == ij(:,2));
ind1=idia(1:($-1))+1;
qq=ij(ind1,1)-ij(ind1,2);qq=[0;qq];
profil=[1:mn(1)]'-qq;
end;
return;end;
end;
if(ierr == 64000) then
    error('program terminated by error');
return;end;
end;