Code covered by the BSD License  

Highlights from
slatec

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

[lun,kprint,ipass]=qcglss(lun,kprint,ipass);
function [lun,kprint,ipass]=qcglss(lun,kprint,ipass);
persistent a aa b bb delmax delx firstCall i inf info iwork j kcase kk kprog list nerr r rnorm work xx ; if isempty(list),list={};end; if isempty(firstCall),firstCall=1;end; 

if isempty(i), i=0; end;
if isempty(j), j=0; end;
if isempty(kk), kk=0; end;
if isempty(rnorm), rnorm=0; end;
if isempty(aa), aa=zeros(4,4,2); end;
if isempty(a), a=zeros(4,4); end;
if isempty(bb), bb=zeros(4,2); end;
if isempty(b), b=zeros(1,4); end;
if isempty(xx), xx=zeros(4,4); end;
if isempty(delmax), delmax=0; end;
if isempty(delx), delx=0; end;
if isempty(r), r=0; end;
if isempty(work), work=zeros(1,20); end;
if isempty(list), list=cell(1,2); end;
if isempty(inf), inf=zeros(1,4); end;
if isempty(nerr), nerr=0; end;
if isempty(kprog), kprog=0; end;
if isempty(kcase), kcase=0; end;
if isempty(iwork), iwork=zeros(1,7); end;
if isempty(info), info=0; end;
if firstCall,   aa=[1.,.5,1.,.25,0.,2.,0.,1.,2.,-1.,1.,0.,0.,0.,0.,0.,1.,2.,-1.,0.,0.,1.,2.,0.,-1.,0.,1.,0.,1.,0.,1.,0.];  end;
if firstCall,   bb=[3.,1.5,2.,1.25,1.,3.,3.,0.];  end;
if firstCall,   xx=[.9999999999999787,1.000000000000007,1.000000000000007,0.,.8095238095238102,1.047619047619044,1.095238095238081,0.,.7777777777777857,1.444444444444429,.3333333333333393,.5555555555555500,.3333333333333321,0.0,-.3333333333333286,.3333333333333286];  end;
if firstCall,   inf=[0,1,0,2];  end;
if firstCall,   list={'L','U'};  end;aa=reshape(aa,[4,4,2]);bb=reshape(bb,[4,2]);xx=reshape(xx,[4,4]);
firstCall=0;
info = 0;
nerr = 0;
r = sqrt(r1mach(4));
if( kprint>=2 )
writef(lun,[ '\n ' ,' *    QCGLSS - QUICK CHECK FOR SGLSS (LLSIA AND ULSIA)', '\n '  ' \n']);
end;
%format [' *    QCGLSS - QUICK CHECK FOR SGLSS (LLSIA AND ULSIA)'];
for kprog = 1 : 2;
for kcase = 1 : 2;
for i = 1 : 4;
for j = 1 : 4;
a(i,j) = aa(i,j,kprog);
end; j = fix(4+1);
b(i) = bb(i,kprog);
end; i = fix(4+1);
if( kcase~=1 )
for i = 2 : 3;
for j = 1 : 4;
a(i,j) = a(1,j);
end; j = fix(4+1);
b(i) = b(1);
end; i = fix(3+1);
end;
info = 0;
if( kprog==1 )
[a,dumvar2,dumvar3,dumvar4,b,dumvar6,dumvar7,rnorm,work,dumvar10,iwork,dumvar12,info]=sglss(a,4,4,3,b,4,1,rnorm,work,20,iwork,7,info);
end;
if( kprog==2 )
[a,dumvar2,dumvar3,dumvar4,b,dumvar6,dumvar7,rnorm,work,dumvar10,iwork,dumvar12,info]=sglss(a,4,3,4,b,4,1,rnorm,work,20,iwork,7,info);
end;
kk = fix(2.*(kprog-1) + kcase);
delmax = 0.0e0;
for i = 1 : 4;
delx = abs(b(i)-xx(i,kk));
delmax = max(delmax,delx);
end; i = fix(4+1);
if( kprint>=3 )
writef(lun,[repmat(' ',1,3),'%s','LSIA, CASE ','%1i','.  MAX ABS ERROR OF','%11.4f', '\n '  ' \n'], list{kprog} , kcase , delmax);
end;
%format (3X,a,'LSIA, CASE ',i1,'.  MAX ABS ERROR OF',e11.4];
if( delmax>=r )
nerr = fix(nerr + 1);
if( kprint>=2 )
writef(lun,['   PROBLEM WITH ','%s','LSIA, CASE ','%1i','.  MAX ABS ERROR OF','%11.4f', '\n '  ' \n'], list{kprog} , kcase , delmax);
end;
%format ('   PROBLEM WITH ',a,'LSIA, CASE ',i1,'.  MAX ABS ERROR OF',e11.4];
end;
if( kprint>=3 )
writef(lun,[repmat(' ',1,3),'%s','LSIA, CASE ','%1i','.  RNORM IS ','%11.4f', '\n '  ' \n'], list{kprog} , kcase , rnorm);
end;
%format (3X,a,'LSIA, CASE ',i1,'.  RNORM IS ',e11.4];
if( rnorm>r )
nerr = fix(nerr + 1);
if( kprint>=2 )
writef(lun,['   PROBLEM WITH ','%s','LSIA, CASE ','%1i','.  RNORM (TOO LARGE) IS','%11.4f', '\n '  ' \n'], list{kprog} , kcase , rnorm);
end;
%format ('   PROBLEM WITH ',a,'LSIA, CASE ',i1,'.  RNORM (TOO LARGE) IS',e11.4];
end;
if( kprint>=3 )
writef(lun,[repmat(' ',1,3),'%s','LSIA, CASE ','%1i','.  INFO=','%1i',' (SHOULD = ','%1i',')', '\n '  ' \n'], list{kprog} , kcase , info ,inf(kk));
end;
%format (3X,a,'LSIA, CASE ',i1,'.  INFO=',i1,' (SHOULD = ',i1,')'];
if( info~=inf(kk) )
nerr = fix(nerr + 1);
if( kprint>=2 )
writef(lun,['   PROBLEM WITH ','%s','LSIA, CASE ','%1i','.  INFO=','%1i',' (SHOULD = ','%1i',')', '\n '  ' \n'], list{kprog} , kcase , info ,inf(kk));
end;
%format ('   PROBLEM WITH ',a,'LSIA, CASE ',i1,'.  INFO=',i1,' (SHOULD = ',i1,')'];
end;
end; kcase = fix(2+1);
end; kprog = fix(2+1);
ipass = 0;
if( nerr==0 )
ipass = 1;
end;
if( nerr~=0 && kprint~=0 )
writef(lun,[ '\n ' ,' **** QCGLSS DETECTED A TOTAL OF ','%2i',' PROBLEMS WITH SGLSS. ****', '\n '  ' \n'], nerr);
end;
%format [' **** QCGLSS DETECTED A TOTAL OF ',i2,' PROBLEMS WITH SGLSS. ****'];
if( nerr==0 && kprint>1 )
writef(lun,['     QCGLSS DETECTED NO PROBLEMS WITH SGLSS.', '\n '  ' \n']);
end;
%format ('     QCGLSS DETECTED NO PROBLEMS WITH SGLSS.'];
return;
end %subroutine qcglss

Contact us at files@mathworks.com