[lun,kprint,nerr]=chpqc(lun,kprint,nerr);

function [lun,kprint,nerr]=chpqc(lun,kprint,nerr);
persistent ainv ap at b bt c dc det firstCall i indx inert info ipvt irt 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(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,47); 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 isempty(inert), inert=zeros(1,3); end;
if isempty(irt), irt=zeros(1,3); 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,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,.33333e0),complex(.66667e0,0.0e0),complex(0.0e0,0.0e0),complex(0.0e0,0.0e0),complex(.36364e0,0.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=['HPFAHPCOHPSLHPDI'];  end;
if firstCall,   kfail=['INFORCONDSOLUTIONDETERMINANTINVERSEINERTIA'];  end;
if firstCall,   rcnd=[.24099e0];  end;
if firstCall,   irt=[4,0,0];  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]=chpfa(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]=chpsl(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]=chpco(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,inert,z]=chpdi(at,n,ipvt,det,inert,z,111);
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 : 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;
indx = 0;
for i = 1 : 3;
if((inert(i)-irt(i))~=0 )
indx = fix(indx + 1);
end;
end; i = fix(3+1);
if( indx~=0 )
writef(lun,[ '\n ' ,' *** C','%s',' FAILURE - ERROR IN ','%s' ' \n'], kprog([16:min(length(kprog),19)]) , kfail([41:min(length(kfail),47)]));
nerr = fix(nerr + 1);
end;
if( kprint>=2 || nerr~=0 )
writef(lun,[ '\n ' ,' * CHPQC - TEST FOR CHPFA, CHPCO, CHPSL AND CHPDI FOUND ','%1i',' ERRORS.', '\n '  ' \n'], nerr);
end;
%format [' * CHPQC - TEST FOR CHPFA, CHPCO, CHPSL AND CHPDI FOUND ',i1,' ERRORS.'];
return;
%format [' *** C',a,' FAILURE - ERROR IN ',a);
end %subroutine chpqc