[nout,kprint,ipass]=dblat2(nout,kprint,ipass);

function [nout,kprint,ipass]=dblat2(nout,kprint,ipass);
persistent a aa alf as bet eps err firstCall ftl ftl1 ftl2 g i idim_v inc incmax isnum j kb ltest n nalf nbet nidim ninc nkb nmax nsubs one same snames thresh trans tsterr x xs xx y ys yt yy z zero ; if isempty(snames),snames={};end; if isempty(firstCall),firstCall=1;end; 

if isempty(nsubs), nsubs=16 ; end;
if isempty(zero), zero=0.0d0; end;
if isempty(one), one=1.0d0 ; end;
if isempty(nmax), nmax=65; end;
if isempty(incmax), incmax=2 ; end;
if isempty(eps), eps=0; end;
if isempty(err), err=0; end;
if isempty(thresh), thresh=0; end;
if isempty(i), i=0; end;
if isempty(isnum), isnum=0; end;
if isempty(j), j=0; end;
if isempty(n), n=0; end;
if isempty(nidim), nidim=6; end;
if isempty(nkb), nkb=4; end;
if isempty(ninc), ninc=4; end;
if isempty(nalf), nalf=3; end;
if isempty(nbet), nbet=3 ; end;
if isempty(same), same=false; end;
if isempty(tsterr), tsterr=false; end;
if isempty(ftl), ftl=false; end;
if isempty(ftl1), ftl1=false; end;
if isempty(ftl2), ftl2=false; end;
if isempty(trans), trans=repmat(' ',1,1); end;
if isempty(a), a=zeros(nmax,nmax); end;
if isempty(aa), aa=zeros(1,nmax.*nmax); end;
if isempty(alf), alf=zeros(1,nalf); end;
if isempty(as), as=zeros(1,nmax.*nmax); end;
if isempty(bet), bet=zeros(1,nbet); end;
if isempty(g), g=zeros(1,nmax); end;
if isempty(x), x=zeros(1,nmax); end;
if isempty(xs), xs=zeros(1,nmax.*incmax); end;
if isempty(xx), xx=zeros(1,nmax.*incmax); end;
if isempty(y), y=zeros(1,nmax); end;
if isempty(ys), ys=zeros(1,nmax.*incmax); end;
if isempty(yt), yt=zeros(1,nmax); end;
if isempty(yy), yy=zeros(1,nmax.*incmax); end;
if isempty(z), z=zeros(1,2.*nmax); end;
if isempty(idim_v), idim_v=zeros(1,nidim); end;
if isempty(inc), inc=zeros(1,ninc); end;
if isempty(kb), kb=zeros(1,nkb); end;
if isempty(ltest), ltest=zeros(1,nsubs); end;
if isempty(snames), snames=cell(1,nsubs); end;
if firstCall,   snames={'DGEMV','DGBMV','DSYMV','DSBMV','DSPMV','DTRMV','DTBMV','DTPMV','DTRSV','DTBSV','DTPSV','DGER','DSYR','DSPR','DSYR2','DSPR2'};  end;
if firstCall,   idim_v=[0,1,2,3,5,9];  end;
if firstCall,   kb=[0,1,2,4];  end;
if firstCall,   inc=[1,2,-1,-2];  end;
if firstCall,   alf=[0.0,1.0,0.7];  end;
if firstCall,   bet=[0.0,1.0,0.9];  end;
firstCall=0;
tsterr = true;
thresh = 16.0;
ipass = 1;
if( kprint>=3 )
writef(nout,[' TESTS OF THE doubleprecision LEVEL 2 BLAS', '\n ' , '\n ' ,' THE F','OLLOWING PARAMETER VALUES WILL BE USED:' ' \n']);
for i=(1):(nidim), writef(nout,['   FOR N              ',repmat('%6i',1,9) ' \n'],idim_v(i)); end;
for i=(1):(nkb), writef(nout,['   FOR K              ',repmat('%6i',1,7) ' \n'],kb(i)); end;
for i=(1):(ninc), writef(nout,['   FOR INCX AND INCY  ',repmat('%6i',1,7) ' \n'],inc(i)); end;
for i=(1):(nalf), writef(nout,['   FOR ALPHA          ',repmat('%6.1f',1,7) ' \n'],alf(i)); end;
for i=(1):(nbet), writef(nout,['   FOR BETA           ',repmat('%6.1f',1,7) ' \n'],bet(i)); end;
if( ~tsterr )
writef(nout,[' ERROR-EXITS WILL NOT BE TESTED' ' \n']);
end;
writef(nout,[' ROUTINES PASS COMPUTATIONAL TESTS IF TEST RATIO IS LES','S THAN','%8.2f' ' \n'], thresh);
end;
for i = 1 : nsubs;
ltest(i) = true;
end; i = fix(nsubs+1);
[eps ]=r1mach(4);
n = fix(min(32,nmax));
for j = 1 : n;
for i = 1 : n;
a(i,j) = max(i-j+1,0);
end; i = fix(n+1);
x(j) = j;
y(j) = zero;
end; j = fix(n+1);
for j = 1 : n;
yy(j) = fix((j.*((j+1).*j))./2) -fix((((j+1).*j).*(j-1))./3);
end; j = fix(n+1);
trans = 'N';
ftl = false;
n_orig=n;    [trans,n,dumvar3,one,a,nmax,x,dumvar8,zero,y,dumvar11,yt,g,yy,eps,err,ftl,nout,dumvar19,kprint]=dmvch(trans,n,n,one,a,nmax,x,1,zero,y,1,yt,g,yy,eps,err,ftl,nout,true,kprint);    n(dumvar3~=n_orig)=dumvar3(dumvar3~=n_orig);
[same ,yy,yt,n]=lde(yy,yt,n);
if( ~same || err~=zero )
ipass = 0;
if( kprint>=2 )
writef(nout,[' ERROR IN DMVCH -  IN-LINE DOT PRODUCTS ARE BEING EVALU','ATED WRONGLY.', '\n ' ,' DMVCH WAS CALLED WITH TRANS = ','%1s',' AND RETURNED SAME = ','%1f',' AND ERR = ','%12.3f','.', '\n ' ,' THIS MAY BE DUE TO FAULTS IN THE ARITHMETIC OR THE',' COMPILER.' ' \n'], trans , same , err);
end;
end;
trans = 'T';
ftl = false;
n_orig=n;    [trans,n,dumvar3,one,a,nmax,x,dumvar8,zero,y,dumvar11,yt,g,yy,eps,err,ftl,nout,dumvar19,kprint]=dmvch(trans,n,n,one,a,nmax,x,-1,zero,y,-1,yt,g,yy,eps,err,ftl,nout,true,kprint);    n(dumvar3~=n_orig)=dumvar3(dumvar3~=n_orig);
[same ,yy,yt,n]=lde(yy,yt,n);
if( ~same || err~=zero )
ipass = 0;
if( kprint>=2 )
writef(nout,[' ERROR IN DMVCH -  IN-LINE DOT PRODUCTS ARE BEING EVALU','ATED WRONGLY.', '\n ' ,' DMVCH WAS CALLED WITH TRANS = ','%1s',' AND RETURNED SAME = ','%1f',' AND ERR = ','%12.3f','.', '\n ' ,' THIS MAY BE DUE TO FAULTS IN THE ARITHMETIC OR THE',' COMPILER.' ' \n'], trans , same , err);
end;
end;
for isnum = 1 : nsubs;
if( ~ltest(isnum) )
writef(nout,[repmat(' ',1,1),'%6s',' WAS NOT TESTED' ' \n'], snames{isnum});
else;
ftl1 = false;
if( tsterr )
[isnum,snames{isnum},nout,kprint,ftl1]=dchke2(isnum,snames{isnum},nout,kprint,ftl1);
end;
xerclr;
ftl2 = false;
if( isnum==3 || isnum==4 || isnum==5 )
[snames{isnum},eps,thresh,nout,kprint,ftl2,nidim,idim_v,nkb,kb,nalf,alf,nbet,bet,ninc,inc,nmax,incmax,a,aa,as,x,xx,xs,y,yy,ys,yt,g]=dchk22(snames{isnum},eps,thresh,nout,kprint,ftl2,nidim,idim_v,nkb,kb,nalf,alf,nbet,bet,ninc,inc,nmax,incmax,a,aa,as,x,xx,xs,y,yy,ys,yt,g);
elseif( isnum==6 || isnum==7 || isnum==8 || isnum==9 ||isnum==10 || isnum==11 ) ;
[snames{isnum},eps,thresh,nout,kprint,ftl2,nidim,idim_v,nkb,kb,ninc,inc,nmax,incmax,a,aa,as,y,yy,ys,yt,g,z]=dchk32(snames{isnum},eps,thresh,nout,kprint,ftl2,nidim,idim_v,nkb,kb,ninc,inc,nmax,incmax,a,aa,as,y,yy,ys,yt,g,z);
elseif( isnum==12 ) ;
[snames{isnum},eps,thresh,nout,kprint,ftl2,nidim,idim_v,nalf,alf,ninc,inc,nmax,incmax,a,aa,as,x,xx,xs,y,yy,ys,yt,g,z]=dchk42(snames{isnum},eps,thresh,nout,kprint,ftl2,nidim,idim_v,nalf,alf,ninc,inc,nmax,incmax,a,aa,as,x,xx,xs,y,yy,ys,yt,g,z);
elseif( isnum==13 || isnum==14 ) ;
[snames{isnum},eps,thresh,nout,kprint,ftl2,nidim,idim_v,nalf,alf,ninc,inc,nmax,incmax,a,aa,as,x,xx,xs,y,yy,ys,yt,g,z]=dchk52(snames{isnum},eps,thresh,nout,kprint,ftl2,nidim,idim_v,nalf,alf,ninc,inc,nmax,incmax,a,aa,as,x,xx,xs,y,yy,ys,yt,g,z);
elseif( isnum==15 || isnum==16 ) ;
[snames{isnum},eps,thresh,nout,kprint,ftl2,nidim,idim_v,nalf,alf,ninc,inc,nmax,incmax,a,aa,as,x,xx,xs,y,yy,ys,yt,g,z]=dchk62(snames{isnum},eps,thresh,nout,kprint,ftl2,nidim,idim_v,nalf,alf,ninc,inc,nmax,incmax,a,aa,as,x,xx,xs,y,yy,ys,yt,g,z);
else;
[snames{isnum},eps,thresh,nout,kprint,ftl2,nidim,idim_v,nkb,kb,nalf,alf,nbet,bet,ninc,inc,nmax,incmax,a,aa,as,x,xx,xs,y,yy,ys,yt,g]=dchk12(snames{isnum},eps,thresh,nout,kprint,ftl2,nidim,idim_v,nkb,kb,nalf,alf,nbet,bet,ninc,inc,nmax,incmax,a,aa,as,x,xx,xs,y,yy,ys,yt,g);
end;
if( ftl1 || ftl2 )
ipass = 0;
end;
end;
end; isnum = fix(nsubs+1);
return;
%format (' ROUTINES PASS COMPUTATIONAL TESTS IF TEST RATIO IS LES','S THAN',f8.2);
%format (' TESTS OF THE doubleprecision LEVEL 2 BLAS',//' THE F','OLLOWING PARAMETER VALUES WILL BE USED:');
%format ('   FOR N              ',9I6);
%format ('   FOR K              ',7I6);
%format ('   FOR INCX AND INCY  ',7I6);
%format ('   FOR ALPHA          ',7F6.1);
%format ('   FOR BETA           ',7F6.1);
%format (' ERROR IN DMVCH -  IN-LINE DOT PRODUCTS ARE BEING EVALU','ATED WRONGLY.',/' DMVCH WAS CALLED WITH TRANS = ',a1,' AND RETURNED SAME = ',l1,' AND ERR = ',f12.3,'.',/' THIS MAY BE DUE TO FAULTS IN THE ARITHMETIC OR THE',' COMPILER.');
%format (1X,a6,' WAS NOT TESTED');
%format (' ERROR-EXITS WILL NOT BE TESTED');
end %subroutine dblat2