Code covered by the BSD License  

Highlights from
slatec

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

[lun,kprint,nerr]=cspqc(lun,kprint,nerr);
function [lun,kprint,nerr]=cspqc(lun,kprint,nerr);
persistent ainv ap at b bt c dc det firstCall i indx info ipvt j kfail kprog n r rcnd rcond xa xb z ; if isempty(firstCall),firstCall=1;end; 

if isempty(ap), ap=zeros(1,10); end;
if isempty(at), at=zeros(1,10); end;
if isempty(b), b=zeros(1,4); end;
if isempty(bt), bt=zeros(1,4); end;
if isempty(c), c=zeros(1,4); end;
if isempty(ainv), ainv=zeros(1,10); end;
if isempty(det), det=zeros(1,2); end;
if isempty(dc), dc=zeros(1,2); end;
if isempty(z), z=zeros(1,4); end;
if isempty(xa), xa=0; end;
if isempty(xb), xb=0; end;
if isempty(r), r=0; end;
if isempty(rcond), rcond=0; end;
if isempty(rcnd), rcnd=0; end;
% delx= @(xa,xb)  abs(real(xa-xb)) + abs(aimag(xa-xb));real :: delx;
if isempty(kprog), kprog=repmat(' ',1,19); end;
if isempty(kfail), kfail=repmat(' ',1,39); end;
if isempty(n), n=0; end;
if isempty(ipvt), ipvt=zeros(1,4); end;
if isempty(info), info=0; end;
if isempty(i), i=0; end;
if isempty(j), j=0; end;
if isempty(indx), indx=0; end;
if firstCall,   ap=[complex(2.0e0,0.0e0),complex(0.0e0,-1.0e0),complex(2.0e0,0.0e0),complex(0.0e0,0.0e0),complex(0.0e0,0.0e0),complex(3.0e0,0.0e0),complex(0.0e0,0.0e0),complex(0.0e0,0.0e0),complex(0.0e0,-1.0e0),complex(4.0e0,0.0e0)];  end;
if firstCall,   b=[complex(3.0e0,2.0e0),complex(1.0e0,1.0e0),complex(0.0e0,-4.0e0),complex(3.0e0,0.0e0)];  end;
if firstCall,   c=[complex(1.0e0,1.0e0),complex(0.0e0,1.0e0),complex(0.0e0,-1.0e0),complex(1.0e0,0.0e0)];  end;
if firstCall,   ainv=[complex(.4e0,0.0e0),complex(0.0e0,.2e0),complex(.4e0,0.0e0),complex(0.0e0,0.0e0),complex(0.0e0,0.0e0),complex(.30769e0,0.0e0),complex(0.0e0,0.0e0),complex(0.0e0,0.0e0),complex(0.0e0,.07692e0),complex(.23077e0,0.0e0)];  end;
if firstCall,   dc=[complex(6.5e0,0.0e0),complex(1.0e0,0.0e0)];  end;
if firstCall,   kprog=['SPFASPCOSPSLSPDI'];  end;
if firstCall,   kfail=['INFORCONDSOLUTIONDETERMINANTINVERSE'];  end;
if firstCall,   rcnd=[.58692e0];  end;
firstCall=0;
delx= @(xa,xb)  abs(real(xa-xb)) + abs(imag(xa-xb));
n = 4;
nerr = 0;
for j = 1 : n;
bt(j) = b(j);
end; j = fix(n+1);
for i = 1 : 10;
at(i) = ap(i);
end; i = fix(10+1);
[at,n,ipvt,info]=cspfa(at,n,ipvt,info);
if( info~=0 )
writef(lun,[ '\n ' ,'*** C','%s',' FAILURE - ERROR IN ','%s' ' \n'], kprog([1:min(length(kprog),4)]) , kfail([1:min(length(kfail),4)]));
nerr = fix(nerr + 1);
end;
[at,n,ipvt,bt]=cspsl(at,n,ipvt,bt);
indx = 0;
for i = 1 : n;
delx= @(xa,xb)  abs(real(xa-xb)) + abs(imag(xa-xb));
if( delx(c(i),bt(i))>.0001 )
indx = fix(indx + 1);
end;
end; i = fix(n+1);
if( indx~=0 )
writef(lun,[ '\n ' ,'*** C','%s',' FAILURE - ERROR IN ','%s' ' \n'], kprog([11:min(length(kprog),14)]) , kfail([12:min(length(kfail),19)]));
nerr = fix(nerr + 1);
end;
for i = 1 : 10;
at(i) = ap(i);
end; i = fix(10+1);
[at,n,ipvt,rcond,z]=cspco(at,n,ipvt,rcond,z);
r = abs(rcnd-rcond);
if( r>=.0001 )
writef(lun,[ '\n ' ,'*** C','%s',' FAILURE - ERROR IN ','%s' ' \n'], kprog([6:min(length(kprog),9)]) , kfail([6:min(length(kfail),10)]));
nerr = fix(nerr + 1);
end;
[at,n,ipvt,det,z]=cspdi(at,n,ipvt,det,z,11);
indx = 0;
for i = 1 : 2;
delx= @(xa,xb)  abs(real(xa-xb)) + abs(imag(xa-xb));
if( delx(dc(i),det(i))>.0001 )
indx = fix(indx + 1);
end;
end; i = fix(2+1);
if( indx~=0 )
writef(lun,[ '\n ' ,'*** C','%s',' FAILURE - ERROR IN ','%s' ' \n'], kprog([16:min(length(kprog),19)]) , kfail([21:min(length(kfail),31)]));
nerr = fix(nerr + 1);
end;
indx = 0;
for i = 1 : 10;
delx= @(xa,xb)  abs(real(xa-xb)) + abs(imag(xa-xb));
if( delx(ainv(i),at(i))>.0001 )
indx = fix(indx + 1);
end;
end; i = fix(10+1);
if( indx~=0 )
writef(lun,[ '\n ' ,'*** C','%s',' FAILURE - ERROR IN ','%s' ' \n'], kprog([16:min(length(kprog),19)]) , kfail([33:min(length(kfail),39)]));
nerr = fix(nerr + 1);
end;
if( kprint>=2 || nerr~=0 )
writef(lun,[ '\n ' ,' * CSPQC - TEST FOR CSPFA, CSPCO, CSPSL AND CSPDI FOUND ','%1i',' ERRORS.', '\n '  ' \n'], nerr);
end;
%format [' * CSPQC - TEST FOR CSPFA, CSPCO, CSPSL AND CSPDI FOUND ',i1,' ERRORS.'];
return;
%format ['*** C',a,' FAILURE - ERROR IN ',a);
end %subroutine cspqc

Contact us