Code covered by the BSD License  

Highlights from
slatec

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

[lun,kprint,ipass]=cdqag(lun,kprint,ipass);
function [lun,kprint,ipass]=cdqag(lun,kprint,ipass);
persistent a abserr b epmach epsabs epsrel error exact1 exact2 exact3 firstCall ier ierv ip iwork key last lenw limit neval pi result uflow work ; if isempty(firstCall),firstCall=1;end; 

if isempty(ierv), ierv=zeros(1,2); end;
if isempty(a), a=0; end;
if isempty(abserr), abserr=0; end;
if isempty(b), b=0; end;
if isempty(epmach), epmach=0; end;
if isempty(epsabs), epsabs=0; end;
if isempty(epsrel), epsrel=0; end;
if isempty(error), error=0; end;
if isempty(exact1), exact1=0; end;
if isempty(exact2), exact2=0; end;
if isempty(exact3), exact3=0; end;
if isempty(pi), pi=0; end;
if isempty(result), result=0; end;
if isempty(uflow), uflow=0; end;
if isempty(work), work=zeros(1,400); end;
if isempty(ier), ier=0; end;
if isempty(ip), ip=0; end;
if isempty(iwork), iwork=zeros(1,100); end;
if isempty(key), key=0; end;
if isempty(last), last=0; end;
if isempty(lenw), lenw=0; end;
if isempty(limit), limit=0; end;
if isempty(neval), neval=0; end;
if firstCall,   pi=[0.31415926535897932d+01];  end;
if firstCall,   exact1=[0.1154700538379252d+01];  end;
if firstCall,   exact2=[0.11780972450996172d+00];  end;
if firstCall,   exact3=[0.1855802d+02];  end;
firstCall=0;
if( kprint>=2 )
writef(lun,['1DQAG QUICK CHECK' '\n ' ]);
end;
ipass = 1;
limit = 100;
lenw = fix(limit.*4);
epsabs = 0.0d+00;
[epmach ]=d1mach(4);
key = 6;
epsrel = max(sqrt(epmach),0.1d-07);
a = 0.0d+00;
b = 0.1d+01;
[dumvar1,a,b,epsabs,epsrel,key,result,abserr,neval,ier,limit,lenw,last,iwork,work]=dqag(@df1g,a,b,epsabs,epsrel,key,result,abserr,neval,ier,limit,lenw,last,iwork,work);
ierv(1) = fix(ier);
ip = 0;
error = abs(exact1-result);
if( ier==0 && error<=abserr && abserr<=epsrel.*abs(exact1) )
ip = 1;
end;
if( ip==0 )
ipass = 0;
end;
[lun,dumvar2,kprint,ip,exact1,result,abserr,neval,ierv]=dprin(lun,0,kprint,ip,exact1,result,abserr,neval,ierv,1);
limit = 1;
lenw = fix(limit.*4);
b = pi.*0.2d+01;
[dumvar1,a,b,epsabs,epsrel,key,result,abserr,neval,ier,limit,lenw,last,iwork,work]=dqag(@df2g,a,b,epsabs,epsrel,key,result,abserr,neval,ier,limit,lenw,last,iwork,work);
ierv(1) = fix(ier);
ip = 0;
if( ier==1 )
ip = 1;
end;
if( ip==0 )
ipass = 0;
end;
[lun,dumvar2,kprint,ip,exact2,result,abserr,neval,ierv]=dprin(lun,1,kprint,ip,exact2,result,abserr,neval,ierv,1);
[uflow ]=d1mach(1);
limit = 100;
lenw = fix(limit.*4);
[dumvar1,a,b,uflow,dumvar5,key,result,abserr,neval,ier,limit,lenw,last,iwork,work]=dqag(@df2g,a,b,uflow,0.0d+00,key,result,abserr,neval,ier,limit,lenw,last,iwork,work);
ierv(1) = fix(ier);
ierv(2) = 1;
ip = 0;
if( ier==2 || ier==1 )
ip = 1;
end;
if( ip==0 )
ipass = 0;
end;
[lun,dumvar2,kprint,ip,exact2,result,abserr,neval,ierv]=dprin(lun,2,kprint,ip,exact2,result,abserr,neval,ierv,2);
b = 0.1d+01;
[dumvar1,a,b,epsabs,epsrel,dumvar6,result,abserr,neval,ier,limit,lenw,last,iwork,work]=dqag(@df3g,a,b,epsabs,epsrel,1,result,abserr,neval,ier,limit,lenw,last,iwork,work);
ierv(1) = fix(ier);
ierv(2) = 1;
ip = 0;
if( ier==3 || ier==1 )
ip = 1;
end;
if( ip==0 )
ipass = 0;
end;
[lun,dumvar2,kprint,ip,exact3,result,abserr,neval,ierv]=dprin(lun,3,kprint,ip,exact3,result,abserr,neval,ierv,2);
lenw = 1;
[dumvar1,a,b,epsabs,epsrel,key,result,abserr,neval,ier,limit,lenw,last,iwork,work]=dqag(@df1g,a,b,epsabs,epsrel,key,result,abserr,neval,ier,limit,lenw,last,iwork,work);
ierv(1) = fix(ier);
ip = 0;
if( ier==6 && result==0.0d+00 && abserr==0.0d+00 &&neval==0 && last==0 )
ip = 1;
end;
if( ip==0 )
ipass = 0;
end;
[lun,dumvar2,kprint,ip,exact1,result,abserr,neval,ierv]=dprin(lun,6,kprint,ip,exact1,result,abserr,neval,ierv,1);
if( kprint>=1 )
if( ipass==0 )
writef(lun,[ '\n ' ' SOME TEST(S) IN CDQAG FAILED' '\n ' ]);
elseif( kprint>=2 ) ;
writef(lun,[ '\n ' ' ALL TEST(S) IN CDQAG PASSED' '\n ' ]);
end;
end;
end %subroutine cdqag

Contact us at files@mathworks.com