function [lun,kprint,ipass]=dlseit(lun,kprint,ipass);
persistent a cnorm d err f fatal firstCall g h i idigit ip jdigit kontrl ma mdd me meap1 mep1 mg mode n nerr np1 prgopt relerr relnrm resnrm rnorme rnorml sol tnorm work x ; if isempty(firstCall),firstCall=1;end;
if isempty(cnorm), cnorm=0; end;
if isempty(relerr), relerr=0; end;
if isempty(relnrm), relnrm=0; end;
if isempty(resnrm), resnrm=0; end;
if isempty(rnorme), rnorme=0; end;
if isempty(rnorml), rnorml=0; end;
if isempty(tnorm), tnorm=0; end;
if isempty(i), i=0; end;
if isempty(idigit), idigit=0; end;
if isempty(jdigit), jdigit=0; end;
if isempty(kontrl), kontrl=0; end;
if isempty(ma), ma=0; end;
if isempty(mdd), mdd=0; end;
if isempty(me), me=0; end;
if isempty(meap1), meap1=0; end;
if isempty(mep1), mep1=0; end;
if isempty(mg), mg=0; end;
if isempty(mode), mode=0; end;
if isempty(n), n=0; end;
if isempty(nerr), nerr=0; end;
if isempty(np1), np1=0; end;
if isempty(fatal), fatal=false; end;
if isempty(a), a=zeros(6,5); end;
if isempty(d), d=zeros(11,6); end;
if isempty(err), err=zeros(1,5); end;
if isempty(f), f=zeros(1,6); end;
if isempty(g), g=zeros(5,5); end;
if isempty(h), h=zeros(1,5); end;
if isempty(prgopt), prgopt=zeros(1,4); end;
if isempty(sol), sol=zeros(1,5); end;
if isempty(work), work=zeros(1,105); end;
if isempty(x), x=zeros(1,5); end;
if isempty(ip), ip=zeros(1,17); end;
if firstCall, a(1,1) =[-74.]; end;
if firstCall, a(1,2) =[80.]; end;
if firstCall, a(1,3) =[18.]; end;
if firstCall, a(1,4) =[-11.]; end;
if firstCall, a(1,5)=[-4.]; end;
if firstCall, a(2,1) =[14.]; end;
if firstCall, a(2,2) =[-69.]; end;
if firstCall, a(2,3) =[21.]; end;
if firstCall, a(2,4) =[28.]; end;
if firstCall, a(2,5)=[0.]; end;
if firstCall, a(3,1) =[66.]; end;
if firstCall, a(3,2) =[-72.]; end;
if firstCall, a(3,3) =[-5.]; end;
if firstCall, a(3,4) =[7.]; end;
if firstCall, a(3,5)=[1.]; end;
if firstCall, a(4,1) =[-12.]; end;
if firstCall, a(4,2) =[66.]; end;
if firstCall, a(4,3) =[-30.]; end;
if firstCall, a(4,4) =[-23.]; end;
if firstCall, a(4,5)=[3.]; end;
if firstCall, a(5,1) =[3.]; end;
if firstCall, a(5,2) =[8.]; end;
if firstCall, a(5,3) =[-7.]; end;
if firstCall, a(5,4) =[-4.]; end;
if firstCall, a(5,5)=[1.]; end;
if firstCall, a(6,1) =[4.]; end;
if firstCall, a(6,2) =[-12.]; end;
if firstCall, a(6,3) =[4.]; end;
if firstCall, a(6,4) =[4.]; end;
if firstCall, a(6,5)=[0.]; end;
if firstCall, g(1,1) =[-1.]; end;
if firstCall, g(1,2) =[-1.]; end;
if firstCall, g(1,3) =[-1.]; end;
if firstCall, g(1,4) =[-1.]; end;
if firstCall, g(1,5)=[-1.]; end;
if firstCall, g(2,1) =[10.]; end;
if firstCall, g(2,2) =[10.]; end;
if firstCall, g(2,3) =[-3.]; end;
if firstCall, g(2,4) =[5.]; end;
if firstCall, g(2,5)=[4.]; end;
if firstCall, g(3,1) =[-8.]; end;
if firstCall, g(3,2) =[1.]; end;
if firstCall, g(3,3) =[-2.]; end;
if firstCall, g(3,4) =[-5.]; end;
if firstCall, g(3,5)=[3.]; end;
if firstCall, g(4,1) =[8.]; end;
if firstCall, g(4,2) =[-1.]; end;
if firstCall, g(4,3) =[2.]; end;
if firstCall, g(4,4) =[5.]; end;
if firstCall, g(4,5)=[-3.]; end;
if firstCall, g(5,1) =[-4.]; end;
if firstCall, g(5,2) =[-2.]; end;
if firstCall, g(5,3) =[3.]; end;
if firstCall, g(5,4) =[-5.]; end;
if firstCall, g(5,5)=[1.]; end;
if firstCall, f(1) =[-5.]; end;
if firstCall, f(2) =[-9.]; end;
if firstCall, f(3) =[708.]; end;
if firstCall, f(4) =[4165.]; end;
if firstCall, f(5) =[-13266.]; end;
if firstCall, f(6)=[8409.]; end;
if firstCall, h(1) =[-5.]; end;
if firstCall, h(2) =[20.]; end;
if firstCall, h(3) =[-40.]; end;
if firstCall, h(4) =[11.]; end;
if firstCall, h(5)=[-30.]; end;
if firstCall, sol(1) =[1.]; end;
if firstCall, sol(2) =[2.]; end;
if firstCall, sol(3) =[-1.]; end;
if firstCall, sol(4) =[3.]; end;
if firstCall, sol(5)=[-4.]; end;a=reshape(a,[6,5]);g=reshape(g,[5,5]);
firstCall=0;
if( kprint>=2 )
writef(lun,['1TEST OF SUBROUTINE DLSEI' ' \n']);
end;
%format ('1TEST OF SUBROUTINE DLSEI');
mdd = 11;
ma = 6;
mg = 5;
n = 5;
me = 0;
ip(1) = 105;
ip(2) = 17;
np1 = fix(n + 1);
mep1 = fix(me + 1);
meap1 = fix(me + ma + 1);
for i = 1 : n;
[mg,g(sub2ind(size(g),1,i):end),dumvar3,d(sub2ind(size(d),meap1,i):end)]=dcopy(mg,g(sub2ind(size(g),1,i):end),1,d(sub2ind(size(d),meap1,i):end),1);
[ma,a(sub2ind(size(a),1,i):end),dumvar3,d(sub2ind(size(d),mep1,i):end)]=dcopy(ma,a(sub2ind(size(a),1,i):end),1,d(sub2ind(size(d),mep1,i):end),1);
end; i = fix(n+1);
[mg,h,dumvar3,d(sub2ind(size(d),meap1,np1):end)]=dcopy(mg,h,1,d(sub2ind(size(d),meap1,np1):end),1);
[ma,f,dumvar3,d(sub2ind(size(d),mep1,np1):end)]=dcopy(ma,f,1,d(sub2ind(size(d),mep1,np1):end),1);
prgopt(1) = 1;
idigit = -4;
jdigit = -11;
for i = 1 : ma;
work(i) = ddot(n,d(sub2ind(size(d),i,1):end),mdd,sol,1) - f(i);
end; i = fix(ma+1);
[resnrm ,ma,work]=dnrm2(ma,work,1);
[d,mdd,me,ma,mg,n,prgopt,x,rnorme,rnorml,mode,work,ip]=dlsei(d,mdd,me,ma,mg,n,prgopt,x,rnorme,rnorml,mode,work,ip);
[tnorm ,n,sol]=dnrm2(n,sol,1);
[n,sol,dumvar3,err]=dcopy(n,sol,1,err,1);
[n,dumvar2,x,dumvar4,err]=daxpy(n,-1.0d0,x,1,err,1);
[cnorm ,n,err]=dnrm2(n,err,1);
relerr = cnorm./tnorm;
relnrm =(resnrm-rnorml)./resnrm;
if( relerr<=70.0d0.*sqrt(d1mach(4)) && relnrm<=5.0d0.*d1mach(4))
ipass = 1;
if( kprint>=3 )
writef(lun,[ '\n ' ,' DLSEI PASSED TEST' ' \n']);
end;
%format [' DLSEI PASSED TEST');
else;
ipass = 0;
if( kprint>=2 )
writef(lun,[ '\n ' ,' DLSEI FAILED TEST', '\n ' ,' RELERR = ',repmat('%f',1,1),'%20.6f', '\n ' ,' RELNRM = ','%20.6f' ' \n'], relerr , relnrm);
end;
%format [' DLSEI FAILED TEST'/' RELERR = ',1P,d20.6/' RELNRM = ',d20.6);
end;
if( kprint>=3 )
[n,err,dumvar3,idigit]=dvout(n,err,'('' RESIDUALS FROM KNOWN LEAST SQUARES SOLUTION'')',idigit);
[n,x,dumvar3,jdigit]=dvout(n,x,'['' SOLUTION COMPUTED BY DLSEI'')',jdigit);
end;
if( kprint>=2 )
if( kprint~=2 || ipass==0 )
[dumvar1,resnrm,dumvar3,jdigit]=dvout(1,resnrm,'['' RESIDUAL NORM OF KNOWN LEAST SQUARES SOLUTION'')',jdigit);
[dumvar1,rnorml,dumvar3,jdigit]=dvout(1,rnorml,'['' RESIDUAL NORM COMPUTED BY DLSEI'')',jdigit);
[dumvar1,relerr,dumvar3,idigit]=dvout(1,relerr,'['' COMPUTED SOLUTION RELATIVE ERROR'')',idigit);
[dumvar1,relnrm,dumvar3,idigit]=dvout(1,relnrm,'['' COMPUTED RELATIVE ERROR IN RESIDUAL NORM'')',idigit);
end;
end;
[kontrl]=xgetf(kontrl);
if( kprint<=2 )
xsetf(0);
else;
xsetf(1);
end;
fatal = false;
xerclr;
if( kprint>=3 )
writef(lun,[ '\n ' ,' 2 ERROR MESSAGES EXPECTED' ' \n']);
end;
%format [' 2 ERROR MESSAGES EXPECTED');
[d,dumvar2,me,ma,mg,n,prgopt,x,rnorme,rnorml,mode,work,ip]=dlsei(d,0,me,ma,mg,n,prgopt,x,rnorme,rnorml,mode,work,ip);
if( numxer(nerr)~=2 )
ipass = 0;
fatal = true;
end;
xerclr;
prgopt(1) = -1;
[d,mdd,me,ma,mg,n,prgopt,x,rnorme,rnorml,mode,work,ip]=dlsei(d,mdd,me,ma,mg,n,prgopt,x,rnorme,rnorml,mode,work,ip);
if( numxer(nerr)~=2 )
ipass = 0;
fatal = true;
end;
xerclr;
[kontrl]=xsetf(kontrl);
if( fatal )
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;
if( ipass==1 && kprint>=2 )
writef(lun,[ '\n ' ,' *DLSEI PASSED ALL TESTS' ' \n']);
end;
%format [' *DLSEI PASSED ALL TESTS');
if( ipass==0 && kprint>=1 )
writef(lun,[ '\n ' ,' *DLSEI FAILED SOME TESTS****' ' \n']);
end;
%format [' *DLSEI FAILED SOME TESTS****');
return;
end %subroutine dlseit
