function [lun,kprint,nerr]=sqck(lun,kprint,nerr);
persistent a abe abet at b bt c delmax delx firstCall i ind iwork j j1 j2 jd k kcase kprog lda list ml mlp mu n r signmlv work ; if isempty(list),list={};end; if isempty(firstCall),firstCall=1;end;
if isempty(a), a=zeros(4,4); end;
if isempty(at), at=zeros(5,4); end;
if isempty(abe), abe=zeros(5,7); end;
if isempty(abet), abet=zeros(5,7); 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(work), work=zeros(1,35); end;
if isempty(r), r=0; end;
if isempty(delx), delx=0; end;
if isempty(delmax), delmax=0; end;
if isempty(signmlv), signmlv=0; end;
if isempty(list), list=cell(1,4); end;
if isempty(lda), lda=0; end;
if isempty(n), n=0; end;
if isempty(ml), ml=0; end;
if isempty(mu), mu=0; end;
if isempty(ind), ind=0; end;
if isempty(iwork), iwork=zeros(1,4); end;
if isempty(i), i=0; end;
if isempty(j), j=0; end;
if isempty(j1), j1=0; end;
if isempty(j2), j2=0; end;
if isempty(jd), jd=0; end;
if isempty(mlp), mlp=0; end;
if isempty(k), k=0; end;
if isempty(kcase), kcase=0; end;
if isempty(kprog), kprog=0; end;
if firstCall, a=[5.0e0,4.0e0,1.0e0,1.0e0,4.0e0,5.0e0,1.0e0,1.0e0,1.0e0,1.0e0,4.0e0,2.0e0,1.0e0,1.0e0,2.0e0,4.0e0]; end;
if firstCall, list={'POFS','POIR','NBFS','NBIR'}; end;a=reshape(a,[4,4]);
firstCall=0;
if( kprint>=3 )
writef(lun,[ '\n ' ,' * SQCK - QUICK CHECK FOR SPOFS, SPOIR, SNBFS AND ','SNBIR', '\n ' ' \n']);
end;
%format [' * SQCK - QUICK CHECK FOR SPOFS, SPOIR, SNBFS AND ','SNBIR'];
lda = 5;
n = 4;
ml = 2;
mu = 1;
jd = fix(2.*ml + mu + 1);
nerr = 0;
r = r1mach(4).^0.8e0;
signmlv = 1.0e0;
for i = 1 : n;
c(i) = signmlv./i;
signmlv = -signmlv;
end; i = fix(n+1);
for kcase = 1 : 2;
for kprog = 1 : 4;
for i = 1 : n;
b(i) = 0.0e0;
end; i = fix(n+1);
if( kprog<=2 )
for i = 1 : n;
for j = 1 : n;
b(i) = b(i) + a(i,j).*c(j);
end; j = fix(n+1);
end; i = fix(n+1);
else;
for j = 1 : jd;
for i = 1 : n;
abe(i,j) = 0.0e0;
end; i = fix(n+1);
end; j = fix(jd+1);
mlp = fix(ml + 1);
for i = 1 : n;
j1 = fix(max(1,i-ml));
j2 = fix(min(n,i+mu));
for j = j1 : j2;
k = fix(j - i + mlp);
abe(i,k) = a(i,j);
b(i) = b(i) +(a(i,j).*c(j));
end; j = fix(j2+1);
end; i = fix(n+1);
end;
for i = 1 : n;
bt(i) = b(i);
for j = 1 : n;
at(i,j) = a(i,j);
end; j = fix(n+1);
end; i = fix(n+1);
for j = 1 : jd;
for i = 1 : n;
abet(i,j) = abe(i,j);
end; i = fix(n+1);
end; j = fix(jd+1);
if( kcase==2 )
for j = 1 : n;
at(1,j) = 0.0e0;
end; j = fix(n+1);
for j = 1 : jd;
abet(1,j) = 0.0e0;
end; j = fix(jd+1);
end;
if( kprog==1 )
[at,lda,n,bt,dumvar5,ind,work]=spofs(at,lda,n,bt,1,ind,work);
end;
if( kprog==2 )
[at,lda,n,bt,dumvar5,ind,work]=spoir(at,lda,n,bt,1,ind,work);
end;
if( kprog==3 )
[abet,lda,n,ml,mu,bt,dumvar7,ind,work,iwork]=snbfs(abet,lda,n,ml,mu,bt,1,ind,work,iwork);
end;
if( kprog==4 )
[abet,lda,n,ml,mu,bt,dumvar7,ind,work,iwork]=snbir(abet,lda,n,ml,mu,bt,1,ind,work,iwork);
end;
if( kcase==1 )
delmax = 0.0e0;
for i = 1 : n;
delx = abs(bt(i)-c(i));
delmax = max(delmax,delx);
end; i = fix(n+1);
if( r<=delmax )
nerr = fix(nerr + 1);
writef(lun,[' PROBLEM WITH S','%s',', CASE ','%1i','. MAX ABS ERROR OF','%11.4f', '\n ' ' \n'], list{kprog} , kcase , delmax);
%format (' PROBLEM WITH S',a,', CASE ',i1,'. MAX ABS ERROR OF',e11.4];
end;
elseif( ind~=-4 ) ;
nerr = fix(nerr + 1);
writef(lun,[' PROBLEM WITH S','%s',', CASE ','%1i','. IND = ','%2i',' INSTEAD OF -4', '\n ' ' \n'], list{kprog} , kcase , ind);
%format (' PROBLEM WITH S',a,', CASE ',i1,'. IND = ',i2,' INSTEAD OF -4'];
end;
end; kprog = fix(4+1);
end; kcase = fix(2+1);
if( nerr~=0 )
writef(lun,[ '\n ' ,' **** SQCK DETECTED A TOTAL OF ','%2i',' PROBLEMS. ****', '\n ' ' \n'], nerr);
end;
%format [' **** SQCK DETECTED A TOTAL OF ',i2,' PROBLEMS. ****'];
if( kprint>=2 && nerr==0 )
writef(lun,[' SQCK DETECTED NO PROBLEMS.', '\n ' ' \n']);
end;
%format (' SQCK DETECTED NO PROBLEMS.'];
return;
end %subroutine sqck
