function [lun,kprint,ipass]=fcqx(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;
% intrinsic abs , real :: ;
if firstCall, xdata(1) =[0.15e0]; end;
if firstCall, xdata(2) =[0.27e0]; end;
if firstCall, xdata(3) =[0.33e0]; end;
if firstCall, xdata(4) =[0.40e0]; end;
if firstCall, xdata(5) =[0.43e0]; end;
if firstCall, xdata(6) =[0.47e0]; end;
if firstCall, xdata(7) =[0.53e0]; end;
if firstCall, xdata(8) =[0.58e0]; end;
if firstCall, xdata(9)=[0.63e0]; end;
if firstCall, ydata(1) =[0.025e0]; end;
if firstCall, ydata(2) =[0.05e0]; end;
if firstCall, ydata(3) =[0.13e0]; end;
if firstCall, ydata(4) =[0.27e0]; end;
if firstCall, ydata(5) =[0.37e0]; end;
if firstCall, ydata(6) =[0.47e0]; end;
if firstCall, ydata(7) =[0.64e0]; end;
if firstCall, ydata(8) =[0.77e0]; end;
if firstCall, ydata(9)=[0.87e0]; end;
if firstCall, sddata(1)=[0.015e0]; 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.6e0]; end;
if firstCall, bkpt(2) =[-0.4e0]; end;
if firstCall, bkpt(3) =[-0.2e0]; end;
if firstCall, bkpt(4) =[0.0e0]; end;
if firstCall, bkpt(5) =[0.2e0]; end;
if firstCall, bkpt(6) =[0.4e0]; end;
if firstCall, bkpt(7) =[0.6e0]; end;
if firstCall, bkpt(8) =[0.8e0]; end;
if firstCall, bkpt(9) =[0.9e0]; end;
if firstCall, bkpt(10) =[1.0e0]; end;
if firstCall, bkpt(11) =[1.1e0]; end;
if firstCall, bkpt(12)=[1.2e0]; end;
if firstCall, bkpt(13)=[1.3e0]; end;
if firstCall, coefck(1) =[1.186380846e-13]; end;
if firstCall, coefck(2) =[-2.826166426e-14]; end;
if firstCall, coefck(3) =[-4.333929094e-15]; end;
if firstCall, coefck(4) =[1.722113311e-01]; end;
if firstCall, coefck(5) =[9.421965984e-01]; end;
if firstCall, coefck(6) =[9.684708719e-01]; end;
if firstCall, coefck(7) =[9.894902905e-01]; end;
if firstCall, coefck(8) =[1.005254855e+00]; end;
if firstCall, coefck(9)=[9.894902905e-01]; end;
if firstCall, check(1) =[2.095830752e-16]; end;
if firstCall, check(2) =[2.870188850e-05]; end;
if firstCall, check(3) =[2.296151081e-04]; end;
if firstCall, check(4) =[7.749509897e-04]; end;
if firstCall, check(5) =[1.836920865e-03]; end;
if firstCall, check(6) =[3.587736064e-03]; end;
if firstCall, check(7) =[6.199607918e-03]; end;
if firstCall, check(8) =[9.844747759e-03]; end;
if firstCall, check(9)=[1.469536692e-02]; end;
if firstCall, check(10) =[2.092367672e-02]; end;
if firstCall, check(11) =[2.870188851e-02]; end;
if firstCall, check(12) =[3.824443882e-02]; end;
if firstCall, check(13) =[4.993466504e-02]; end;
if firstCall, check(14) =[6.419812979e-02]; end;
if firstCall, check(15) =[8.146039566e-02]; end;
if firstCall, check(16) =[1.021470253e-01]; end;
if firstCall, check(17) =[1.266835812e-01]; end;
if firstCall, check(18)=[1.554956261e-01]; end;
if firstCall, check(19) =[1.890087225e-01]; end;
if firstCall, check(20) =[2.276484331e-01]; end;
if firstCall, check(21) =[2.718403204e-01]; end;
if firstCall, check(22) =[3.217163150e-01]; end;
if firstCall, check(23) =[3.762338189e-01]; end;
if firstCall, check(24) =[4.340566020e-01]; end;
if firstCall, check(25) =[4.938484342e-01]; end;
if firstCall, check(26) =[5.542730855e-01]; end;
if firstCall, check(27)=[6.139943258e-01]; end;
if firstCall, check(28) =[6.716759250e-01]; end;
if firstCall, check(29) =[7.259816530e-01]; end;
if firstCall, check(30) =[7.755752797e-01]; end;
if firstCall, check(31) =[8.191205752e-01]; end;
if firstCall, check(32) =[8.556270903e-01]; end;
if firstCall, check(33) =[8.854875002e-01]; end;
if firstCall, check(34) =[9.094402609e-01]; end;
if firstCall, check(35) =[9.282238286e-01]; end;
if firstCall, check(36)=[9.425766596e-01]; end;
if firstCall, check(37) =[9.532372098e-01]; end;
if firstCall, check(38) =[9.609439355e-01]; end;
if firstCall, check(39) =[9.664352927e-01]; end;
if firstCall, check(40) =[9.704497377e-01]; end;
if firstCall, check(41) =[9.737257265e-01]; end;
if firstCall, check(42) =[9.768786393e-01]; end;
if firstCall, check(43) =[9.800315521e-01]; end;
if firstCall, check(44) =[9.831844649e-01]; end;
if firstCall, check(45)=[9.863373777e-01]; end;
if firstCall, check(46) =[9.894902905e-01]; end;
if firstCall, check(47) =[9.926011645e-01]; end;
if firstCall, check(48) =[9.954598055e-01]; end;
if firstCall, check(49) =[9.978139804e-01]; end;
if firstCall, check(50) =[9.994114563e-01]; end;
if firstCall, check(51)=[1.000000000e+00]; end;
firstCall=0;
if( kprint>=2 )
writef(lun,['1', '\n ' ,' Test FC' ' \n']);
end;
%format ('1'/' Test FC');
ipass = 1;
sddata_orig=sddata; [ndata,sddata,dumvar3,dumvar4]=scopy(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]=svout(nbkpt,bkpt,'('' ARRAY OF KNOTS.'')',idigit);
[ndata,xdata,dumvar3,idigit]=svout(ndata,xdata,'('' INDEPENDENT VARIABLE VALUES'')',idigit);
[ndata,ydata,dumvar3,idigit]=svout(ndata,ydata,'('' DEPENDENT VARIABLE VALUES'')',idigit);
[ndata,sddata,dumvar3,idigit]=svout(ndata,sddata,'('' DEPENDENT VARIABLE UNCERTAINTY'')',idigit);
[nconst,xconst,dumvar3,idigit]=svout(nconst,xconst,'('' INDEPENDENT VARIABLE CONSTRAINT VALUES'')',idigit);
[nconst,yconst,dumvar3,idigit]=svout(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]=fc(ndata,xdata,ydata,sddata,nord,nbkpt,bkpt,nconst,xconst,yconst,nderiv,mode,coeff,w,iw);
tol = 7.0e0.*sqrt(r1mach(4));
diff = 0.0e0;
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 ' ,' FC PASSED TEST 1' ' \n']);
end;
%format [' FC PASSED TEST 1');
else;
ipass = 0;
fatal = true;
if( kprint>=2 )
writef(lun,[ '\n ' ,' FC FAILED TEST 1' ' \n']);
end;
%format [' FC FAILED TEST 1');
end;
if((fatal && kprint>=2) || kprint>=3 )
[ndata,coefck,dumvar3,idigit]=svout(ndata,coefck,['['' PREDICTED COEFFICIENTS OF THE B-SPLINE ','FROM SAMPLE'')'],idigit);
[ndata,coeff,dumvar3,idigit]=svout(ndata,coeff,['['' COEFFICIENTS OF THE B-SPLINE COMPUTED ','BY FC'')'],idigit);
end;
n = fix(nbkpt - nord);
nval = 51;
for i = 1 : nval;
xval = real(i-1)./(nval-1);
ii = 1;
for j = 1 : 3;
[v(i,j+1) ,bkpt,coeff,n,nord,dumvar6,xval,ii,work]=bvalu(bkpt,coeff,n,nord,j-1,xval,ii,work);
end; j = fix(3+1);
v(i,1) = xval;
v(i,5) = sqrt(cv(xval,ndata,nconst,nord,nbkpt,bkpt,w));
end; i = fix(nval+1);
diff = 0.0e0;
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 ' ,' FC (AND BVALU) PASSED TEST 2' ' \n']);
end;
%format [' FC (AND BVALU) PASSED TEST 2');
else;
ipass = 0;
fatal = true;
if( kprint>=2 )
writef(lun,[ '\n ' ,' FC (AND BVALU) FAILED TEST 2' ' \n']);
end;
%format [' FC (AND BVALU) FAILED TEST 2');
end;
if((fatal && kprint>=2) || kprint>=3 )
nval_orig=nval; [nval,dumvar2,dumvar3,v,dumvar5,idigit]=smout(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]=fc(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]=fc(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]=fc(-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]=fc(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]=fc(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]=fc(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 ' ,' **FC PASSED ALL TESTS**' ' \n']);
end;
%format [' **FC PASSED ALL TESTS**');
if( ipass==0 && kprint>=1 )
writef(lun,[ '\n ' ,' *FC FAILED SOME TESTS**' ' \n']);
end;
%format [' *FC FAILED SOME TESTS**');
return;
end %subroutine fcqx
