Code covered by the BSD License  

Highlights from
slatec

from slatec by Ben Barrowes
The slatec library converted into matlab functions.

[type,uplo,diag,m,n,a,nmax,aa,lda,reset,transl]=cmake3(type,uplo,diag,m,n,a,nmax,aa,lda,reset,transl);
function [type,uplo,diag,m,n,a,nmax,aa,lda,reset,transl]=cmake3(type,uplo,diag,m,n,a,nmax,aa,lda,reset,transl);
persistent gen her i ibeg iend j jj lowermlv one rogue rrogue rzero sym tri unit uppermlv zero ; 

if isempty(zero), zero=complex(0.0,0.0); end;
if isempty(one), one=complex(1.0,0.0) ; end;
if isempty(rogue), rogue=complex(-1.0e10,1.0e10) ; end;
if isempty(rzero), rzero=0.0 ; end;
if isempty(rrogue), rrogue=-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(ibeg), ibeg=0; end;
if isempty(iend), iend=0; end;
if isempty(j), j=0; end;
if isempty(jj), jj=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;
if isempty(her), her=false; end;
% intrinsic cmplx , conjg , real ::;
gen = strcmp(deblank(type),deblank('GE'));
her = strcmp(deblank(type),deblank('HE'));
sym = strcmp(deblank(type),deblank('SY'));
tri = strcmp(deblank(type),deblank('TR'));
uppermlv = (her | sym | tri) & strcmp(deblank(uplo),deblank('U'));
lowermlv = (her | 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) )
a(i,j) = cbeg(reset) + transl;
if( i~=j )
if( n>3 && j==fix(n./2) )
a(i,j) = zero;
end;
if( her )
a(j,i) = conj(a(i,j));
elseif( sym ) ;
a(j,i) = a(i,j);
elseif( tri ) ;
a(j,i) = zero;
end;
end;
end;
end; i = fix(m+1);
if( her )
a(j,j) = complex(real(a(j,j)),rzero);
end;
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('HE')) || 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);
if( her )
jj = fix(j +(j-1).*lda);
aa(jj) = complex(real(aa(jj)),rrogue);
end;
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 cmake3

Contact us