function [lun,kprint,ipass]=pfitqx(lun,kprint,ipass);
persistent a i icnt itest_v kontrl m maxord tc w x y yfit yp ;
if isempty(kontrl), kontrl=0; end;
global check_1; if isempty(check_1), check_1=0; end;
global check_3; if isempty(check_3), check_3=0; end;
global check_4; if isempty(check_4), check_4=0; end;
global check_5; if isempty(check_5), check_5=0; end;
global check_8; if isempty(check_8), check_8=0; end;
global check_9; if isempty(check_9), check_9=0; end;
global check_7; if isempty(check_7), check_7=0; end;
global check_6; if isempty(check_6), check_6=0; end;
global check_2; if isempty(check_2), check_2=zeros(1,11); end;
if isempty(yfit), yfit=0; end;
if isempty(i), i=0; end;
if isempty(icnt), icnt=0; end;
if isempty(m), m=0; end;
if isempty(maxord), maxord=0; end;
if isempty(a), a=zeros(1,97); end;
if isempty(tc), tc=zeros(1,5); end;
if isempty(w), w=zeros(1,11); end;
if isempty(x), x=zeros(1,11); end;
if isempty(y), y=zeros(1,11); end;
if isempty(yp), yp=zeros(1,5); end;
if isempty(itest_v), itest_v=zeros(1,9); end;
% common :: ;
%% common /check / eps , r , rp , sveps , tol , nordp , nord , ierp ,ierr;
%% common /check / check_1 , check_2 , check_3 , check_4 , check_5 , check_6 , check_7 , check_8 ,check_9;
if( kprint>=2 )
writef(lun,['1', '\n ' ,' Test POLFIT, PCOEF and PVALUE' ' \n']);
end;
for i = 1 : 9;
itest_v(i) = 0;
end; i = fix(9+1);
icnt = 0;
check_5 = sqrt(r1mach(4));
m = 11;
for i = 1 : m;
x(i) = i - 6;
y(i) = x(i).^4;
end; i = fix(m+1);
w(1) = -1.0e0;
check_1 = -0.01e0;
check_4 = check_1;
maxord = 8;
check_6 = 4;
check_3 = 625.0e0;
check_8 = 1;
[m,x,y,w,maxord,check_7,check_1,check_2,check_9,a]=polfit(m,x,y,w,maxord,check_7,check_1,check_2,check_9,a);
[icnt,itest_v]=cmpare(icnt,itest_v);
if( kprint~=0 )
if( kprint~=1 || itest_v(icnt)~=1 )
writef(lun,[' Exercise POLFIT' ' \n']);
writef(lun,[' Input EPS is negative - specified significance level' ' \n']);
if( kprint>2 || itest_v(icnt)~=1 )
writef(lun,[' Input EPS = ','%15.8f',' correct order = ','%3i',' R(1) = ','%15.8f',' IERR = ','%1i' ' \n'], check_4 , check_6 , check_3 , check_8);
writef(lun,[' Output EPS = ','%15.8f',' computed order = ','%3i',' R(1) = ','%15.8f',' IERR = ','%1i' ' \n'], check_1 , check_7 , check_2(11) , check_9);
end;
[lun,icnt,itest_v(icnt)]=pass(lun,icnt,itest_v(icnt));
end;
end;
check_1 = -1.0e0;
check_4 = check_1;
[m,x,y,w,maxord,check_7,check_1,check_2,check_9,a]=polfit(m,x,y,w,maxord,check_7,check_1,check_2,check_9,a);
[icnt,itest_v]=cmpare(icnt,itest_v);
if( kprint~=0 )
if( kprint~=1 || itest_v(icnt)~=1 )
writef(lun,[ '\n ' ,' Input EPS is negative - computed significance level' ' \n']);
if( kprint>2 || itest_v(icnt)~=1 )
writef(lun,[' Maximum order = ','%2i' ' \n'], maxord);
writef(lun,[' Input EPS = ','%15.8f',' correct order = ','%3i',' R(1) = ','%15.8f',' IERR = ','%1i' ' \n'], check_4 , check_6 , check_3 , check_8);
writef(lun,[' Output EPS = ','%15.8f',' computed order = ','%3i',' R(1) = ','%15.8f',' IERR = ','%1i' ' \n'], check_1 , check_7 , check_2(11) , check_9);
end;
[lun,icnt,itest_v(icnt)]=pass(lun,icnt,itest_v(icnt));
end;
end;
w(1) = -1.0e0;
check_1 = 0.0e0;
check_4 = check_1;
check_6 = 5;
maxord = 5;
[m,x,y,w,maxord,check_7,check_1,check_2,check_9,a]=polfit(m,x,y,w,maxord,check_7,check_1,check_2,check_9,a);
[icnt,itest_v]=cmpare(icnt,itest_v);
if( kprint~=0 )
if( kprint~=1 || itest_v(icnt)~=1 )
writef(lun,[ '\n ' ,' Input EPS is zero' ' \n']);
if( kprint>2 || itest_v(icnt)~=1 )
writef(lun,[' Maximum order = ','%2i' ' \n'], maxord);
writef(lun,[' Input EPS = ','%15.8f',' correct order = ','%3i',' R(1) = ','%15.8f',' IERR = ','%1i' ' \n'], check_4 , check_6 , check_3 , check_8);
writef(lun,[' Output EPS = ','%15.8f',' computed order = ','%3i',' R(1) = ','%15.8f',' IERR = ','%1i' ' \n'], check_1 , check_7 , check_2(11) , check_9);
end;
[lun,icnt,itest_v(icnt)]=pass(lun,icnt,itest_v(icnt));
end;
end;
check_8 = 1;
check_6 = 4;
check_1 = 75.0e0.*r1mach(4);
check_4 = check_1;
[m,x,y,w,maxord,check_7,check_1,check_2,check_9,a]=polfit(m,x,y,w,maxord,check_7,check_1,check_2,check_9,a);
[icnt,itest_v]=cmpare(icnt,itest_v);
if( kprint~=0 )
if( kprint~=1 || itest_v(icnt)~=1 )
writef(lun,[ '\n ' ,' Input EPS is positive' ' \n']);
if( kprint>2 || itest_v(icnt)~=1 )
writef(lun,[' Maximum order = ','%2i' ' \n'], maxord);
writef(lun,[' Input EPS = ','%15.8f',' correct order = ','%3i',' R(1) = ','%15.8f',' IERR = ','%1i' ' \n'], check_4 , check_6 , check_3 , check_8);
writef(lun,[' Output EPS = ','%15.8f',' computed order = ','%3i',' R(1) = ','%15.8f',' IERR = ','%1i' ' \n'], check_1 , check_7 , check_2(11) , check_9);
end;
[lun,icnt,itest_v(icnt)]=pass(lun,icnt,itest_v(icnt));
end;
end;
check_8 = 2;
m = -2;
[kontrl]=xgetf(kontrl);
if( kprint<=2 )
xsetf(0);
else;
xsetf(1);
end;
xerclr;
if( kprint>=3 )
writef(lun,[ '\n ' ,' Invalid input' ' \n']);
end;
%format [' Invalid input');
[m,x,y,w,maxord,check_7,check_1,check_2,check_9,a]=polfit(m,x,y,w,maxord,check_7,check_1,check_2,check_9,a);
icnt = fix(icnt + 1);
if( check_9==2 )
itest_v(icnt) = 1;
if( kprint>=3 )
writef(lun,[' POLFIT incorrect argument test ','%s', '\n ' ,' IERR should be 2. It is ','%4i' ' \n'], 'PASSED' , check_9);
end;
elseif( kprint>=2 ) ;
writef(lun,[' POLFIT incorrect argument test ','%s', '\n ' ,' IERR should be 2. It is ','%4i' ' \n'], 'FAILED' , check_9);
end;
if( kprint~=0 )
if( kprint~=1 || itest_v(icnt)~=1 )
if( kprint<=2 && itest_v(icnt)==1 )
end;
[lun,icnt,itest_v(icnt)]=pass(lun,icnt,itest_v(icnt));
xerclr;
[kontrl]=xsetf(kontrl);
end;
end;
m = 11;
w(1) = -1.0e0;
check_1 = 5.0e0.*r1mach(4);
check_4 = check_1;
check_3 = 553.0e0;
maxord = 2;
check_8 = 3;
check_6 = 2;
[m,x,y,w,maxord,check_7,check_1,check_2,check_9,a]=polfit(m,x,y,w,maxord,check_7,check_1,check_2,check_9,a);
[icnt,itest_v]=cmpare(icnt,itest_v);
if( kprint~=0 )
if( kprint~=1 || itest_v(icnt)~=1 )
writef(lun,[ '\n ' ,' Cannot meet RMS error requirement' ' \n']);
if( kprint>2 || itest_v(icnt)~=1 )
writef(lun,[' Maximum order = ','%2i' ' \n'], maxord);
writef(lun,[' Input EPS = ','%15.8f',' correct order = ','%3i',' R(1) = ','%15.8f',' IERR = ','%1i' ' \n'], check_4 , check_6 , check_3 , check_8);
writef(lun,[' Output EPS = ','%15.8f',' computed order = ','%3i',' R(1) = ','%15.8f',' IERR = ','%1i' ' \n'], check_1 , check_7 , check_2(11) , check_9);
end;
[lun,icnt,itest_v(icnt)]=pass(lun,icnt,itest_v(icnt));
end;
end;
check_6 = 4;
check_8 = 4;
check_3 = 625.0e0;
check_1 = -0.01e0;
check_4 = check_1;
maxord = 5;
[m,x,y,w,maxord,check_7,check_1,check_2,check_9,a]=polfit(m,x,y,w,maxord,check_7,check_1,check_2,check_9,a);
[icnt,itest_v]=cmpare(icnt,itest_v);
if( kprint~=0 )
if( kprint~=1 || itest_v(icnt)~=1 )
writef(lun,[ '\n ' ,' Cannot satisfy statistical test' ' \n']);
if( kprint>2 || itest_v(icnt)~=1 )
writef(lun,[' Maximum order = ','%2i' ' \n'], maxord);
writef(lun,[' Input EPS = ','%15.8f',' correct order = ','%3i',' R(1) = ','%15.8f',' IERR = ','%1i' ' \n'], check_4 , check_6 , check_3 , check_8);
writef(lun,[' Output EPS = ','%15.8f',' computed order = ','%3i',' R(1) = ','%15.8f',' IERR = ','%1i' ' \n'], check_1 , check_7 , check_2(11) , check_9);
end;
[lun,icnt,itest_v(icnt)]=pass(lun,icnt,itest_v(icnt));
end;
end;
maxord = 6;
check_1 = 0.0e0;
check_4 = check_1;
y(6) = 1.0e0;
for i = 1 : m;
w(i) = 1.0e0./(y(i).^2);
end; i = fix(m+1);
y(6) = 0.0e0;
[m,x,y,w,maxord,check_7,check_1,check_2,check_9,a]=polfit(m,x,y,w,maxord,check_7,check_1,check_2,check_9,a);
[dumvar1,dumvar2,tc,a]=pcoef(4,5.0e0,tc,a);
icnt = fix(icnt + 1);
if( abs(check_2(11)-tc(1))<=check_5 )
itest_v(icnt) = 1;
end;
if( kprint~=0 )
if( kprint~=1 || itest_v(icnt)~=1 )
writef(lun,[ '\n ' ,' Exercise PCOEF' ' \n']);
if( kprint>2 || itest_v(icnt)~=1 )
writef(lun,[ '\n ' ,' For C=1.0, correct coefficient = ','%15.8f',' computed = ','%15.8f' ' \n'], check_2(11), tc(1));
end;
[lun,icnt,itest_v(icnt)]=pass(lun,icnt,itest_v(icnt));
end;
end;
[dumvar1,dumvar2,x(8),yfit,yp,a]=pvalue(6,0,x(8),yfit,yp,a);
icnt = fix(icnt + 1);
if( abs(check_2(8)-yfit)<=check_5 )
itest_v(icnt) = 1;
end;
if( kprint~=0 )
if( kprint~=1 || itest_v(icnt)~=1 )
writef(lun,[ '\n ' ,' Exercise PVALUE' ' \n']);
writef(lun,[' Normal execution' ' \n']);
if( kprint>2 || itest_v(icnt)~=1 )
writef(lun,[' For X = ','%5.2f',' correct P(X) = ','%15.8f',' P(X) from PVALUE = ','%15.8f' ' \n'], x(8) ,check_2(8) , yfit);
end;
[lun,icnt,itest_v(icnt)]=pass(lun,icnt,itest_v(icnt));
end;
end;
ipass = 1;
for i = 1 : 9;
ipass = fix(ipass.*itest_v(i));
end; i = fix(9+1);
if( ipass==1 && kprint>=3 )
writef(lun,[ '\n ' ,' POLFIT PASSED ALL TESTS' ' \n']);
end;
if( ipass==0 && kprint>=2 )
writef(lun,[ '\n ' ,' POLFIT FAILED SOME TESTS****' ' \n']);
end;
return;
%format ('1'/' Test POLFIT, PCOEF and PVALUE');
%format (' Exercise POLFIT');
%format (' Input EPS is negative - specified significance level');
%format (' Input EPS = ',e15.8,' correct order = ',i3,' R(1) = ',e15.8,' IERR = ',i1);
%format (' Output EPS = ',e15.8,' computed order = ',i3,' R(1) = ',e15.8,' IERR = ',i1);
%format [' Input EPS is negative - computed significance level');
%format (' Maximum order = ',i2);
%format [' Input EPS is zero');
%format [' Input EPS is positive');
%format (' POLFIT incorrect argument test ',a/' IERR should be 2. It is ',i4);
%format [' Cannot meet RMS error requirement');
%format [' Cannot satisfy statistical test');
%format [' Exercise PCOEF');
%format [' For C=1.0, correct coefficient = ',e15.8,' computed = ',e15.8);
%format [' Exercise PVALUE');
%format (' Normal execution');
%format (' For X = ',f5.2,' correct P(X) = ',e15.8,' P(X) from PVALUE = ',e15.8);
%format [' POLFIT PASSED ALL TESTS');
%format [' POLFIT FAILED SOME TESTS****');
end %subroutine pfitqx