Code covered by the BSD License  

Highlights from
slatec

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

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

if isempty(a), a=zeros(4,4); end;
if isempty(at), at=zeros(5,4); 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(4,4); 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(det), det=zeros(1,2); end;
if isempty(dc), dc=zeros(1,2); end;
if isempty(kprog), kprog=repmat(' ',1,19); end;
if isempty(kfail), kfail=repmat(' ',1,39); end;
if isempty(lda), lda=0; end;
if isempty(n), n=0; 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,   a=[complex(2.0e0,0.0e0),complex(0.0e0,1.0e0),complex(0.0e0,0.0e0),complex(0.0e0,0.0e0),complex(0.0e0,-1.0e0),complex(2.0e0,0.0e0),complex(0.0e0,0.0e0),complex(0.0e0,0.0e0),complex(0.0e0,0.0e0),complex(0.0e0,0.0e0),complex(3.0e0,0.0e0),complex(0.0e0,1.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,3.0e0),complex(0.0e0,-4.0e0),complex(5.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(.66667e0,0.0e0),complex(0.0e0,1.0e0),complex(0.0e0,0.0e0),complex(0.0e0,0.0e0),complex(0.0e0,.33333e0),complex(.66667e0,0.0e0),complex(0.0e0,0.0e0),complex(0.0e0,0.0e0),complex(0.0e0,0.0e0),complex(0.0e0,0.0e0),complex(.36364e0,0.0e0),complex(0.0e0,1.0e0),complex(0.0e0,0.0e0),complex(0.0e0,0.0e0),complex(0.0e0,.09091e0),complex(.27273e0,0.0e0)];  end;
if firstCall,   dc=[3.3e0,1.0e0];  end;
if firstCall,   kprog=['POFAPOCOPOSLPODI'];  end;
if firstCall,   kfail=['INFORCONDSOLUTIONDETERMINANTINVERSE'];  end;
if firstCall,   rcnd=[.24099e0];  end;a=reshape(a,[4,4]);ainv=reshape(ainv,[4,4]);
firstCall=0;
delx= @(xa,xb)  abs(real(xa-xb)) + abs(imag(xa-xb));
lda = 5;
n = 4;
nerr = 0;
for j = 1 : n;
bt(j) = b(j);
for i = 1 : n;
at(i,j) = a(i,j);
end; i = fix(n+1);
end; j = fix(n+1);
[at,lda,n,info]=cpofa(at,lda,n,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,lda,n,bt]=cposl(at,lda,n,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 j = 1 : n;
for i = 1 : n;
at(i,j) = a(i,j);
end; i = fix(n+1);
end; j = fix(n+1);
[at,lda,n,rcond,z,info]=cpoco(at,lda,n,rcond,z,info);
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;
if( info~=0 )
writef(lun,[ '\n ' ,' *** C','%s',' FAILURE - ERROR IN ','%s' ' \n'], kprog([6:min(length(kprog),9)]) , kfail([1:min(length(kfail),4)]));
nerr = fix(nerr + 1);
end;
[at,lda,n,det]=cpodi(at,lda,n,det,11);
indx = 0;
for i = 1 : 2;
if( abs(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 : n;
for j = 1 : n;
delx= @(xa,xb)  abs(real(xa-xb)) + abs(imag(xa-xb));
if( delx(ainv(i,j),at(i,j))>.0001 )
indx = fix(indx + 1);
end;
end; j = fix(n+1);
end; i = fix(n+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 ' ,' * CPOQC - TEST FOR CPOFA, CPOCO, CPOSL AND CPODI FOUND ','%1i',' ERRORS.', '\n '  ' \n'], nerr);
end;
%format [' * CPOQC - TEST FOR CPOFA, CPOCO, CPOSL AND CPODI FOUND ',i1,' ERRORS.'];
return;
%format [' *** C',a,' FAILURE - ERROR IN ',a);
end %subroutine cpoqc

Contact us