function [lun,kprint,ipass]=dfcqx(lun,kprint,ipass);
persistent bkpt check coefck coeff diff fatal firstCall i idigit ii iw j kontrl l last mode n nbkpt nconst ndata ndeg nderiv nerr nord nval one sddata t tol v w work xconst xdata xval yconst ydata zero ; if isempty(firstCall),firstCall=1;end;
if isempty(diff), diff=0; end;
if isempty(one), one=0; end;
if isempty(t), t=0; end;
if isempty(tol), tol=0; end;
if isempty(xval), xval=0; end;
if isempty(zero), zero=0; end;
if isempty(kontrl), kontrl=0; end;
if isempty(i), i=0; end;
if isempty(idigit), idigit=0; end;
if isempty(ii), ii=0; end;
if isempty(j), j=0; end;
if isempty(l), l=0; end;
if isempty(last), last=0; end;
if isempty(mode), mode=0; end;
if isempty(n), n=0; end;
if isempty(nbkpt), nbkpt=0; end;
if isempty(nconst), nconst=0; end;
if isempty(ndata), ndata=0; end;
if isempty(ndeg), ndeg=0; end;
if isempty(nerr), nerr=0; end;
if isempty(nord), nord=0; end;
if isempty(nval), nval=0; end;
if isempty(fatal), fatal=false; end;
if isempty(bkpt), bkpt=zeros(1,13); end;
if isempty(check), check=zeros(1,51); end;
if isempty(coefck), coefck=zeros(1,9); end;
if isempty(coeff), coeff=zeros(1,9); end;
if isempty(sddata), sddata=zeros(1,9); end;
if isempty(v), v=zeros(51,5); end;
if isempty(w), w=zeros(1,529); end;
if isempty(work), work=zeros(1,12); end;
if isempty(xconst), xconst=zeros(1,11); end;
if isempty(xdata), xdata=zeros(1,9); end;
if isempty(yconst), yconst=zeros(1,11); end;
if isempty(ydata), ydata=zeros(1,9); end;
if isempty(iw), iw=zeros(1,30); end;
if isempty(nderiv), nderiv=zeros(1,11); end;
if firstCall, xdata(1) =[0.15d0]; end;
if firstCall, xdata(2) =[0.27d0]; end;
if firstCall, xdata(3) =[0.33d0]; end;
if firstCall, xdata(4) =[0.40d0]; end;
if firstCall, xdata(5) =[0.43d0]; end;
if firstCall, xdata(6) =[0.47d0]; end;
if firstCall, xdata(7) =[0.53d0]; end;
if firstCall, xdata(8) =[0.58d0]; end;
if firstCall, xdata(9)=[0.63d0]; end;
if firstCall, ydata(1) =[0.025d0]; end;
if firstCall, ydata(2) =[0.05d0]; end;
if firstCall, ydata(3) =[0.13d0]; end;
if firstCall, ydata(4) =[0.27d0]; end;
if firstCall, ydata(5) =[0.37d0]; end;
if firstCall, ydata(6) =[0.47d0]; end;
if firstCall, ydata(7) =[0.64d0]; end;
if firstCall, ydata(8) =[0.77d0]; end;
if firstCall, ydata(9)=[0.87d0]; end;
if firstCall, sddata(1)=[0.015d0]; end;
if firstCall, ndata=[9]; end;
if firstCall, nord=[4]; end;
if firstCall, nbkpt=[13]; end;
if firstCall, last=[10]; end;
if firstCall, bkpt(1) =[-0.6d0]; end;
if firstCall, bkpt(2) =[-0.4d0]; end;
if firstCall, bkpt(3) =[-0.2d0]; end;
if firstCall, bkpt(4) =[0.0d0]; end;
if firstCall, bkpt(5) =[0.2d0]; end;
if firstCall, bkpt(6) =[0.4d0]; end;
if firstCall, bkpt(7) =[0.6d0]; end;
if firstCall, bkpt(8) =[0.8d0]; end;
if firstCall, bkpt(9) =[0.9d0]; end;
if firstCall, bkpt(10) =[1.0d0]; end;
if firstCall, bkpt(11) =[1.1d0]; end;
if firstCall, bkpt(12)=[1.2d0]; end;
if firstCall, bkpt(13)=[1.3d0]; end;
if firstCall, coefck(1) =[1.186380846d-13]; end;
if firstCall, coefck(2) =[-2.826166426d-14]; end;
if firstCall, coefck(3) =[-4.333929094d-15]; end;
if firstCall, coefck(4) =[1.722113311d-01]; end;
if firstCall, coefck(5) =[9.421965984d-01]; end;
if firstCall, coefck(6) =[9.684708719d-01]; end;
if firstCall, coefck(7) =[9.894902905d-01]; end;
if firstCall, coefck(8) =[1.005254855d+00]; end;
if firstCall, coefck(9)=[9.894902905d-01]; end;
if firstCall, check(1) =[2.095830752d-16]; end;
if firstCall, check(2) =[2.870188850d-05]; end;
if firstCall, check(3) =[2.296151081d-04]; end;
if firstCall, check(4) =[7.749509897d-04]; end;
if firstCall, check(5) =[1.836920865d-03]; end;
if firstCall, check(6) =[3.587736064d-03]; end;
if firstCall, check(7) =[6.199607918d-03]; end;
if firstCall, check(8) =[9.844747759d-03]; end;
if firstCall, check(9)=[1.469536692d-02]; end;
if firstCall, check(10) =[2.092367672d-02]; end;
if firstCall, check(11) =[2.870188851d-02]; end;
if firstCall, check(12) =[3.824443882d-02]; end;
if firstCall, check(13) =[4.993466504d-02]; end;
if firstCall, check(14) =[6.419812979d-02]; end;
if firstCall, check(15) =[8.146039566d-02]; end;
if firstCall, check(16) =[1.021470253d-01]; end;
if firstCall, check(17) =[1.266835812d-01]; end;
if firstCall, check(18)=[1.554956261d-01]; end;
if firstCall, check(19) =[1.890087225d-01]; end;
if firstCall, check(20) =[2.276484331d-01]; end;
if firstCall, check(21) =[2.718403204d-01]; end;
if firstCall, check(22) =[3.217163150d-01]; end;
if firstCall, check(23) =[3.762338189d-01]; end;
if firstCall, check(24) =[4.340566020d-01]; end;
if firstCall, check(25) =[4.938484342d-01]; end;
if firstCall, check(26) =[5.542730855d-01]; end;
if firstCall, check(27)=[6.139943258d-01]; end;
if firstCall, check(28) =[6.716759250d-01]; end;
if firstCall, check(29) =[7.259816530d-01]; end;
if firstCall, check(30) =[7.755752797d-01]; end;
if firstCall, check(31) =[8.191205752d-01]; end;
if firstCall, check(32) =[8.556270903d-01]; end;
if firstCall, check(33) =[8.854875002d-01]; end;
if firstCall, check(34) =[9.094402609d-01]; end;
if firstCall, check(35) =[9.282238286d-01]; end;
if firstCall, check(36)=[9.425766596d-01]; end;
if firstCall, check(37) =[9.532372098d-01]; end;
if firstCall, check(38) =[9.609439355d-01]; end;
if firstCall, check(39) =[9.664352927d-01]; end;
if firstCall, check(40) =[9.704497377d-01]; end;
if firstCall, check(41) =[9.737257265d-01]; end;
if firstCall, check(42) =[9.768786393d-01]; end;
if firstCall, check(43) =[9.800315521d-01]; end;
if firstCall, check(44) =[9.831844649d-01]; end;
if firstCall, check(45)=[9.863373777d-01]; end;
if firstCall, check(46) =[9.894902905d-01]; end;
if firstCall, check(47) =[9.926011645d-01]; end;
if firstCall, check(48) =[9.954598055d-01]; end;
if firstCall, check(49) =[9.978139804d-01]; end;
if firstCall, check(50) =[9.994114563d-01]; end;
if firstCall, check(51)=[1.000000000d+00]; end;
firstCall=0;
if( kprint>=2 )
writef(lun,['1', '\n ' ,' Test DFC' ' \n']);
end;
%format ('1'/' Test DFC');
ipass = 1;
sddata_orig=sddata; [ndata,sddata,dumvar3,dumvar4]=dcopy(ndata,sddata,0,sddata,1); sddata(dumvar4~=sddata_orig)=dumvar4(dumvar4~=sddata_orig);
zero = 0;
one = 1;
ndeg = fix(nord - 1);
nconst = 0;
t = bkpt(nord);
nconst = fix(nconst + 1);
xconst(nconst) = t;
yconst(nconst) = zero;
nderiv(nconst) = fix(2 + 4.*0);
nconst = fix(nconst + 1);
xconst(nconst) = t;
yconst(nconst) = zero;
nderiv(nconst) = fix(1 + 4.*1);
for i = 1 : 3;
l = fix(ndeg + i);
t = bkpt(l);
nconst = fix(nconst + 1);
xconst(nconst) = t;
yconst(nconst) = zero;
nderiv(nconst) = fix(1 + 4.*2);
end; i = fix(3+1);
nconst = fix(nconst + 1);
t = bkpt(last);
xconst(nconst) = t;
yconst(nconst) = one;
nderiv(nconst) = fix(2 + 4.*0);
nconst = fix(nconst + 1);
xconst(nconst) = bkpt(nord);
yconst(nconst) = bkpt(last);
nderiv(nconst) = fix(3 + 4.*1);
for i = 1 : 4;
nconst = fix(nconst + 1);
l = fix(last - 4 + i);
xconst(nconst) = bkpt(l);
yconst(nconst) = zero;
nderiv(nconst) = fix(0 + 4.*2);
end; i = fix(4+1);
idigit = -4;
if( kprint>=3 )
[nbkpt,bkpt,dumvar3,idigit]=dvout(nbkpt,bkpt,'('' ARRAY OF KNOTS.'')',idigit);
[ndata,xdata,dumvar3,idigit]=dvout(ndata,xdata,'('' INDEPENDENT VARIABLE VALUES'')',idigit);
[ndata,ydata,dumvar3,idigit]=dvout(ndata,ydata,'('' DEPENDENT VARIABLE VALUES'')',idigit);
[ndata,sddata,dumvar3,idigit]=dvout(ndata,sddata,'('' DEPENDENT VARIABLE UNCERTAINTY'')',idigit);
[nconst,xconst,dumvar3,idigit]=dvout(nconst,xconst,'('' INDEPENDENT VARIABLE CONSTRAINT VALUES'')',idigit);
[nconst,yconst,dumvar3,idigit]=dvout(nconst,yconst,'('' CONSTRAINT VALUES'')',idigit);
[nconst,nderiv,dumvar3,idigit]=ivout(nconst,nderiv,'('' CONSTRAINT INDICATOR'')',idigit);
end;
iw(1) = 529;
iw(2) = 30;
mode = 2;
[ndata,xdata,ydata,sddata,nord,nbkpt,bkpt,nconst,xconst,yconst,nderiv,mode,coeff,w,iw]=dfc(ndata,xdata,ydata,sddata,nord,nbkpt,bkpt,nconst,xconst,yconst,nderiv,mode,coeff,w,iw);
tol = max(7.0d0.*sqrt(d1mach(4)),1.0d-8);
diff = 0.0d0;
for i = 1 : ndata;
diff = max(diff,abs(coeff(i)-coefck(i)));
end; i = fix(ndata+1);
if( diff<=tol )
fatal = false;
if( kprint>=3 )
writef(lun,[ '\n ' ,' DFC PASSED TEST 1' ' \n']);
end;
%format [' DFC PASSED TEST 1');
else;
ipass = 0;
fatal = true;
if( kprint>=2 )
writef(lun,[ '\n ' ,' DFC FAILED TEST 1' ' \n']);
end;
%format [' DFC FAILED TEST 1');
end;
if((fatal && kprint>=2) || kprint>=3 )
[ndata,coefck,dumvar3,idigit]=dvout(ndata,coefck,['['' PREDICTED COEFFICIENTS OF THE B-SPLINE ','FROM SAMPLE'')'],idigit);
[ndata,coeff,dumvar3,idigit]=dvout(ndata,coeff,['['' COEFFICIENTS OF THE B-SPLINE COMPUTED ','BY DFC'')'],idigit);
end;
n = fix(nbkpt - nord);
nval = 51;
for i = 1 : nval;
xval = fix((i-1)./(nval-1));
ii = 1;
for j = 1 : 3;
[v(i,j+1) ,bkpt,coeff,n,nord,dumvar6,xval,ii,work]=dbvalu(bkpt,coeff,n,nord,j-1,xval,ii,work);
end; j = fix(3+1);
v(i,1) = xval;
v(i,5) = sqrt(dcv(xval,ndata,nconst,nord,nbkpt,bkpt,w));
end; i = fix(nval+1);
diff = 0.0d0;
for i = 1 : nval;
diff = max(diff,abs(v(i,2)-check(i)));
end; i = fix(nval+1);
if( diff<=tol )
fatal = false;
if( kprint>=3 )
writef(lun,[ '\n ' ,' DFC (AND DBVALU) PASSED TEST 2' ' \n']);
end;
%format [' DFC (AND DBVALU) PASSED TEST 2');
else;
ipass = 0;
fatal = true;
if( kprint>=2 )
writef(lun,[ '\n ' ,' DFC (AND DBVALU) FAILED TEST 2' ' \n']);
end;
%format [' DFC (AND DBVALU) FAILED TEST 2');
end;
if((fatal && kprint>=2) || kprint>=3 )
nval_orig=nval; [nval,dumvar2,dumvar3,v,dumvar5,idigit]=dmout(nval,5,nval,v,['(16X, ''X'', 10X, ''FNCN'', 8X,','''1ST D'', 7X, ''2ND D'', 7X, ''ERROR'')'],idigit); nval(dumvar3~=nval_orig)=dumvar3(dumvar3~=nval_orig);
writef(lun,[ '\n ' ,' VALUES SHOULD CORRESPOND TO THOSE IN ','SAND78-1291,',' P. 26' ' \n']);
%format [' VALUES SHOULD CORRESPOND TO THOSE IN ','SAND78-1291,',' P. 26');
end;
[kontrl]=xgetf(kontrl);
if( kprint<=2 )
xsetf(0);
else;
xsetf(1);
end;
fatal = false;
xerclr;
if( kprint>=3 )
writef(lun,[ '\n ' ,' TRIGGER 6 ERROR MESSAGES', '\n ' ' \n']);
end;
%format [' TRIGGER 6 ERROR MESSAGES',];
[ndata,xdata,ydata,sddata,dumvar5,nbkpt,bkpt,nconst,xconst,yconst,nderiv,mode,coeff,w,iw]=dfc(ndata,xdata,ydata,sddata,0,nbkpt,bkpt,nconst,xconst,yconst,nderiv,mode,coeff,w,iw);
if( numxer(nerr)~=2 )
fatal = true;
end;
xerclr;
[ndata,xdata,ydata,sddata,nord,dumvar6,bkpt,nconst,xconst,yconst,nderiv,mode,coeff,w,iw]=dfc(ndata,xdata,ydata,sddata,nord,0,bkpt,nconst,xconst,yconst,nderiv,mode,coeff,w,iw);
if( numxer(nerr)~=2 )
fatal = true;
end;
xerclr;
[dumvar1,xdata,ydata,sddata,nord,nbkpt,bkpt,nconst,xconst,yconst,nderiv,mode,coeff,w,iw]=dfc(-1,xdata,ydata,sddata,nord,nbkpt,bkpt,nconst,xconst,yconst,nderiv,mode,coeff,w,iw);
if( numxer(nerr)~=2 )
fatal = true;
end;
xerclr;
mode = 0;
[ndata,xdata,ydata,sddata,nord,nbkpt,bkpt,nconst,xconst,yconst,nderiv,mode,coeff,w,iw]=dfc(ndata,xdata,ydata,sddata,nord,nbkpt,bkpt,nconst,xconst,yconst,nderiv,mode,coeff,w,iw);
if( numxer(nerr)~=2 )
fatal = true;
end;
xerclr;
iw(1) = 10;
[ndata,xdata,ydata,sddata,nord,nbkpt,bkpt,nconst,xconst,yconst,nderiv,mode,coeff,w,iw]=dfc(ndata,xdata,ydata,sddata,nord,nbkpt,bkpt,nconst,xconst,yconst,nderiv,mode,coeff,w,iw);
if( numxer(nerr)~=2 )
fatal = true;
end;
xerclr;
iw(1) = 529;
iw(2) = 2;
[ndata,xdata,ydata,sddata,nord,nbkpt,bkpt,nconst,xconst,yconst,nderiv,mode,coeff,w,iw]=dfc(ndata,xdata,ydata,sddata,nord,nbkpt,bkpt,nconst,xconst,yconst,nderiv,mode,coeff,w,iw);
if( numxer(nerr)~=2 )
fatal = true;
end;
xerclr;
[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 ' ,' *DFC PASSED ALL TESTS**' ' \n']);
end;
%format [' *DFC PASSED ALL TESTS**');
if( ipass==0 && kprint>=1 )
writef(lun,[ '\n ' ,' DFC FAILED SOME TESTS**' ' \n']);
end;
%format [' DFC FAILED SOME TESTS**');
return;
end %subroutine dfcqx
