function [lun,kprint,ipass]=slapqc(lun,kprint,ipass);
persistent a dens err f factor ia ierr isym iter itmax itol itolgm iunit iwork ja k kase leniw lenw maxiw maxn maxrw mxnelt n nelt neltmx nfail nmax nsave rwork tol xiter ;
if isempty(maxn), maxn=25; end;
if isempty(mxnelt), mxnelt=500; end;
if isempty(maxiw), maxiw=1000; end;
if isempty(maxrw), maxrw=1000 ; end;
global sslblk_1; if isempty(sslblk_1), sslblk_1=zeros(1,maxn); end;
if isempty(dens), dens=0; end;
if isempty(err), err=0; end;
if isempty(factor), factor=0; end;
if isempty(tol), tol=0; end;
if isempty(ierr), ierr=0; end;
if isempty(isym), isym=0; end;
if isempty(iter), iter=0; end;
if isempty(itmax), itmax=0; end;
if isempty(itol), itol=0; end;
if isempty(itolgm), itolgm=0; end;
if isempty(iunit), iunit=0; end;
if isempty(k), k=0; end;
if isempty(kase), kase=0; end;
if isempty(leniw), leniw=0; end;
if isempty(lenw), lenw=0; end;
if isempty(n), n=0; end;
if isempty(nelt), nelt=0; end;
if isempty(neltmx), neltmx=0; end;
if isempty(nfail), nfail=0; end;
if isempty(nmax), nmax=0; end;
if isempty(nsave), nsave=0; end;
if isempty(a), a=zeros(1,mxnelt); end;
if isempty(f), f=zeros(1,maxn); end;
if isempty(rwork), rwork=zeros(1,maxrw); end;
if isempty(xiter), xiter=zeros(1,maxn); end;
if isempty(ia), ia=zeros(1,mxnelt); end;
if isempty(iwork), iwork=zeros(1,maxiw); end;
if isempty(ja), ja=zeros(1,mxnelt); end;
% intrinsic max , real ::;
% common :: ;
%% common /sslblk/ soln;
%% common /sslblk/ sslblk_1;
neltmx = fix(mxnelt);
nmax = fix(maxn);
leniw = fix(maxiw);
lenw = fix(maxrw);
n = fix(nmax);
itmax = fix(n);
factor = 1.2e0;
if( kprint<3 )
iunit = 0;
else;
iunit = fix(lun);
end;
tol = max(1.0e3.*r1mach(3),1.0e-6);
nfail = 0;
for kase = 1 : 3;
if( kase==1 || kase==2 )
itol = fix(kase);
end;
if( kase==3 )
itol = 11;
end;
for isym = 0 : 1;
if( kprint>=2 )
writef(lun,['1', '\n ' ,' Running tests with N =','%3i',', KASE =','%2i',', ISYM =','%2i' ' \n'], n , kase , isym);
end;
%format ('1'/' Running tests with N =',i3,', KASE =',i2,', ISYM =',i2);
[neltmx,factor,ierr,n,nelt,isym,ia,ja,a,f,sslblk_1,rwork,iwork,dumvar14]=srmgen(neltmx,factor,ierr,n,nelt,isym,ia,ja,a,f,sslblk_1,rwork,iwork,iwork(n+1:n+1+n-1)); dumvar14i=find((iwork(n+1:n+1+n-1))~=(dumvar14)); iwork(n+1-1+dumvar14i)=dumvar14(dumvar14i);
if( ierr~=0 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'SLAPQC -- Fatal error ','%1i',' generating ','*RANDOM* Matrix.' ' \n'], ierr);
%format [1X,'SLAPQC -- Fatal error ',i1,' generating ','*RANDOM* Matrix.');
nfail = fix(nfail + 1);
continue;
end;
if( isym==0 )
dens = real(nelt)./(n.*n);
else;
dens = real(2.*nelt)./(n.*n);
end;
if( kprint>=2 )
writef(lun,[ '\n ' ,' * RANDOM Matrix of sizemlv','%5i','*', '\n ' ,' ','Number of non-zeros & Density = ','%5i',repmat('%f',1,1),'%16.7f' ' \n'], n , nelt , dens);
%format [' * RANDOM Matrix of sizemlv',i5,'*'/' ','Number of non-zeros & Density = ',i5,1P,e16.7);
writef(lun,[' Error tolerance = ',repmat('%f',1,1),'%16.7f' ' \n'], tol);
%format (' Error tolerance = ',1P,e16.7);
end;
[n,nelt,ia,ja,a,isym]=ss2y(n,nelt,ia,ja,a,isym);
if( kprint>=4 )
for k=(1):(nelt), writef(lun,[ '\n ' ,' SLAP Column Matrix ', '\n ' ,' Indx ia ja a', '\n ' ,repmat([repmat(' ',1,1),'%4i',repmat(' ',1,1),'%4i',repmat(' ',1,1),'%4i',repmat(' ',1,1),repmat('%f',1,1),'%16.7f'] ,1,1) ' \n'],k,ia(k),ja(k),a(k)); end;
%format [' SLAP Column Matrix '/' Indx ia ja a'/(1X,i4,1X,i4,1X,i4,1X,1P,e16.7));
[n,nelt,ia,ja,a,isym,lun]=scpplt(n,nelt,ia,ja,a,isym,lun);
end;
if( kprint>=3 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%6s',' : ITOL = ','%2i',' ISYM = ','%1i' ' \n'], 'SSJAC ' , itol , isym);
end;
[n,xiter]=vfill(n,xiter,0.0e0);
[n,f,xiter,nelt,ia,ja,a,isym,itol,tol,dumvar11,iter,err,ierr,iunit,rwork,lenw,iwork,leniw]=ssjac(n,f,xiter,nelt,ia,ja,a,isym,itol,tol,2.*itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw);
[dumvar1,ierr,kprint,nfail,lun,iter,err]=outerr('SSJAC ',ierr,kprint,nfail,lun,iter,err);
if( kprint>=3 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%6s',' : ITOL = ','%2i',' ISYM = ','%1i' ' \n'], 'SSGS ' , itol , isym);
end;
[n,xiter]=vfill(n,xiter,0.0e0);
[n,f,xiter,nelt,ia,ja,a,isym,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw]=ssgs(n,f,xiter,nelt,ia,ja,a,isym,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw);
[dumvar1,ierr,kprint,nfail,lun,iter,err]=outerr('SSGS ',ierr,kprint,nfail,lun,iter,err);
if( kprint>=3 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%6s',' : ITOL = ','%2i',' ISYM = ','%1i' ' \n'], 'SSILUR' , itol , isym);
end;
[n,xiter]=vfill(n,xiter,0.0e0);
[n,f,xiter,nelt,ia,ja,a,isym,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw]=ssilur(n,f,xiter,nelt,ia,ja,a,isym,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw);
[dumvar1,ierr,kprint,nfail,lun,iter,err]=outerr('SSILUR',ierr,kprint,nfail,lun,iter,err);
if( isym==1 )
if( kprint>=3 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%6s',' : ITOL = ','%2i',' ISYM = ','%1i' ' \n'], 'SSDCG' , itol , isym);
end;
[n,xiter]=vfill(n,xiter,0.0e0);
[n,f,xiter,nelt,ia,ja,a,isym,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw]=ssdcg(n,f,xiter,nelt,ia,ja,a,isym,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw);
[dumvar1,ierr,kprint,nfail,lun,iter,err]=outerr('SSDCG ',ierr,kprint,nfail,lun,iter,err);
end;
if( isym==1 )
if( kprint>=3 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%6s',' : ITOL = ','%2i',' ISYM = ','%1i' ' \n'], 'SSICCG' , itol , isym);
end;
[n,xiter]=vfill(n,xiter,0.0e0);
[n,f,xiter,nelt,ia,ja,a,isym,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw]=ssiccg(n,f,xiter,nelt,ia,ja,a,isym,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw);
[dumvar1,ierr,kprint,nfail,lun,iter,err]=outerr('SSICCG',ierr,kprint,nfail,lun,iter,err);
end;
if( kprint>=3 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%6s',' : ITOL = ','%2i',' ISYM = ','%1i' ' \n'], 'SSDCGN' , itol , isym);
end;
[n,xiter]=vfill(n,xiter,0.0e0);
[n,f,xiter,nelt,ia,ja,a,isym,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw]=ssdcgn(n,f,xiter,nelt,ia,ja,a,isym,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw);
[dumvar1,ierr,kprint,nfail,lun,iter,err]=outerr('SSDCGN',ierr,kprint,nfail,lun,iter,err);
if( kprint>=3 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%6s',' : ITOL = ','%2i',' ISYM = ','%1i' ' \n'], 'SSLUCN' , itol , isym);
end;
[n,xiter]=vfill(n,xiter,0.0e0);
[n,f,xiter,nelt,ia,ja,a,isym,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw]=sslucn(n,f,xiter,nelt,ia,ja,a,isym,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw);
[dumvar1,ierr,kprint,nfail,lun,iter,err]=outerr('SSLUCN',ierr,kprint,nfail,lun,iter,err);
if( kprint>=3 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%6s',' : ITOL = ','%2i',' ISYM = ','%1i' ' \n'], 'SSDBCG' , itol , isym);
end;
[n,xiter]=vfill(n,xiter,0.0e0);
[n,f,xiter,nelt,ia,ja,a,isym,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw]=ssdbcg(n,f,xiter,nelt,ia,ja,a,isym,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw);
[dumvar1,ierr,kprint,nfail,lun,iter,err]=outerr('SSDBCG',ierr,kprint,nfail,lun,iter,err);
if( kprint>=3 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%6s',' : ITOL = ','%2i',' ISYM = ','%1i' ' \n'], 'SSLUBC' , itol , isym);
end;
[n,xiter]=vfill(n,xiter,0.0e0);
[n,f,xiter,nelt,ia,ja,a,isym,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw]=sslubc(n,f,xiter,nelt,ia,ja,a,isym,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw);
[dumvar1,ierr,kprint,nfail,lun,iter,err]=outerr('SSLUBC',ierr,kprint,nfail,lun,iter,err);
if( kprint>=3 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%6s',' : ITOL = ','%2i',' ISYM = ','%1i' ' \n'], 'SSDCGS' , itol , isym);
end;
[n,xiter]=vfill(n,xiter,0.0e0);
[n,f,xiter,nelt,ia,ja,a,isym,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw]=ssdcgs(n,f,xiter,nelt,ia,ja,a,isym,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw);
[dumvar1,ierr,kprint,nfail,lun,iter,err]=outerr('SSDCGS',ierr,kprint,nfail,lun,iter,err);
if( kprint>=3 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%6s',' : ITOL = ','%2i',' ISYM = ','%1i' ' \n'], 'SSLUCS' , itol , isym);
end;
[n,xiter]=vfill(n,xiter,0.0e0);
[n,f,xiter,nelt,ia,ja,a,isym,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw]=sslucs(n,f,xiter,nelt,ia,ja,a,isym,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw);
[dumvar1,ierr,kprint,nfail,lun,iter,err]=outerr('SSLUCS',ierr,kprint,nfail,lun,iter,err);
for nsave = 0 : 3;
if( kprint>=3 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%6s',' : ITOL = ','%2i',' ISYM = ','%1i',' NSAVE = ','%2i' ' \n'], 'SSDOMN' , itol , isym ,nsave);
end;
[n,xiter]=vfill(n,xiter,0.0e0);
[n,f,xiter,nelt,ia,ja,a,isym,nsave,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw]=ssdomn(n,f,xiter,nelt,ia,ja,a,isym,nsave,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw);
[dumvar1,ierr,kprint,nfail,lun,iter,err]=outerr('SSDOMN',ierr,kprint,nfail,lun,iter,err);
end; nsave = fix(3+1);
for nsave = 0 : 3;
if( kprint>=3 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%6s',' : ITOL = ','%2i',' ISYM = ','%1i',' NSAVE = ','%2i' ' \n'], 'SSLUOM' , itol , isym ,nsave);
end;
[n,xiter]=vfill(n,xiter,0.0e0);
[n,f,xiter,nelt,ia,ja,a,isym,nsave,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw]=ssluom(n,f,xiter,nelt,ia,ja,a,isym,nsave,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw);
[dumvar1,ierr,kprint,nfail,lun,iter,err]=outerr('SSLUOM',ierr,kprint,nfail,lun,iter,err);
end; nsave = fix(3+1);
for nsave = 5 : 12;
if( kprint>=3 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%6s',' : ITOL = ','%2i',' ISYM = ','%1i',' NSAVE = ','%2i' ' \n'], 'SSDGMR' , itol , isym ,nsave);
end;
[n,xiter]=vfill(n,xiter,0.0e0);
itolgm = 0;
[n,f,xiter,nelt,ia,ja,a,isym,nsave,itolgm,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw]=ssdgmr(n,f,xiter,nelt,ia,ja,a,isym,nsave,itolgm,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw);
[dumvar1,ierr,kprint,nfail,lun,iter,err]=outerr('SSDGMR',ierr,kprint,nfail,lun,iter,err);
end; nsave = fix(12+1);
for nsave = 5 : 12;
if( kprint>=3 )
writef(lun,[ '\n ' ,repmat(' ',1,1),'%6s',' : ITOL = ','%2i',' ISYM = ','%1i',' NSAVE = ','%2i' ' \n'], 'SSLUGM' , itol , isym ,nsave);
end;
[n,xiter]=vfill(n,xiter,0.0e0);
[n,f,xiter,nelt,ia,ja,a,isym,nsave,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw]=sslugm(n,f,xiter,nelt,ia,ja,a,isym,nsave,itol,tol,itmax,iter,err,ierr,iunit,rwork,lenw,iwork,leniw);
[dumvar1,ierr,kprint,nfail,lun,iter,err]=outerr('SSLUGM',ierr,kprint,nfail,lun,iter,err);
end; nsave = fix(12+1);
end; isym = fix(1+1);
end; kase = fix(3+1);
if( nfail==0 )
ipass = 1;
if( kprint>=2 )
writef(lun,['--------- All single precisionmlv SLAP tests passed ','---------' ' \n']);
end;
%format ('--------- All single precisionmlv SLAP tests passed ','---------');
else;
ipass = 0;
if( kprint>=2 )
writef(lun,['****','%3i',' single precisionmlv SLAP tests failed ','****' ' \n'], nfail);
end;
%format ('****',i3,' single precisionmlv SLAP tests failed ','****');
end;
return;
%format [1X,a6,' : ITOL = ',i2,' ISYM = ',i1);
%format [1X,a6,' : ITOL = ',i2,' ISYM = ',i1,' NSAVE = ',i2);
end %subroutine slapqc
