function [lun,kprint,ipass]=snls1q(lun,kprint,ipass);
persistent fatal fjac fjrow fjtj fnorm fnorms fvec i iflag info infos iopt iw kontrl ldfjac lwa m n nerr nprint one sigma temp1 temp2 temp3 tol tol2 wa x zero ;
if isempty(fnorm), fnorm=0; end;
if isempty(fnorms), fnorms=0; end;
if isempty(one), one=0; end;
if isempty(sigma), sigma=0; end;
if isempty(temp1), temp1=0; end;
if isempty(temp2), temp2=0; end;
if isempty(temp3), temp3=0; end;
if isempty(tol), tol=0; end;
if isempty(tol2), tol2=0; end;
if isempty(zero), zero=0; end;
if isempty(i), i=0; end;
if isempty(iflag), iflag=0; end;
if isempty(info), info=0; end;
if isempty(infos), infos=0; end;
if isempty(iopt), iopt=0; end;
if isempty(kontrl), kontrl=0; end;
if isempty(ldfjac), ldfjac=0; end;
if isempty(lwa), lwa=0; end;
if isempty(m), m=0; end;
if isempty(n), n=0; end;
if isempty(nerr), nerr=0; end;
if isempty(nprint), nprint=0; end;
if isempty(fatal), fatal=false; end;
if isempty(fjac), fjac=zeros(10,2); end;
if isempty(fjrow), fjrow=zeros(1,2); end;
if isempty(fjtj), fjtj=zeros(1,3); end;
if isempty(fvec), fvec=zeros(1,10); end;
if isempty(wa), wa=zeros(1,40); end;
if isempty(x), x=zeros(1,2); end;
if isempty(iw), iw=zeros(1,2); end;
if( kprint>=2 )
writef(lun,['1', '\n ' ,' Test SNLS1E, SNLS1 and SCOV' ' \n']);
end;
%format ('1'/' Test SNLS1E, SNLS1 and SCOV');
ipass = 1;
infos = 1;
fnorms = 1.1151779e+01;
m = 10;
n = 2;
lwa = 40;
ldfjac = 10;
nprint = -1;
iflag = 1;
zero = 0.0e0;
one = 1.0e0;
tol = sqrt(40.0e0.*r1mach(4));
tol2 = sqrt(tol);
iopt = 2;
x(1) = 3.0e-1;
x(2) = 4.0e-1;
[dumvar1,iopt,m,n,x,fvec,tol,nprint,info,iw,wa,lwa]=snls1e(@fcn2,iopt,m,n,x,fvec,tol,nprint,info,iw,wa,lwa);
[fnorm ,m,fvec]=enorm(m,fvec);
if( info==infos && abs(fnorm-fnorms)./fnorms<=tol )
fatal = false;
if( kprint>=3 )
[lun]=pass(lun,1,1);
end;
else;
ipass = 0;
fatal = true;
if( kprint>=2 )
[lun]=pass(lun,1,0);
end;
end;
if((fatal && kprint>=2) || kprint>=3 )
writef(lun,[' EXPECTED VALUE OF INFO AND RESIDUAL NORM','%5i','%20.9f', '\n ' ,' RETURNED VALUE OF INFO AND RESIDUAL NORM','%5i','%20.9f', '\n ' ' \n'],infos , fnorms , info , fnorm);
end;
sigma = fnorm.*fnorm./(m-n);
iflag = 2;
[iflag,m,n,x,fvec,fjac,ldfjac]=fcn2(iflag,m,n,x,fvec,fjac,ldfjac);
for i = 1 : 3;
fjtj(i) = zero;
end; i = fix(3+1);
for i = 1 : m;
fjtj(1) = fjtj(1) + fjac(i,1).^2;
fjtj(2) = fjtj(2) + fjac(i,1).*fjac(i,2);
fjtj(3) = fjtj(3) + fjac(i,2).^2;
end; i = fix(m+1);
[dumvar1,iopt,m,n,x,fvec,fjac,ldfjac,info,dumvar10,dumvar11,dumvar12,dumvar13]=scov(@fcn2,iopt,m,n,x,fvec,fjac,ldfjac,info,wa(sub2ind(size(wa),max(1,1)):end),wa(sub2ind(size(wa),max(n+1,1)):end),wa(sub2ind(size(wa),max(2.*n+1,1)):end),wa(sub2ind(size(wa),max(3.*n+1,1)):end)); dumvar10i=find((wa(sub2ind(size(wa),max(1,1)):end))~=(dumvar10));dumvar11i=find((wa(sub2ind(size(wa),max(n+1,1)):end))~=(dumvar11));dumvar12i=find((wa(sub2ind(size(wa),max(2.*n+1,1)):end))~=(dumvar12));dumvar13i=find((wa(sub2ind(size(wa),max(3.*n+1,1)):end))~=(dumvar13)); wa(1-1+dumvar10i)=dumvar10(dumvar10i); wa(n+1-1+dumvar11i)=dumvar11(dumvar11i); wa(2.*n+1-1+dumvar12i)=dumvar12(dumvar12i); wa(3.*n+1-1+dumvar13i)=dumvar13(dumvar13i);
temp1 =(fjtj(1).*fjac(1,1)+fjtj(2).*fjac(1,2))./sigma;
temp2 =(fjtj(1).*fjac(1,2)+fjtj(2).*fjac(2,2))./sigma;
temp3 =(fjtj(2).*fjac(1,2)+fjtj(3).*fjac(2,2))./sigma;
if( info==infos && abs(temp1-one)<tol2 && abs(temp2)<tol2 && abs(temp3-one)<tol2 )
fatal = false;
if( kprint>=3 )
[lun]=pass(lun,2,1);
end;
else;
ipass = 0;
fatal = true;
if( kprint>=2 )
[lun]=pass(lun,2,0);
end;
end;
if((fatal && kprint>=2) || kprint>=3 )
writef(lun,[' EXPECTED AND RETURNED VALUE OF INFO','%5i',repmat(' ',1,10),'%5i', '\n ' ,' RETURNED PRODUCT OF (J-TRANS*J)*COVARIANCE MATRIX/SIGMA', '\n ' ,' (SHOULD = THE IDENTITY -- 1.0, 0.0, 1.0)', '\n ' ,repmat('%20.9f',1,3), '\n ' ' \n'],infos , info , temp1 , temp2 , temp3);
end;
iopt = 1;
x(1) = 3.0e-1;
x(2) = 4.0e-1;
[dumvar1,iopt,m,n,x,fvec,tol,nprint,info,iw,wa,lwa]=snls1e(@fcn1,iopt,m,n,x,fvec,tol,nprint,info,iw,wa,lwa);
[fnorm ,m,fvec]=enorm(m,fvec);
if( info==infos && abs(fnorm-fnorms)./fnorms<=tol )
fatal = false;
if( kprint>=3 )
[lun]=pass(lun,3,1);
end;
else;
ipass = 0;
fatal = true;
if( kprint>=2 )
[lun]=pass(lun,3,0);
end;
end;
if((fatal && kprint>=2) || kprint>=3 )
writef(lun,[' EXPECTED VALUE OF INFO AND RESIDUAL NORM','%5i','%20.9f', '\n ' ,' RETURNED VALUE OF INFO AND RESIDUAL NORM','%5i','%20.9f', '\n ' ' \n'],infos , fnorms , info , fnorm);
end;
sigma = fnorm.*fnorm./(m-n);
iflag = 1;
[dumvar1,m,n,x,fvec,fjac,ldfjac,iflag,zero,wa]=fdjac3(@fcn1,m,n,x,fvec,fjac,ldfjac,iflag,zero,wa);
for i = 1 : 3;
fjtj(i) = zero;
end; i = fix(3+1);
for i = 1 : m;
fjtj(1) = fjtj(1) + fjac(i,1).^2;
fjtj(2) = fjtj(2) + fjac(i,1).*fjac(i,2);
fjtj(3) = fjtj(3) + fjac(i,2).^2;
end; i = fix(m+1);
[dumvar1,iopt,m,n,x,fvec,fjac,ldfjac,info,dumvar10,dumvar11,dumvar12,dumvar13]=scov(@fcn1,iopt,m,n,x,fvec,fjac,ldfjac,info,wa(sub2ind(size(wa),max(1,1)):end),wa(sub2ind(size(wa),max(n+1,1)):end),wa(sub2ind(size(wa),max(2.*n+1,1)):end),wa(sub2ind(size(wa),max(3.*n+1,1)):end)); dumvar10i=find((wa(sub2ind(size(wa),max(1,1)):end))~=(dumvar10));dumvar11i=find((wa(sub2ind(size(wa),max(n+1,1)):end))~=(dumvar11));dumvar12i=find((wa(sub2ind(size(wa),max(2.*n+1,1)):end))~=(dumvar12));dumvar13i=find((wa(sub2ind(size(wa),max(3.*n+1,1)):end))~=(dumvar13)); wa(1-1+dumvar10i)=dumvar10(dumvar10i); wa(n+1-1+dumvar11i)=dumvar11(dumvar11i); wa(2.*n+1-1+dumvar12i)=dumvar12(dumvar12i); wa(3.*n+1-1+dumvar13i)=dumvar13(dumvar13i);
temp1 =(fjtj(1).*fjac(1,1)+fjtj(2).*fjac(1,2))./sigma;
temp2 =(fjtj(1).*fjac(1,2)+fjtj(2).*fjac(2,2))./sigma;
temp3 =(fjtj(2).*fjac(1,2)+fjtj(3).*fjac(2,2))./sigma;
if( info==infos && abs(temp1-one)<tol2 && abs(temp2)<tol2 && abs(temp3-one)<tol2 )
fatal = false;
if( kprint>=3 )
[lun]=pass(lun,4,1);
end;
else;
ipass = 0;
fatal = true;
if( kprint>=2 )
[lun]=pass(lun,4,0);
end;
end;
if((fatal && kprint>=2) || kprint>=3 )
writef(lun,[' EXPECTED AND RETURNED VALUE OF INFO','%5i',repmat(' ',1,10),'%5i', '\n ' ,' RETURNED PRODUCT OF (J-TRANS*J)*COVARIANCE MATRIX/SIGMA', '\n ' ,' (SHOULD = THE IDENTITY -- 1.0, 0.0, 1.0)', '\n ' ,repmat('%20.9f',1,3), '\n ' ' \n'],infos , info , temp1 , temp2 , temp3);
end;
iopt = 3;
x(1) = 3.0e-1;
x(2) = 4.0e-1;
[dumvar1,iopt,m,n,x,fvec,tol,nprint,info,iw,wa,lwa]=snls1e(@fcn3,iopt,m,n,x,fvec,tol,nprint,info,iw,wa,lwa);
[fnorm ,m,fvec]=enorm(m,fvec);
if( info==infos && abs(fnorm-fnorms)./fnorms<=tol )
fatal = false;
if( kprint>=3 )
[lun]=pass(lun,5,1);
end;
else;
ipass = 0;
fatal = true;
if( kprint>=2 )
[lun]=pass(lun,5,0);
end;
end;
if((fatal && kprint>=2) || kprint>=3 )
writef(lun,[' EXPECTED VALUE OF INFO AND RESIDUAL NORM','%5i','%20.9f', '\n ' ,' RETURNED VALUE OF INFO AND RESIDUAL NORM','%5i','%20.9f', '\n ' ' \n'],infos , fnorms , info , fnorm);
end;
sigma = fnorm.*fnorm./(m-n);
for i = 1 : 3;
fjtj(i) = zero;
end; i = fix(3+1);
iflag = 3;
for i = 1 : m;
[iflag,m,n,x,fvec,fjrow,i]=fcn3(iflag,m,n,x,fvec,fjrow,i);
fjtj(1) = fjtj(1) + fjrow(1).^2;
fjtj(2) = fjtj(2) + fjrow(1).*fjrow(2);
fjtj(3) = fjtj(3) + fjrow(2).^2;
end; i = fix(m+1);
[dumvar1,iopt,m,n,x,fvec,fjac,ldfjac,info,dumvar10,dumvar11,dumvar12,dumvar13]=scov(@fcn3,iopt,m,n,x,fvec,fjac,ldfjac,info,wa(sub2ind(size(wa),max(1,1)):end),wa(sub2ind(size(wa),max(n+1,1)):end),wa(sub2ind(size(wa),max(2.*n+1,1)):end),wa(sub2ind(size(wa),max(3.*n+1,1)):end)); dumvar10i=find((wa(sub2ind(size(wa),max(1,1)):end))~=(dumvar10));dumvar11i=find((wa(sub2ind(size(wa),max(n+1,1)):end))~=(dumvar11));dumvar12i=find((wa(sub2ind(size(wa),max(2.*n+1,1)):end))~=(dumvar12));dumvar13i=find((wa(sub2ind(size(wa),max(3.*n+1,1)):end))~=(dumvar13)); wa(1-1+dumvar10i)=dumvar10(dumvar10i); wa(n+1-1+dumvar11i)=dumvar11(dumvar11i); wa(2.*n+1-1+dumvar12i)=dumvar12(dumvar12i); wa(3.*n+1-1+dumvar13i)=dumvar13(dumvar13i);
temp1 =(fjtj(1).*fjac(1,1)+fjtj(2).*fjac(1,2))./sigma;
temp2 =(fjtj(1).*fjac(1,2)+fjtj(2).*fjac(2,2))./sigma;
temp3 =(fjtj(2).*fjac(1,2)+fjtj(3).*fjac(2,2))./sigma;
if( info==infos && abs(temp1-one)<tol2 && abs(temp2)<tol2 && abs(temp3-one)<tol2 )
fatal = false;
if( kprint>=3 )
[lun]=pass(lun,6,1);
end;
else;
ipass = 0;
fatal = true;
if( kprint>=2 )
[lun]=pass(lun,6,0);
end;
end;
if((fatal && kprint>=2) || kprint>=3 )
writef(lun,[' EXPECTED AND RETURNED VALUE OF INFO','%5i',repmat(' ',1,10),'%5i', '\n ' ,' RETURNED PRODUCT OF (J-TRANS*J)*COVARIANCE MATRIX/SIGMA', '\n ' ,' (SHOULD = THE IDENTITY -- 1.0, 0.0, 1.0)', '\n ' ,repmat('%20.9f',1,3), '\n ' ' \n'],infos , info , temp1 , temp2 , temp3);
end;
[kontrl]=xgetf(kontrl);
if( kprint<=2 )
xsetf(0);
else;
xsetf(1);
end;
fatal = false;
xerclr;
if( kprint>=3 )
writef(lun,[ '\n ' ,' TRIGGER 2 ERROR MESSAGES', '\n ' ' \n']);
end;
%format [' TRIGGER 2 ERROR MESSAGES',];
lwa = 35;
iopt = 2;
x(1) = 3.0e-1;
x(2) = 4.0e-1;
[dumvar1,iopt,m,n,x,fvec,tol,nprint,info,iw,wa,lwa]=snls1e(@fcn2,iopt,m,n,x,fvec,tol,nprint,info,iw,wa,lwa);
if( info~=0 || numxer(nerr)~=2 )
fatal = true;
end;
m = 0;
[dumvar1,iopt,m,n,x,fvec,fjac,ldfjac,info,dumvar10,dumvar11,dumvar12,dumvar13]=scov(@fcn2,iopt,m,n,x,fvec,fjac,ldfjac,info,wa(sub2ind(size(wa),max(1,1)):end),wa(sub2ind(size(wa),max(n+1,1)):end),wa(sub2ind(size(wa),max(2.*n+1,1)):end),wa(sub2ind(size(wa),max(3.*n+1,1)):end)); dumvar10i=find((wa(sub2ind(size(wa),max(1,1)):end))~=(dumvar10));dumvar11i=find((wa(sub2ind(size(wa),max(n+1,1)):end))~=(dumvar11));dumvar12i=find((wa(sub2ind(size(wa),max(2.*n+1,1)):end))~=(dumvar12));dumvar13i=find((wa(sub2ind(size(wa),max(3.*n+1,1)):end))~=(dumvar13)); wa(1-1+dumvar10i)=dumvar10(dumvar10i); wa(n+1-1+dumvar11i)=dumvar11(dumvar11i); wa(2.*n+1-1+dumvar12i)=dumvar12(dumvar12i); wa(3.*n+1-1+dumvar13i)=dumvar13(dumvar13i);
if( info~=0 || numxer(nerr)~=2 )
fatal = true;
end;
[kontrl]=xsetf(kontrl);
if( fatal )
ipass = 0;
if( kprint>=2 )
writef(lun,[' AT LEAST ONE INCORRECT ARGUMENT TEST FAILED' ' \n']);
%format (' AT LEAST ONE INCORRECT ARGUMENT TEST FAILED');
end;
elseif( kprint>=3 ) ;
writef(lun,[' ALL INCORRECT ARGUMENT TESTS PASSED' ' \n']);
%format (' ALL INCORRECT ARGUMENT TESTS PASSED');
end;
if( ipass==1 && kprint>=2 )
writef(lun,[ '\n ' ,' ***SNLS1E PASSED ALL TESTS**' ' \n']);
end;
%format [' ***SNLS1E PASSED ALL TESTS**');
if( ipass==0 && kprint>=1 )
writef(lun,[ '\n ' ,' **SNLS1E FAILED SOME TESTS**' ' \n']);
end;
%format [' **SNLS1E FAILED SOME TESTS**');
return;
%format (' EXPECTED VALUE OF INFO AND RESIDUAL NORM',i5,e20.9/' RETURNED VALUE OF INFO AND RESIDUAL NORM',i5,e20.9];
%format (' EXPECTED AND RETURNED VALUE OF INFO',i5,10X,i5/' RETURNED PRODUCT OF (J-TRANS*J)*COVARIANCE MATRIX/SIGMA'/' (SHOULD = THE IDENTITY -- 1.0, 0.0, 1.0)'/3E20.9];
end %subroutine snls1q
