Code covered by the BSD License  

Highlights from
slatec

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

[lun,kprint,nerr]=sgeqc(lun,kprint,nerr);
function [lun,kprint,nerr]=sgeqc(lun,kprint,nerr);
persistent a atemp b btemp bxex errcmp errmax firstCall i ind itask iwork j kprog lda list n work ; if isempty(list),list={};end; if isempty(firstCall),firstCall=1;end; 

if isempty(errcmp), errcmp=0; end;
if isempty(errmax), errmax=0; end;
if isempty(i), i=0; end;
if isempty(ind), ind=0; end;
if isempty(itask), itask=0; end;
if isempty(j), j=0; end;
if isempty(kprog), kprog=0; end;
if isempty(lda), lda=0; end;
if isempty(n), n=0; end;
if isempty(a), a=zeros(5,4); end;
if isempty(atemp), atemp=zeros(5,4); end;
if isempty(b), b=zeros(1,4); end;
if isempty(btemp), btemp=zeros(1,4); end;
if isempty(bxex), bxex=zeros(1,4); end;
if isempty(work), work=zeros(1,20); end;
if isempty(iwork), iwork=zeros(1,4); end;
if isempty(list), list=cell(1,2); end;
if firstCall,   a=[5.0e0,1.0e0,0.3e0,2.1e0,0.0e0,-1.0e0,-0.5e0,1.0e0,1.0e0,0.0e0,4.5e0,-1.0e0,-1.7e0,2.0e0,0.0e0,0.5e0,2.0e0,0.6e0,1.3e0,0.0e0];  end;
if firstCall,   b=[0.0e0,3.5e0,3.6e0,2.4e0];  end;
if firstCall,   bxex=[0.10e+01,0.10e+01,-0.10e+01,0.10e+01];  end;
if firstCall,   list={'GEFS','GEIR'};  end;a=reshape(a,[5,4]);
firstCall=0;
n = 4;
lda = 5;
nerr = 0;
errcmp = r1mach(4).^0.8e0;
if( kprint>=2 )
writef(lun,[ '\n ' , '\n ' ,repmat(' ',1,2),'SGEFS and SGEIR Quick Check', '\n '  ' \n']);
end;
%format [/,2X,'SGEFS and SGEIR Quick Check'];
for kprog = 1 : 2;
itask = 1;
for i = 1 : n;
btemp(i) = b(i);
end; i = fix(n+1);
for j = 1 : n;
for i = 1 : n;
atemp(i,j) = a(i,j);
end; i = fix(n+1);
end; j = fix(n+1);
if( kprog==1 )
[atemp,lda,n,btemp,itask,ind,work,iwork]=sgefs(atemp,lda,n,btemp,itask,ind,work,iwork);
else;
[atemp,lda,n,btemp,itask,ind,work,iwork]=sgeir(atemp,lda,n,btemp,itask,ind,work,iwork);
end;
if( ind<0 )
if( kprint>=2 )
writef(lun,[ '\n ' ,repmat(' ',1,5),'S','%s',' Normal test PASSED' ' \n'], list{kprog} , ind);
end;
nerr = fix(nerr + 1);
end;
errmax = 0.0e0;
for i = 1 : n;
errmax = max(errmax,abs(btemp(i)-bxex(i)));
end; i = fix(n+1);
if( errcmp>errmax )
if( kprint>=3 )
writef(lun,[ '\n ' ,repmat(' ',1,5),'S','%s',' Normal test PASSED' ' \n'], list{kprog});
end;
else;
if( kprint>=2 )
writef(lun,[ '\n ' ,repmat(' ',1,5),'S','%s',' Test FAILED, MAX ABS(ERROR) is','%13.5f' ' \n'], list{kprog} , errmax);
end;
nerr = fix(nerr + 1);
end;
itask = 1;
for i = 1 : n;
btemp(i) = b(i);
end; i = fix(n+1);
for j = 1 : n;
for i = 1 : n;
atemp(i,j) = a(i,j);
end; i = fix(n+1);
end; j = fix(n+1);
for j = 1 : n;
atemp(1,j) = 0.0e0;
end; j = fix(n+1);
if( kprog==1 )
[atemp,lda,n,btemp,itask,ind,work,iwork]=sgefs(atemp,lda,n,btemp,itask,ind,work,iwork);
else;
[atemp,lda,n,btemp,itask,ind,work,iwork]=sgeir(atemp,lda,n,btemp,itask,ind,work,iwork);
end;
if( ind==-4 )
if( kprint>=3 )
writef(lun,[ '\n ' ,repmat(' ',1,5),'S','%s',' Singular test PASSED' ' \n'], list{kprog});
end;
else;
if( kprint>=2 )
writef(lun,[ '\n ' ,repmat(' ',1,5),'S','%s',' Singular test FAILED, IND=','%3i' ' \n'], list{kprog} , ind);
end;
nerr = fix(nerr + 1);
end;
end; kprog = fix(2+1);
if( kprint>=3 && nerr==0 )
writef(lun,[ '\n ' ,repmat(' ',1,2),'SGEFS and SGEIR Quick Check PASSED', '\n '  ' \n']);
end;
%format [,2X,'SGEFS and SGEIR Quick Check PASSED'];
if( kprint>=2 && nerr~=0 )
writef(lun,[ '\n ' ,repmat(' ',1,2),'SGEFS and SGEIR Quick Check FAILED', '\n '  ' \n']);
end;
%format [,2X,'SGEFS and SGEIR Quick Check FAILED'];
return;
%format [,5X,'S',a,' Normal test PASSED');
%format [,5X,'S',a,' Test FAILED, MAX ABS(ERROR) is',e13.5);
%format [,5X,'S',a,' Singular test PASSED');
%format [,5X,'S',a,' Singular test FAILED, IND=',i3);
end %subroutine sgeqc

Contact us at files@mathworks.com