function [lun,kprint,nerr]=dgeqc(lun,kprint,nerr);
persistent a atemp b btemp bxex errcmp errmax firstCall i ind itask iwork j kprog lda list n work ; if isempty(list),list={};end; if isempty(firstCall),firstCall=1;end;
if isempty(errcmp), errcmp=0; end;
if isempty(errmax), errmax=0; end;
if isempty(i), i=0; end;
if isempty(ind), ind=0; end;
if isempty(itask), itask=0; end;
if isempty(j), j=0; end;
if isempty(kprog), kprog=0; end;
if isempty(lda), lda=0; end;
if isempty(n), n=0; end;
if isempty(a), a=zeros(5,4); end;
if isempty(atemp), atemp=zeros(5,4); end;
if isempty(b), b=zeros(1,4); end;
if isempty(btemp), btemp=zeros(1,4); end;
if isempty(bxex), bxex=zeros(1,4); end;
if isempty(work), work=zeros(1,20); end;
if isempty(iwork), iwork=zeros(1,4); end;
if isempty(list), list=cell(1,2); end;
if firstCall, a=[5.0d0,1.0d0,0.3d0,2.1d0,0.0d0,-1.0d0,-0.5d0,1.0d0,1.0d0,0.0d0,4.5d0,-1.0d0,-1.7d0,2.0d0,0.0d0,0.5d0,2.0d0,0.6d0,1.3d0,0.0d0]; end;
if firstCall, b=[0.0d0,3.5d0,3.6d0,2.4d0]; end;
if firstCall, bxex=[0.10d+01,0.10d+01,-0.10d+01,0.10d+01]; end;
if firstCall, list={'GEFS','GEIR'}; end;a=reshape(a,[5,4]);
firstCall=0;
n = 4;
lda = 5;
nerr = 0;
errcmp = d1mach(4).^0.8d0;
if( kprint>=2 )
writef(lun,[ '\n ' , '\n ' ,repmat(' ',1,2),'DGEFS Quick Check', '\n ' ' \n']);
end;
%format [/,2X,'DGEFS Quick Check'];
kprog = 1;
itask = 1;
btemp([1:n]) = b([1:n]);
atemp([1:n],[1:n]) = a([1:n],[1:n]);
[atemp,lda,n,btemp,itask,ind,work,iwork]=dgefs(atemp,lda,n,btemp,itask,ind,work,iwork);
if( ind<0 )
if( kprint>=2 )
writef(lun,[ '\n ' ,repmat(' ',1,5),'D','%s',' Test FAILED, MAX ABS(ERROR) is','%13.5f' ' \n'], list{kprog} , ind);
end;
nerr = fix(nerr + 1);
end;
errmax = 0.0d0;
for i = 1 : n;
errmax = max(errmax,abs(btemp(i)-bxex(i)));
end; i = fix(n+1);
if( errcmp>errmax )
if( kprint>=3 )
writef(lun,[ '\n ' ,repmat(' ',1,5),'D','%s',' Normal test PASSED' ' \n'], list{kprog});
end;
else;
if( kprint>=2 )
writef(lun,[ '\n ' ,repmat(' ',1,5),'D','%s',' Test FAILED, MAX ABS(ERROR) is','%13.5f' ' \n'], list{kprog} , errmax);
end;
nerr = fix(nerr + 1);
end;
itask = 1;
for i = 1 : n;
btemp(i) = b(i);
end; i = fix(n+1);
for j = 1 : n;
for i = 1 : n;
atemp(i,j) = a(i,j);
end; i = fix(n+1);
end; j = fix(n+1);
for j = 1 : n;
atemp(1,j) = 0.0d0;
end; j = fix(n+1);
[atemp,lda,n,btemp,itask,ind,work,iwork]=dgefs(atemp,lda,n,btemp,itask,ind,work,iwork);
if( ind==-4 )
if( kprint>=3 )
writef(lun,[ '\n ' ,repmat(' ',1,5),'D','%s',' Singular test PASSED' ' \n'], list{kprog});
end;
else;
if( kprint>=2 )
writef(lun,[ '\n ' ,repmat(' ',1,5),'D','%s',' Singular test FAILED, IND=','%3i' ' \n'], list{kprog} , ind);
end;
nerr = fix(nerr + 1);
end;
if( kprint>=3 && nerr==0 )
writef(lun,[ '\n ' ,repmat(' ',1,2),'DGEFS Quick Check PASSED', '\n ' ' \n']);
end;
%format [,2X,'DGEFS Quick Check PASSED'];
if( kprint>=2 && nerr~=0 )
writef(lun,[ '\n ' ,repmat(' ',1,2),'SGEFS and SGEIR Quick Check FAILED', '\n ' ' \n']);
end;
%format [,2X,'SGEFS and SGEIR Quick Check FAILED'];
return;
%format [,5X,'D',a,' Normal test PASSED');
%format [,5X,'D',a,' Test FAILED, MAX ABS(ERROR) is',e13.5);
%format [,5X,'D',a,' Singular test PASSED');
%format [,5X,'D',a,' Singular test FAILED, IND=',i3);
end %subroutine dgeqc