[lun,kprint,ipass]=bspck(lun,kprint,ipass);

function [lun,kprint,ipass]=bspck(lun,kprint,ipass);
persistent adif atol bc bquad bv c cc den dn er fatal fbcl fbcr i ibcl ibcr id ierr iknt ileft ilo inbv inev inppv iwork j jhigh jj k kk knt kntopt kontrl ldc ldcc lxi mflag n ndata nerr nmk nn pi pquad q qq qsave quad spv sv t tol w x x1 x2 xi xl xx y ; 

if isempty(atol), atol=0; end;
if isempty(bquad), bquad=0; end;
if isempty(bv), bv=0; end;
if isempty(den), den=0; end;
if isempty(dn), dn=0; end;
if isempty(er), er=0; end;
if isempty(fbcl), fbcl=0; end;
if isempty(fbcr), fbcr=0; end;
if isempty(pi), pi=0; end;
if isempty(pquad), pquad=0; end;
if isempty(quad), quad=0; end;
if isempty(spv), spv=0; end;
if isempty(tol), tol=0; end;
if isempty(x1), x1=0; end;
if isempty(x2), x2=0; end;
if isempty(xl), xl=0; end;
if isempty(xx), xx=0; end;
if isempty(i), i=0; end;
if isempty(ibcl), ibcl=0; end;
if isempty(ibcr), ibcr=0; end;
if isempty(id), id=0; end;
if isempty(ierr), ierr=0; end;
if isempty(iknt), iknt=0; end;
if isempty(ileft), ileft=0; end;
if isempty(ilo), ilo=0; end;
if isempty(inbv), inbv=0; end;
if isempty(inev), inev=0; end;
if isempty(inppv), inppv=0; end;
if isempty(iwork), iwork=0; end;
if isempty(j), j=0; end;
if isempty(jhigh), jhigh=0; end;
if isempty(jj), jj=0; end;
if isempty(k), k=0; end;
if isempty(kk), kk=0; end;
if isempty(knt), knt=0; end;
if isempty(kntopt), kntopt=0; end;
if isempty(kontrl), kontrl=0; end;
if isempty(ldc), ldc=0; end;
if isempty(ldcc), ldcc=0; end;
if isempty(lxi), lxi=0; end;
if isempty(mflag), mflag=0; end;
if isempty(n), n=0; end;
if isempty(ndata), ndata=0; end;
if isempty(nerr), nerr=0; end;
if isempty(nmk), nmk=0; end;
if isempty(nn), nn=0; end;
if isempty(fatal), fatal=false; end;
if isempty(adif), adif=zeros(1,52); end;
if isempty(bc), bc=zeros(1,13); end;
if isempty(c), c=zeros(4,11); end;
if isempty(cc), cc=zeros(4,4); end;
if isempty(q), q=zeros(1,3); end;
if isempty(qq), qq=zeros(1,77); end;
if isempty(qsave), qsave=zeros(1,2); end;
if isempty(sv), sv=zeros(1,4); end;
if isempty(t), t=zeros(1,17); end;
if isempty(w), w=zeros(1,65); end;
if isempty(x), x=zeros(1,11); end;
if isempty(xi), xi=zeros(1,11); end;
if isempty(y), y=zeros(1,11); end;
if( kprint>=2 )
writef(lun,['1 QUICK CHECK FOR SPLINE ROUTINES', '\n ' , '\n '  ' \n']);
end;
%format ('1 QUICK CHECK FOR SPLINE ROUTINES',/];
ipass = 1;
pi = 3.14159265358979324e0;
tol = 1000.0e0.*r1mach(4);
ndata = 11;
den = ndata - 1;
for i = 1 : ndata;
x(i) =(i-1)./den;
y(i) = sin(pi.*x(i));
end; i = fix(ndata+1);
x(3) = 2.0e0./den;
y(3) = sin(pi.*x(3));
for iknt = 1 : 2;
knt = fix(3 - iknt);
ibcl = 1;
ibcr = 2;
fbcl = pi;
fbcr = 0.0e0;
[x,y,ndata,ibcl,ibcr,fbcl,fbcr,knt,t,bc,n,k,w]=bint4(x,y,ndata,ibcl,ibcr,fbcl,fbcr,knt,t,bc,n,k,w);
inbv = 1;
for i = 1 : ndata;
xx = x(i);
[bv ,t,bc,n,k,dumvar6,xx,inbv,w]=bvalu(t,bc,n,k,0,xx,inbv,w);
er = abs(y(i)-bv);
if( er>tol )
ipass = 0;
if( kprint>=2 )
writef(lun,[' ERROR TEST FOR INTERPOLATION BY BINT4 NOT SATISFIED' ' \n']);
end;
%format (' ERROR TEST FOR INTERPOLATION BY BINT4 NOT SATISFIED');
end;
end; i = fix(ndata+1);
inbv = 1;
[bv ,t,bc,n,k,dumvar6,x(1),inbv,w]=bvalu(t,bc,n,k,1,x(1),inbv,w);
er = abs(pi-bv);
if( er>tol )
ipass = 0;
if( kprint>=2 )
writef(lun,[' ERROR TEST FOR INTERPOLATION BY BINT4 NOT SATISFIED ','BY FIRST DERIVATIVE' ' \n']);
end;
%format (' ERROR TEST FOR INTERPOLATION BY BINT4 NOT SATISFIED ','BY FIRST DERIVATIVE');
end;
[bv ,t,bc,n,k,dumvar6,x(ndata),inbv,w]=bvalu(t,bc,n,k,2,x(ndata),inbv,w);
er = abs(bv);
if( er>tol )
ipass = 0;
if( kprint>=2 )
writef(lun,[' ERROR TEST FOR INTERPOLATION BY BINT4 NOT SATISFIED ','BY SECOND DERIVATIVE' ' \n']);
end;
%format (' ERROR TEST FOR INTERPOLATION BY BINT4 NOT SATISFIED ','BY SECOND DERIVATIVE');
end;
x1 = x(1);
x2 = x(ndata);
[t,bc,n,k,x1,x2,bquad,w]=bsqad(t,bc,n,k,x1,x2,bquad,w);
ldc = 4;
[t,bc,n,k,ldc,c,xi,lxi,w]=bsppp(t,bc,n,k,ldc,c,xi,lxi,w);
[ldc,c,xi,lxi,k,x1,x2,q(1)]=ppqad(ldc,c,xi,lxi,k,x1,x2,q(1));
[dumvar1,t,bc,n,k,dumvar6,x1,x2,tol,q(2),ierr,w]=bfqad(@fb,t,bc,n,k,0,x1,x2,tol,q(2),ierr,w);
[dumvar1,ldc,c,xi,lxi,k,dumvar7,x1,x2,tol,q(3),ierr]=pfqad(@fb,ldc,c,xi,lxi,k,0,x1,x2,tol,q(3),ierr);
for i = 1 : 3;
er = abs(bquad-q(i));
if( er>tol )
ipass = 0;
if( kprint>=2 )
writef(lun,[' ERROR IN QUADRATURE CHECKS' ' \n']);
end;
%format (' ERROR IN QUADRATURE CHECKS');
end;
end; i = fix(3+1);

qsave(knt) = bquad;
end; iknt = fix(2+1);
er = abs(qsave(1)-qsave(2));
if( er>tol )
ipass = 0;
if( kprint>=2 )
writef(lun,[' ERROR IN QUADRATURE CHECK USING TWO SETS OF KNOTS' ' \n']);
end;
%format (' ERROR IN QUADRATURE CHECK USING TWO SETS OF KNOTS');
end;
k_orig=k;    [t,bc,n,k,dumvar5,adif]=bspdr(t,bc,n,k,k,adif);    k(dumvar5~=k_orig)=dumvar5(dumvar5~=k_orig);
inev = 1;
inbv = 1;
inppv = 1;
ilo = 1;
for i = 1 : 6;
xx = x(i+i-1);
k_orig=k;    [t,adif,n,k,dumvar5,xx,inev,sv,w]=bspev(t,adif,n,k,k,xx,inev,sv,w);    k(dumvar5~=k_orig)=dumvar5(dumvar5~=k_orig);
atol = tol;
for j = 1 : k;
[spv ,t,bc,n,k,dumvar6,xx,inbv,w]=bvalu(t,bc,n,k,j-1,xx,inbv,w);
er = abs(spv-sv(j));
x2 = abs(sv(j));
if( x2>1.0e0 )
er = er./x2;
end;
if( er>atol )
ipass = 0;
if( kprint>=2 )
writef(lun,[' COMPARISONS FROM BSPEV AND BVALU DO NOT AGREE' ' \n']);
end;
%format (' COMPARISONS FROM BSPEV AND BVALU DO NOT AGREE');
end;
atol = 10.0e0.*atol;
end; j = fix(k+1);
atol = tol;
for j = 1 : k;
[spv ,ldc,c,xi,lxi,k,dumvar7,xx,inppv]=ppval(ldc,c,xi,lxi,k,j-1,xx,inppv);
er = abs(spv-sv(j));
x2 = abs(sv(j));
if( x2>1.0e0 )
er = er./x2;
end;
if( er>atol )
ipass = 0;
if( kprint>=2 )
writef(lun,[' COMPARISONS FROM BSPEV AND PPVAL DO NOT AGREE' ' \n']);
end;
%format (' COMPARISONS FROM BSPEV AND PPVAL DO NOT AGREE');
end;
atol = 10.0e0.*atol;
end; j = fix(k+1);
atol = tol;
ldcc = 4;
x1 = xx;
if( i+i-1==ndata )
x1 = t(n);
end;
nn = fix(n + k);
[t,nn,x1,ilo,ileft,mflag]=intrv(t,nn,x1,ilo,ileft,mflag);
for j = 1 : k;
[t,k,j,xx,ileft,ldcc,cc,w]=bspvd(t,k,j,xx,ileft,ldcc,cc,w);
er = 0.0e0;
for jj = 1 : k;
er = er + bc(ileft-k+jj).*cc(jj,j);
end; jj = fix(k+1);
er = abs(er-sv(j));
x2 = abs(sv(j));
if( x2>1.0e0 )
er = er./x2;
end;
if( er>atol )
ipass = 0;
if( kprint>=2 )
writef(lun,[' COMPARISONS FROM BSPEV AND BSPVD DO NOT AGREE' ' \n']);
end;
%format (' COMPARISONS FROM BSPEV AND BSPVD DO NOT AGREE');
end;
atol = 10.0e0.*atol;
end; j = fix(k+1);
end; i = fix(6+1);
for k = 2 : 4;
n = fix(ndata);
nmk = fix(n - k);
for i = 1 : k;
t(i) = x(1);
t(n+i) = x(n);
end; i = fix(k+1);
xl = x(n) - x(1);
dn = n - k + 1;
for i = 1 : nmk;
t(k+i) = x(1) + i.*xl./dn;
end; i = fix(nmk+1);
[x,y,t,n,k,bc,qq,w]=bintk(x,y,t,n,k,bc,qq,w);
inbv = 1;
for i = 1 : n;
xx = x(i);
[bv ,t,bc,n,k,dumvar6,xx,inbv,w]=bvalu(t,bc,n,k,0,xx,inbv,w);
er = abs(y(i)-bv);
if( er>tol )
ipass = 0;
if( kprint>=2 )
writef(lun,[' ERROR TEST FOR INTERPOLATION BY BINTK NOT SATISFIED' ' \n']);
end;
%format (' ERROR TEST FOR INTERPOLATION BY BINTK NOT SATISFIED');
end;
end; i = fix(n+1);
end; k = fix(4+1);
[kontrl]=xgetf(kontrl);
if( kprint<=2 )
xsetf(0);
else;
xsetf(1);
end;
fatal = false;
xerclr;
if( kprint>=3 )
writef(lun,[ '\n ' ,' TRIGGER 52 ERROR CONDITIONS', '\n '  ' \n']);
end;
%format [' TRIGGER 52 ERROR CONDITIONS',];
w(1) = 11.0e0;
w(2) = 4.0e0;
w(3) = 2.0e0;
w(4) = 0.5e0;
w(5) = 4.0e0;
ilo = 1;
inev = 1;
inbv = 1;
[t,dumvar2,w(4),ilo,ileft,mflag]=intrv(t,n+1,w(4),ilo,ileft,mflag);
for i = 1 : 5;
w(i) = -w(i);
n = fix(w(1));
k = fix(w(2));
id = fix(w(3));
xx = w(4);
ldc = fix(w(5));
if( i<=4 )
[bv ,t,bc,n,k,id,xx,inbv,qq]=bvalu(t,bc,n,k,id,xx,inbv,qq);
if( numxer(nerr)~=2 )
ipass = 0;
fatal = true;
end;
xerclr;

[t,adif,n,k,id,xx,inev,sv,qq]=bspev(t,adif,n,k,id,xx,inev,sv,qq);
if( numxer(nerr)~=2 )
ipass = 0;
fatal = true;
end;
xerclr;

jhigh = fix(n - 10);
[t,jhigh,k,id,xx,ileft,sv,qq,iwork]=bspvn(t,jhigh,k,id,xx,ileft,sv,qq,iwork);
if( numxer(nerr)~=2 )
ipass = 0;
fatal = true;
end;
xerclr;

[dumvar1,t,bc,n,k,id,xx,x2,tol,quad,ierr,qq]=bfqad(@fb,t,bc,n,k,id,xx,x2,tol,quad,ierr,qq);
if( numxer(nerr)~=2 )
ipass = 0;
fatal = true;
end;
xerclr;
end;

if( i~=3 && i~=4 )
[t,bc,n,k,ldc,c,xi,lxi,qq]=bsppp(t,bc,n,k,ldc,c,xi,lxi,qq);
if( numxer(nerr)~=2 )
ipass = 0;
fatal = true;
end;
xerclr;
end;

if( i<=3 )
[t,bc,n,k,id,adif]=bspdr(t,bc,n,k,id,adif);
if( numxer(nerr)~=2 )
ipass = 0;
fatal = true;
end;
xerclr;
end;

if( i~=3 && i~=5 )
[t,bc,n,k,xx,x2,bquad,qq]=bsqad(t,bc,n,k,xx,x2,bquad,qq);
if( numxer(nerr)~=2 )
ipass = 0;
fatal = true;
end;
xerclr;
end;

if( i>1 )
[t,k,id,xx,ileft,ldc,c,qq]=bspvd(t,k,id,xx,ileft,ldc,c,qq);
if( numxer(nerr)~=2 )
ipass = 0;
fatal = true;
end;
xerclr;
end;

if( i<=2 )
[x,y,t,n,k,bc,qq,adif]=bintk(x,y,t,n,k,bc,qq,adif);
if( numxer(nerr)~=2 )
ipass = 0;
fatal = true;
end;
xerclr;
end;

if( i~=4 )
kntopt = fix(ldc - 2);
ibcl = fix(k - 2);
[x,y,n,ibcl,id,fbcl,fbcr,kntopt,t,bc,nn,kk,qq]=bint4(x,y,n,ibcl,id,fbcl,fbcr,kntopt,t,bc,nn,kk,qq);
if( numxer(nerr)~=2 )
ipass = 0;
fatal = true;
end;
xerclr;
end;
w(i) = -w(i);
end; i = fix(5+1);
kntopt = 1;
x(1) = 1.0e0;
n_orig=n;    [x,y,n,ibcl,ibcr,fbcl,fbcr,kntopt,t,bc,dumvar11,k,qq]=bint4(x,y,n,ibcl,ibcr,fbcl,fbcr,kntopt,t,bc,n,k,qq);    n(dumvar11~=n_orig)=dumvar11(dumvar11~=n_orig);
if( numxer(nerr)~=2 )
ipass = 0;
fatal = true;
end;
xerclr;
[x,y,t,n,k,bc,qq,adif]=bintk(x,y,t,n,k,bc,qq,adif);
if( numxer(nerr)~=2 )
ipass = 0;
fatal = true;
end;
xerclr;
x(1) = 0.0e0;
atol = 1.0e0;
kntopt = 3;
for i = 1 : 3;
qq(i) = -0.30e0 + 0.10e0.*(i-1);
qq(i+3) = 1.1e0 + 0.10e0.*(i-1);
end; i = fix(3+1);
qq(1) = 1.0e0;
[x,y,ndata,dumvar4,dumvar5,fbcl,fbcr,dumvar8,t,bc,n,k,qq]=bint4(x,y,ndata,1,1,fbcl,fbcr,3,t,bc,n,k,qq);
if( numxer(nerr)~=2 )
ipass = 0;
fatal = true;
end;
xerclr;
[dumvar1,t,bc,n,k,id,x1,x2,atol,quad,ierr,qq]=bfqad(@fb,t,bc,n,k,id,x1,x2,atol,quad,ierr,qq);
if( numxer(nerr)~=2 )
ipass = 0;
fatal = true;
end;
xerclr;
inppv = 1;
for i = 1 : 5;
w(i) = -w(i);
lxi = fix(w(1));
k = fix(w(2));
id = fix(w(3));
xx = w(4);
ldc = fix(w(5));
[spv ,ldc,c,xi,lxi,k,id,xx,inppv]=ppval(ldc,c,xi,lxi,k,id,xx,inppv);
if((i~=4 && numxer(nerr)~=2) ||(i==4 && numxer(nerr)~=0) )
ipass = 0;
fatal = true;
end;
xerclr;

[dumvar1,ldc,c,xi,lxi,k,id,xx,x2,tol,quad,ierr]=pfqad(@fb,ldc,c,xi,lxi,k,id,xx,x2,tol,quad,ierr);
if((i~=4 && numxer(nerr)~=2) ||(i==4 && numxer(nerr)~=0) )
ipass = 0;
fatal = true;
end;
xerclr;

if( i~=3 )
[ldc,c,xi,lxi,k,xx,x2,pquad]=ppqad(ldc,c,xi,lxi,k,xx,x2,pquad);
if((i~=4 && numxer(nerr)~=2) ||(i==4 && numxer(nerr)~=0) )
ipass = 0;
fatal = true;
end;
xerclr;
end;

w(i) = -w(i);
end; i = fix(5+1);
ldc = fix(w(5));
[dumvar1,ldc,c,xi,lxi,k,id,x1,x2,atol,quad,ierr]=pfqad(@fb,ldc,c,xi,lxi,k,id,x1,x2,atol,quad,ierr);
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 ' ,' B-SPLINE PACKAGE PASSED ALL TESTS' ' \n']);
end;
%format [' B-SPLINE PACKAGE PASSED ALL TESTS');
if( ipass==0 && kprint>=1 )
writef(lun,[ '\n ' ,' ****B-SPLINE PACKAGE FAILED SOME TESTS' ' \n']);
end;
%format [' ****B-SPLINE PACKAGE FAILED SOME TESTS');
return;
end %subroutine bspck