Code covered by the BSD License  

Highlights from
slatec

from slatec by Ben Barrowes
The slatec library converted into matlab functions.

[lun,kprint,ipass]=davnts(lun,kprint,ipass);
function [lun,kprint,ipass]=davnts(lun,kprint,ipass);
persistent a ansmlv b del fatal i ierr kontrl n rn1 sqb tol tol1 x xint y ; 

if isempty(kontrl), kontrl=0; end;
if isempty(i), i=0; end;
if isempty(ierr), ierr=0; end;
if isempty(n), n=0; end;
if isempty(a), a=0; end;
if isempty(ansmlv), ansmlv=0; end;
if isempty(b), b=0; end;
if isempty(del), del=0; end;
if isempty(rn1), rn1=0; end;
if isempty(sqb), sqb=0; end;
if isempty(tol), tol=0; end;
if isempty(tol1), tol1=0; end;
if isempty(x), x=zeros(1,501); end;
if isempty(xint), xint=0; end;
if isempty(y), y=zeros(1,501); end;
if isempty(fatal), fatal=false; end;
if( kprint>=2 )
writef(lun,['1', '\n ' ,' DAVINT Quick Check' ' \n']);
end;
%format ('1'/' DAVINT Quick Check');
ipass = 1;
tol = max(.0001d0,sqrt(d1mach(4)));
tol1 = 1.0d-2.*tol;
a = 0.0d0;
b = 5.0d0;
xint = exp(5.0d0) - 1.0d0;
n = 500;
rn1 = n - 1;
sqb = sqrt(b);
del = 0.4d0.*(b-a)./(n-1);
for i = 1 : n;
x(i) = sqb.*sqrt(a+(i-1).*(b-a)./rn1) + del;
y(i) = exp(x(i));
end; i = fix(n+1);
[x,y,n,a,b,ansmlv,ierr]=davint(x,y,n,a,b,ansmlv,ierr);
if( abs(ansmlv-xint)>tol )
ipass = 0;
if( kprint>=3 )
writef(lun,[ '\n ' ,' FAILED ACCURACY TEST', '\n ' ,' IERR=','%2i',repmat(' ',1,5),'COMPUTED ANS=','%20.11f', '\n ' ,repmat(' ',1,14),'CORRECT ANS=','%20.11f',repmat(' ',1,5),'REQUESTED ERR=','%10.2f' ' \n'], ierr , ansmlv , xint);
end;
end;
x(1) = 0.0d0;
x(2) = 5.0d0;
y(1) = 1.0d0;
y(2) = 0.5d0;
a = -0.5d0;
b = 0.5d0;
xint = 1.0d0;
[x,y,dumvar3,a,b,ansmlv,ierr]=davint(x,y,2,a,b,ansmlv,ierr);
if( abs(ansmlv-xint)>tol1 )
ipass = 0;
if( kprint>=3 )
writef(lun,[ '\n ' ,' FAILED ACCURACY TEST', '\n ' ,' IERR=','%2i',repmat(' ',1,5),'COMPUTED ANS=','%20.11f', '\n ' ,repmat(' ',1,14),'CORRECT ANS=','%20.11f',repmat(' ',1,5),'REQUESTED ERR=','%10.2f' ' \n'], ierr , ansmlv , xint);
end;
end;
if( kprint>=2 )
if( ipass==1 )
if( kprint>=3 )
writef(lun,[ '\n ' ,' DAVINT passed both accuracy tests.' ' \n']);
end;
%format [' DAVINT passed both accuracy tests.');
else;
writef(lun,[ '\n ' ,' DAVINT failed at least one accuracy test.' ' \n']);
%format [' DAVINT failed at least one accuracy test.');
end;
end;
[kontrl]=xgetf(kontrl);
if( kprint<=2 )
xsetf(0);
else;
xsetf(1);
end;
fatal = false;
xerclr;
if( kprint>=3 )
writef(lun,[ '\n ' ,' Test error returns from DAVINT', '\n ' ,' 4 error messages expected', '\n '  ' \n']);
%format [' Test error returns from DAVINT'/' 4 error messages expected'];
end;
for i = 1 : 20;
x(i) =(i-1)./19.0d0 - 0.01d0;
if( i~=1 )
y(i) = x(i)./(exp(x(i))-1.0);
end;
end; i = fix(20+1);
y(1) = 1.0d0;
[x,y,dumvar3,dumvar4,dumvar5,ansmlv,ierr]=davint(x,y,20,0.0d0,1.0d0,ansmlv,ierr);
if( ierr~=1 )
ipass = 0;
fatal = true;
if( kprint>=3 )
writef(lun,[ '\n ' ,' IERR =','%2i',' and it should =','%2i', '\n '  ' \n'], ierr , 1);
end;
end;
xerclr;
[x,y,dumvar3,dumvar4,dumvar5,ansmlv,ierr]=davint(x,y,20,1.0d0,0.0d0,ansmlv,ierr);
if( ierr~=2 )
ipass = 0;
fatal = true;
if( kprint>=3 )
writef(lun,[ '\n ' ,' IERR =','%2i',' and it should =','%2i', '\n '  ' \n'], ierr , 2);
end;
end;
if( ansmlv~=0.0d0 )
ipass = 0;
fatal = true;
if( kprint>=3 )
writef(lun,[repmat(' ',1,1),'ANS  /=  0' ' \n']);
end;
end;
xerclr;
[x,y,dumvar3,dumvar4,dumvar5,ansmlv,ierr]=davint(x,y,1,0.0d0,1.0d0,ansmlv,ierr);
if( ierr~=5 )
ipass = 0;
fatal = true;
if( kprint>=3 )
writef(lun,[ '\n ' ,' IERR =','%2i',' and it should =','%2i', '\n '  ' \n'], ierr , 5);
end;
end;
if( ansmlv~=0.0d0 )
ipass = 0;
fatal = true;
if( kprint>=3 )
writef(lun,[repmat(' ',1,1),'ANS  /=  0' ' \n']);
end;
end;
xerclr;
x(1) = 1.0d0./19.0d0;
x(2) = 0.0d0;
[x,y,dumvar3,dumvar4,dumvar5,ansmlv,ierr]=davint(x,y,20,0.0d0,1.0d0,ansmlv,ierr);
if( ierr~=4 )
ipass = 0;
fatal = true;
if( kprint>=3 )
writef(lun,[ '\n ' ,' IERR =','%2i',' and it should =','%2i', '\n '  ' \n'], ierr , 4);
end;
end;
if( ansmlv~=0.0d0 )
ipass = 0;
fatal = true;
if( kprint>=3 )
writef(lun,[repmat(' ',1,1),'ANS  /=  0' ' \n']);
end;
end;
xerclr;
x(1) = 0.0d0;
x(2) = 1.0d0./19.0d0;
[x,y,dumvar3,dumvar4,dumvar5,ansmlv,ierr]=davint(x,y,20,0.0d0,.01d0,ansmlv,ierr);
if( ierr~=3 )
ipass = 0;
fatal = true;
if( kprint>=3 )
writef(lun,[ '\n ' ,' IERR =','%2i',' and it should =','%2i', '\n '  ' \n'], ierr , 3);
end;
end;
if( ansmlv~=0.0d0 )
ipass = 0;
fatal = true;
if( kprint>=3 )
writef(lun,[repmat(' ',1,1),'ANS  /=  0' ' \n']);
end;
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>=3 )
writef(lun,[ '\n ' ,' DAVINT PASSED ALL TESTS' ' \n']);
end;
%format [' DAVINT PASSED ALL TESTS');
if( ipass==0 && kprint>=2 )
writef(lun,[ '\n ' ,' DAVINT FAILED SOME TESTS****' ' \n']);
end;
%format [' DAVINT FAILED SOME TESTS****');
return;
%format [' FAILED ACCURACY TEST'/' IERR=',i2,5X,'COMPUTED ANS=',e20.11/14X,'CORRECT ANS=',d20.11,5X,'REQUESTED ERR=',d10.2);
%format [' IERR =',i2,' and it should =',i2];
%format (1X,'ANS  ~=  0');
end %subroutine davnts

Contact us