[lun,kprint,ipass]=cqrtst(lun,kprint,ipass);

function [lun,kprint,ipass]=cqrtst(lun,kprint,ipass);
persistent chk1 chk2 coeff1 coeff2 coeff3 fatal firstCall i ierr itest_v itmp j kontrl nerr root tol work ; if isempty(firstCall),firstCall=1;end; 

if isempty(i), i=0; end;
if isempty(ierr), ierr=0; end;
if isempty(j), j=0; end;
if isempty(kontrl), kontrl=0; end;
if isempty(nerr), nerr=0; end;
if isempty(tol), tol=0; end;
if isempty(itest_v), itest_v=zeros(1,2); end;
if isempty(itmp), itmp=zeros(1,7); end;
if isempty(work), work=zeros(1,144); end;
if isempty(coeff1), coeff1=zeros(1,9); end;
if isempty(coeff2), coeff2=zeros(1,2); end;
if isempty(coeff3), coeff3=zeros(1,2); end;
if isempty(root), root=zeros(1,8); end;
if isempty(chk1), chk1=zeros(1,8); end;
if isempty(chk2), chk2=0; end;
if isempty(fatal), fatal=false; end;
if firstCall,   coeff1=[complex(1.0,0.0),complex(-7.0,-2.0),complex(8.0,6.0),complex(28.0,8.0),complex(-49.0,-24.0),complex(7.0,2.0),complex(-8.0,-6.0),complex(-28.0,-8.0),complex(48.0,24.0)];  end;
if firstCall,   coeff2=[complex(1.0,1.0),complex(1.0,3.0)];  end;
if firstCall,   coeff3=[complex(0.0,0.0),complex(1.0,3.0)];  end;
if firstCall,   chk1=[complex(4.0,2.0),complex(3.0,0.0),complex(-2.0,0.0),complex(2.0,0.0),complex(0.0,-1.0),complex(-1.0,0.0),complex(0.0,1.0),complex(1.0,0.0)];  end;
if firstCall,   chk2=[complex(-2.0,-1.0)];  end;
firstCall=0;
if( kprint>=2 )
writef(lun,['1', '\n ' ,' CPQR79 QUICK CHECK' ' \n']);
end;
%format ('1',/,' CPQR79 QUICK CHECK');
tol = sqrt(r1mach(4));
ipass = 1;
[dumvar1,coeff1,root,ierr,work]=cpqr79(8,coeff1,root,ierr,work);
for i = 1 : 7;
itmp(i) = 0;
end; i = fix(7+1);
for i = 1 : 7;
for j = 1 : 7;
if( abs(root(i)-chk1(j))<=tol )
itmp(j) = 1;
break;
end;
end;
end;
itest_v(1) = 1;
for i = 1 : 7;
itest_v(1) = fix(itest_v(1).*itmp(i));
end; i = fix(7+1);
if( kprint>=3 ||(kprint>=2 && itest_v(1)==0) )
writef(lun,[ '\n ' ,' CHECK REAL AND IMAGINARY PARTS OF ROOT', '\n ' ,' COEFFICIENTS' ' \n']);
for j=(1):(9), writef(lun,[ '\n ' ,repmat(['%6i',repmat(' ',1,3),repmat('%f',1,1),repmat('%22.14f',1,2)] ,1,1) ' \n'],j,coeff1(j)); end;
writef(lun,[ '\n ' , '\n ' ,repmat(' ',1,25),'TABLE of ROOTS', '\n ' , '\n ' ,'   ROOT         REAL  PART',repmat(' ',1,12),'IMAG  PART', '\n ' ,'  NUMBER',repmat(' ',1,8),repmat([' of  ZERO ',repmat(' ',1,12)] ,1,2) ' \n']);
for j=(1):(7), writef(lun,['%6i',repmat(' ',1,3),repmat('%f',1,1),repmat('%22.14f',1,2) ' \n'],j,root(j)); end;
end;
if( kprint>=2 )
[lun,dumvar2,itest_v(1)]=pass(lun,1,itest_v(1));
end;
[dumvar1,coeff2,root,ierr,work]=cpqr79(1,coeff2,root,ierr,work);
itest_v(2) = 1;
if( abs(root(1)-chk2)>tol )
itest_v(2) = 0;
end;
if( kprint>=3 ||(kprint>=2 && itest_v(1)==0) )
writef(lun,[ '\n ' ,' TEST SUBSEQUENT RELATED CALL' ' \n']);
%format [,' TEST SUBSEQUENT RELATED CALL');
writef(lun,[ '\n ' ,' CHECK REAL AND IMAGINARY PARTS OF ROOT', '\n ' ,' COEFFICIENTS' ' \n']);
for j=(1):(2), writef(lun,[ '\n ' ,repmat(['%6i',repmat(' ',1,3),repmat('%f',1,1),repmat('%22.14f',1,2)] ,1,1) ' \n'],j,coeff2(j)); end;
writef(lun,[ '\n ' , '\n ' ,repmat(' ',1,25),'TABLE of ROOTS', '\n ' , '\n ' ,'   ROOT         REAL  PART',repmat(' ',1,12),'IMAG  PART', '\n ' ,'  NUMBER',repmat(' ',1,8),repmat([' of  ZERO ',repmat(' ',1,12)] ,1,2) ' \n']);
for j=(1):(1), writef(lun,['%6i',repmat(' ',1,3),repmat('%f',1,1),repmat('%22.14f',1,2) ' \n'],j,root(j)); end;
end;
if( kprint>=2 )
[lun,dumvar2,itest_v(2)]=pass(lun,2,itest_v(2));
end;
[kontrl]=xgetf(kontrl);
if( kprint<=2 )
xsetf(0);
else;
xsetf(1);
end;
fatal = false;
xerclr;
if( kprint>=3 )
writef(lun,[ '\n ' , '\n ' ,' TRIGGER 2 ERROR CONDITIONS', '\n ' , '\n '  ' \n']);
end;
%format [/' TRIGGER 2 ERROR CONDITIONS'/];
[dumvar1,coeff2,root,ierr,work]=cpqr79(0,coeff2,root,ierr,work);
if( numxer(nerr)~=3 )
fatal = true;
end;
xerclr;
[dumvar1,coeff3,root,ierr,work]=cpqr79(2,coeff3,root,ierr,work);
if( numxer(nerr)~=2 )
fatal = true;
end;
xerclr;
[kontrl]=xsetf(kontrl);
if( fatal )
ipass = 0;
if( kprint>=2 )
writef(lun,[ '\n ' ,' AT LEAST ONE INCORRECT ARGUMENT TEST FAILED' ' \n']);
%format [' AT LEAST ONE INCORRECT ARGUMENT TEST FAILED');
end;
elseif( kprint>=3 ) ;
writef(lun,[ '\n ' ,' ALL INCORRECT ARGUMENT TESTS PASSED' ' \n']);
%format [' ALL INCORRECT ARGUMENT TESTS PASSED');
end;
ipass = fix(ipass.*itest_v(1).*itest_v(2));
if( ipass==1 && kprint>1 )
writef(lun,[ '\n ' ,' ****CPQR79 PASSED ALL TESTS****' ' \n']);
end;
%format [' ****CPQR79 PASSED ALL TESTS****');
if( ipass==0 && kprint~=0 )
writef(lun,[ '\n ' ,' ****CPQR79 FAILED SOME TESTS***' ' \n']);
end;
%format [' ****CPQR79 FAILED SOME TESTS***');
return;
%format [,' CHECK REAL AND IMAGINARY PARTS OF ROOT'/' COEFFICIENTS');
%format[(i6,3x,1p,2e22.14));
%format [/25X,'TABLE of ROOTS'//'   ROOT         REAL  PART',12X,'IMAG  PART'/'  NUMBER',8X,2(' of  ZERO ',12X));
%format(i6,3x,1p,2e22.14);
end %subroutine cqrtst