function [lun,kprint,ipass]=qxbvsp(lun,kprint,ipass);
persistent a abser ae alpha b beta firstCall i iflag igo igo1 igofx ipss itmp iwork j kont kount l msg ncomp ndiw ndw neqivp nfc nic nrowa nrowb nrowy numort nxpts re reler sve tol work xpts y yans ; if isempty(firstCall),firstCall=1;end;
if isempty(a), a=zeros(2,4); end;
if isempty(abser), abser=0; end;
if isempty(ae), ae=0; end;
if isempty(alpha), alpha=zeros(1,2); end;
if isempty(b), b=zeros(2,4); end;
if isempty(beta), beta=zeros(1,2); end;
if isempty(re), re=0; end;
if isempty(reler), reler=0; end;
if isempty(sve), sve=0; end;
global savex_2; if isempty(savex_2), savex_2=0; end;
if isempty(tol), tol=0; end;
if isempty(work), work=zeros(1,1000); end;
if isempty(xpts), xpts=zeros(1,15); end;
global savex_1; if isempty(savex_1), savex_1=0; end;
if isempty(y), y=zeros(4,15); end;
if isempty(yans), yans=zeros(2,15); end;
if isempty(i), i=0; end;
if isempty(iflag), iflag=0; end;
if isempty(igofx), igofx=0; end;
if isempty(ipss), ipss=0; end;
if isempty(j), j=0; end;
if isempty(kont), kont=0; end;
if isempty(kount), kount=0; end;
if isempty(l), l=0; end;
if isempty(ncomp), ncomp=0; end;
if isempty(ndiw), ndiw=0; end;
if isempty(ndw), ndw=0; end;
if isempty(neqivp), neqivp=0; end;
if isempty(nfc), nfc=0; end;
if isempty(nic), nic=0; end;
if isempty(nrowa), nrowa=0; end;
if isempty(nrowb), nrowb=0; end;
if isempty(nrowy), nrowy=0; end;
if isempty(igo), igo=0; end;
if isempty(igo1), igo1=0; end;
if isempty(numort), numort=0; end;
if isempty(nxpts), nxpts=0; end;
if isempty(itmp), itmp=zeros(1,9); end;
if isempty(iwork), iwork=zeros(1,100); end;
if isempty(msg), msg=repmat(' ',1,4); end;
% common :: ;
%% common /savex / xsave , term;
%% common /savex / savex_1 , savex_2;
if firstCall, yans(1,1) =[5.000000000e+00]; end;
if firstCall, yans(2,1) =[-6.888880126e-01]; end;
if firstCall, yans(1,2) =[8.609248635e+00]; end;
if firstCall, yans(2,2) =[-1.083092311e+00]; end;
if firstCall, yans(1,3) =[1.674923836e+01]; end;
if firstCall, yans(2,3) =[-2.072210073e+00]; end;
if firstCall, yans(1,4) =[3.351098494e+01]; end;
if firstCall, yans(2,4) =[-4.479263780e+00]; end;
if firstCall, yans(1,5) =[6.601103894e+01]; end;
if firstCall, yans(2,5) =[-8.909222513e+00]; end;
if firstCall, yans(1,6) =[8.579580988e+01]; end;
if firstCall, yans(2,6) =[-1.098742758e+01]; end;
if firstCall, yans(1,7) =[1.106536877e+02]; end;
if firstCall, yans(2,7) =[-1.402469444e+01]; end;
if firstCall, yans(1,8) =[1.421228220e+02]; end;
if firstCall, yans(2,8) =[-1.742236546e+01]; end;
if firstCall, yans(1,9) =[1.803383474e+02]; end;
if firstCall, yans(2,9) =[-2.086465851e+01]; end;
if firstCall, yans(1,10) =[2.017054332e+02]; end;
if firstCall, yans(2,10) =[-1.990879843e+01]; end;
if firstCall, yans(1,11) =[2.051622475e+02]; end;
if firstCall, yans(2,11) =[-1.324886978e+01]; end;
if firstCall, yans(1,12) =[2.059197452e+02]; end;
if firstCall, yans(2,12) =[1.051529813e+01]; end;
if firstCall, yans(1,13) =[1.972191446e+02]; end;
if firstCall, yans(2,13) =[9.320592785e+01]; end;
if firstCall, yans(1,14) =[1.556894846e+02]; end;
if firstCall, yans(2,14) =[3.801682434e+02]; end;
if firstCall, yans(1,15) =[1.818989404e-12]; end;
if firstCall, yans(2,15)=[1.379853993e+03]; end;
if firstCall, xpts(1) =[60.]; end;
if firstCall, xpts(2) =[55.]; end;
if firstCall, xpts(3) =[50.]; end;
if firstCall, xpts(4) =[45.]; end;
if firstCall, xpts(5) =[40.]; end;
if firstCall, xpts(6) =[38.]; end;
if firstCall, xpts(7) =[36.]; end;
if firstCall, xpts(8) =[34.]; end;
if firstCall, xpts(9) =[32.]; end;
if firstCall, xpts(10) =[31.]; end;
if firstCall, xpts(11) =[30.8]; end;
if firstCall, xpts(12)=[30.6]; end;
if firstCall, xpts(13) =[30.4]; end;
if firstCall, xpts(14) =[30.2]; end;
if firstCall, xpts(15)=[30.]; end;yans=reshape(yans,[2,15]);
firstCall=0;
if( kprint>=2 )
writef(lun,['1' ' \n']);
%format ('1');
writef(lun,[ '\n ' ,' BVSUP QUICK CHECK' ' \n']);
%format [' BVSUP QUICK CHECK');
end;
for i = 1 : 9;
itmp(i) = 0;
end; i = fix(9+1);
tol = 1.0e-03;
savex_1 = 0.;
nrowy = 4;
ncomp = 2;
nxpts = 15;
a(1,1) = 1.0;
a(1,2) = 0.0;
nrowa = 2;
alpha(1) = 5.0;
nic = 1;
b(1,1) = 1.0;
b(1,2) = 0.0;
nrowb = 2;
beta(1) = 0.0;
nfc = 1;
igofx = 1;
re = 1.0e-05;
ae = 1.0e-05;
ndw = 1000;
ndiw = 100;
neqivp = 0;
ipass = 1;
for i = 1 : 15;
iwork(i) = 0;
end; i = fix(15+1);
[y,nrowy,ncomp,xpts,nxpts,a,nrowa,alpha,nic,b,nrowb,beta,nfc,igofx,re,ae,iflag,work,ndw,iwork,ndiw,neqivp]=bvsup(y,nrowy,ncomp,xpts,nxpts,a,nrowa,alpha,nic,b,nrowb,beta,nfc,igofx,re,ae,iflag,work,ndw,iwork,ndiw,neqivp);
if( iflag~=0 )
ipass = 0;
if( kprint>1 )
writef(lun,[repmat(' ',1,10),'IFLAG =','%2i' ' \n'], iflag);
end;
%format (10X,'IFLAG =',i2);
else;
numort = fix(iwork(1));
for j = 1 : nxpts;
for l = 1 : 2;
abser = abs(yans(l,j)-y(l,j));
reler = abser./abs(yans(l,j));
if( reler>tol && abser>tol )
ipass = 0;
end;
end; l = fix(2+1);
end; j = fix(nxpts+1);
if( kprint==0 ||(kprint==1 && ipass==1) )
if( ipass==1 && kprint>1 )
writef(lun,[ '\n ' ,' *BVSUP PASSED ALL TESTS' ' \n']);
end;
if( ipass==0 && kprint~=0 )
writef(lun,[ '\n ' ,' *BVSUP FAILED SOME TESTS****' ' \n']);
end;
return;
end;
if( kprint~=1 || ipass~=0 )
if( kprint>=3 || ipass==0 )
writef(lun,[ '\n ' ,' ACCURACY TEST' ' \n']);
%format [' ACCURACY TEST');
writef(lun,[ '\n ' ,' NUMBER OF ORTHONORMALIZATIONS =','%3i' ' \n'], numort);
%format [' NUMBER OF ORTHONORMALIZATIONS =',i3);
for j=(1):(numort), writef(lun,[ '\n ' ,' ORTHONORMALIZATION POINTS ARE', '\n ' ,repmat([repmat(' ',1,1),repmat('%10.2f',1,4)] ,1,1) ' \n'],work(j)); end;
%format [' ORTHONORMALIZATION POINTS ARE'/(1X,4F10.2));
writef(lun,[ '\n ' , '\n ' ,repmat(' ',1,20),'CALCULATION',repmat(' ',1,30),'truemlv SOLUTION', '\n ' ,repmat(' ',1,2),'X',repmat(' ',1,14),'Y',repmat(' ',1,17),'Y-PRIME',repmat(' ',1,15),'Y',repmat(' ',1,17),'Y-PRIME', '\n ' ' \n']);
%format [/20X,'CALCULATION',30X,'truemlv SOLUTION'/2X,'X',14X,'Y',17X,'Y-PRIME',15X,'Y',17X,'Y-PRIME'];
for j = 1 : nxpts;
msg = 'PASS';
abser = abs(yans(1,j)-y(1,j));
reler = abser./abs(yans(1,j));
if( reler>tol && abser>tol )
msg = 'FAIL';
end;
abser = abs(yans(2,j)-y(2,j));
reler = abser./abs(yans(2,j));
if( reler>tol && abser>tol )
msg = 'FAIL';
end;
writef(lun,['%5.1f',repmat('%20.7f',1,4),repmat(' ',1,5),'%s' ' \n'], xpts(j) , y(1,j) , y(2,j) , yans(1,j) ,yans(2,j) , msg);
%format(f5.1,4e20.7,5x,a);
end; j = fix(nxpts+1);
end;
end;
[lun,dumvar2,ipass]=pass(lun,1,ipass);
if( kprint==1 )
if( ipass==1 && kprint>1 )
writef(lun,[ '\n ' ,' *BVSUP PASSED ALL TESTS' ' \n']);
end;
if( ipass==0 && kprint~=0 )
writef(lun,[ '\n ' ,' *BVSUP FAILED SOME TESTS****' ' \n']);
end;
return;
end;
kont = 1;
writef(lun,[ '\n ' ,' (7) TESTS OF IFLAG VALUES' ' \n']);
%format [' (7) TESTS OF IFLAG VALUES');
kount = 1;
nrowy = 1;
while (1);
igo=1;
igo1=1;
for i = 1 : 15;
iwork(i) = 0;
end; i = fix(15+1);
[y,nrowy,ncomp,xpts,nxpts,a,nrowa,alpha,nic,b,nrowb,beta,nfc,igofx,re,ae,iflag,work,ndw,iwork,ndiw,neqivp]=bvsup(y,nrowy,ncomp,xpts,nxpts,a,nrowa,alpha,nic,b,nrowb,beta,nfc,igofx,re,ae,iflag,work,ndw,iwork,ndiw,neqivp);
if( kount==2 )
writef(lun,[ '\n ' ,' IFLAG SHOULD BE -2, IFLAG =','%3i' ' \n'], iflag);
if( iflag==-2 )
itmp(kont) = 1;
end;
kont = fix(kont + 1);
kount = 3;
igofx = 1;
re = -1.;
ae = -2.;
elseif( kount==3 ) ;
writef(lun,[ '\n ' ,' IFLAG SHOULD BE -2, IFLAG =','%3i' ' \n'], iflag);
if( iflag==-2 )
itmp(kont) = 1;
end;
kont = fix(kont + 1);
kount = 4;
re = 1.0e-05;
ae = 1.0e-05;
nrowa = 0;
igo=0;
elseif( kount==4 ) ;
igo=0;
elseif( kount==5 ) ;
igo1=0;
elseif( kount==6 ) ;
writef(lun,[ '\n ' ,' IFLAG SHOULD BE -1, IFLAG =','%3i' ' \n'], iflag);
%format [' IFLAG SHOULD BE -1, IFLAG =',i3);
if( iflag==-1 )
itmp(kont) = 1;
end;
kont = fix(kont + 1);
kount = 7;
ndiw = 100;
sve = xpts(1);
xpts(1) = xpts(4);
xpts(4) = sve;
elseif( kount==7 ) ;
writef(lun,[ '\n ' ,' IFLAG SHOULD BE -2, IFLAG =','%3i' ' \n'], iflag);
if( iflag==-2 )
itmp(kont) = 1;
end;
break;
else;
writef(lun,[ '\n ' ,' IFLAG SHOULD BE -2, IFLAG =','%3i' ' \n'], iflag);
if( iflag==-2 )
itmp(kont) = 1;
end;
kont = fix(kont + 1);
kount = 2;
nrowy = 2;
igofx = 3;
end;
if(igo==1 && igo1==1)
continue;
end;
if(igo1==1)
writef(lun,[ '\n ' ,' IFLAG SHOULD BE -2, IFLAG =','%3i' ' \n'], iflag);
if( iflag==-2 )
itmp(kont) = 1;
end;
kont = fix(kont + 1);
kount = 5;
nrowa = 2;
nrowb = 0;
end;
writef(lun,[ '\n ' ,' IFLAG SHOULD BE -2, IFLAG =','%3i' ' \n'], iflag);
if( iflag==-2 )
itmp(kont) = 1;
end;
kont = fix(kont + 1);
kount = 6;
nrowb = 2;
ndiw = 17;
end;
end;
ipss = 1;
for i = 1 : kont;
ipss = fix(ipss.*itmp(i));
end; i = fix(kont+1);
[lun,dumvar2,ipss]=pass(lun,2,ipss);
ipass = fix(ipass.*ipss);
if( ipass==1 && kprint>1 )
writef(lun,[ '\n ' ,' *BVSUP PASSED ALL TESTS' ' \n']);
end;
%format [' *BVSUP PASSED ALL TESTS');
if( ipass==0 && kprint~=0 )
writef(lun,[ '\n ' ,' *BVSUP FAILED SOME TESTS****' ' \n']);
end;
%format [' *BVSUP FAILED SOME TESTS****');
return;
%format [' IFLAG SHOULD BE -2, IFLAG =',i3);
end %subroutine qxbvsp
