| [type,uplo,diag,m,n,a,nmax,aa,lda,kl,ku,reset,transl]=smake2(type,uplo,diag,m,n,a,nmax,aa,lda,kl,ku,reset,transl); |
function [type,uplo,diag,m,n,a,nmax,aa,lda,kl,ku,reset,transl]=smake2(type,uplo,diag,m,n,a,nmax,aa,lda,kl,ku,reset,transl);
persistent gen i i1 i2 i3 ibeg iend ioff j kk lowermlv one rogue sym tri unit uppermlv zero ;
if isempty(zero), zero=0.0; end;
if isempty(one), one=1.0 ; end;
if isempty(rogue), rogue=-1.0e10 ; end;
a_shape=size(a);a=reshape([a(:).',zeros(1,ceil(numel(a)./prod([nmax])).*prod([nmax])-numel(a))],nmax,[]);
aa_shape=size(aa);aa=reshape(aa,1,[]);
if isempty(i), i=0; end;
if isempty(i1), i1=0; end;
if isempty(i2), i2=0; end;
if isempty(i3), i3=0; end;
if isempty(ibeg), ibeg=0; end;
if isempty(iend), iend=0; end;
if isempty(ioff), ioff=0; end;
if isempty(j), j=0; end;
if isempty(kk), kk=0; end;
if isempty(gen), gen=false; end;
if isempty(lowermlv), lowermlv=false; end;
if isempty(sym), sym=false; end;
if isempty(tri), tri=false; end;
if isempty(unit), unit=false; end;
if isempty(uppermlv), uppermlv=false; end;
gen = strcmp(deblank(type([1:1])),deblank('G'));
sym = strcmp(deblank(type([1:1])),deblank('S'));
tri = strcmp(deblank(type([1:1])),deblank('T'));
uppermlv = (sym | tri) & strcmp(deblank(uplo),deblank('U'));
lowermlv = (sym | tri) & strcmp(deblank(uplo),deblank('L'));
unit = tri & strcmp(deblank(diag),deblank('U'));
for j = 1 : n;
for i = 1 : m;
if( gen ||(uppermlv && i<=j) ||(lowermlv && i>=j) )
if((i<=j && j-i<=ku) ||(i>=j && i-j<=kl) )
a(i,j) = sbeg(reset) + transl;
else;
a(i,j) = zero;
end;
if( i~=j )
if( sym )
a(j,i) = a(i,j);
elseif( tri ) ;
a(j,i) = zero;
end;
end;
end;
end; i = fix(m+1);
if( tri )
a(j,j) = a(j,j) + one;
end;
if( unit )
a(j,j) = one;
end;
end; j = fix(n+1);
if( strcmp(deblank(type),deblank('GE')) )
for j = 1 : n;
for i = 1 : m;
aa(i+(j-1).*lda) = a(i,j);
end; i = fix(m+1);
for i = m + 1 : lda;
aa(i+(j-1).*lda) = rogue;
end; i = fix(lda+1);
end; j = fix(n+1);
elseif ( strcmp(deblank(type),deblank('GB')) ) ;
for j = 1 : n;
for i1 = 1 : ku + 1 - j;
aa(i1+(j-1).*lda) = rogue;
end; i1 = fix(ku + 1 - j+1);
for i2 = i1 : min(kl+ku+1,ku+1+m-j);
aa(i2+(j-1).*lda) = a(i2+j-ku-1,j);
end; i2 = fix(min(kl+ku+1,ku+1+m-j)+1);
for i3 = i2 : lda;
aa(i3+(j-1).*lda) = rogue;
end; i3 = fix(lda+1);
end; j = fix(n+1);
elseif ( strcmp(deblank(type),deblank('SY')) || strcmp(deblank(type),deblank('TR')) ) ;
for j = 1 : n;
if( uppermlv )
ibeg = 1;
if( unit )
iend = fix(j - 1);
else;
iend = fix(j);
end;
else;
if( unit )
ibeg = fix(j + 1);
else;
ibeg = fix(j);
end;
iend = fix(n);
end;
for i = 1 : ibeg - 1;
aa(i+(j-1).*lda) = rogue;
end; i = fix(ibeg - 1+1);
for i = ibeg : iend;
aa(i+(j-1).*lda) = a(i,j);
end; i = fix(iend+1);
for i = iend + 1 : lda;
aa(i+(j-1).*lda) = rogue;
end; i = fix(lda+1);
end; j = fix(n+1);
elseif ( strcmp(deblank(type),deblank('SB')) || strcmp(deblank(type),deblank('TB')) ) ;
for j = 1 : n;
if( uppermlv )
kk = fix(kl + 1);
ibeg = fix(max(1,kl+2-j));
if( unit )
iend = fix(kl);
else;
iend = fix(kl + 1);
end;
else;
kk = 1;
if( unit )
ibeg = 2;
else;
ibeg = 1;
end;
iend = fix(min(kl+1,1+m-j));
end;
for i = 1 : ibeg - 1;
aa(i+(j-1).*lda) = rogue;
end; i = fix(ibeg - 1+1);
for i = ibeg : iend;
aa(i+(j-1).*lda) = a(i+j-kk,j);
end; i = fix(iend+1);
for i = iend + 1 : lda;
aa(i+(j-1).*lda) = rogue;
end; i = fix(lda+1);
end; j = fix(n+1);
elseif ( strcmp(deblank(type),deblank('SP')) || strcmp(deblank(type),deblank('TP')) ) ;
ioff = 0;
for j = 1 : n;
if( uppermlv )
ibeg = 1;
iend = fix(j);
else;
ibeg = fix(j);
iend = fix(n);
end;
for i = ibeg : iend;
ioff = fix(ioff + 1);
aa(ioff) = a(i,j);
if( i==j )
if( unit )
aa(ioff) = rogue;
end;
end;
end; i = fix(iend+1);
end; j = fix(n+1);
end;
a_shape=zeros(a_shape);a_shape(:)=a(1:numel(a_shape));a=a_shape;
aa_shape=zeros(aa_shape);aa_shape(:)=aa(1:numel(aa_shape));aa=aa_shape;
end %subroutine smake2
|
|