Code covered by the BSD License  

Highlights from
slatec

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

[lun,kprint,ipass]=cdqaws(lun,kprint,ipass);
function [lun,kprint,ipass]=cdqaws(lun,kprint,ipass);
persistent a abserr alfa b beta epmach epsabs epsrel error exact0 exact1 firstCall ier ierv integr ip iwork last lenw limit neval 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(exact0), exact0=0; end;
if isempty(exact1), exact1=0; end;
if isempty(alfa), alfa=0; end;
if isempty(beta), beta=0; end;
if isempty(result), result=0; end;
if isempty(uflow), uflow=0; end;
if isempty(work), work=zeros(1,800); end;
if isempty(ier), ier=0; end;
if isempty(ip), ip=0; end;
if isempty(iwork), iwork=zeros(1,200); 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 isempty(integr), integr=0; end;
if firstCall,   exact0=[0.5350190569223644d+00];  end;
if firstCall,   exact1=[0.1998491554328673d+04];  end;
firstCall=0;
if( kprint>=2 )
writef(lun,['1DQAWS QUICK CHECK' '\n ' ]);
end;
ipass = 1;
alfa = -0.5d+00;
beta = -0.5d+00;
integr = 1;
a = 0.0d+00;
b = 0.1d+01;
limit = 200;
lenw = fix(limit.*4);
epsabs = 0.0d+00;
[epmach ]=d1mach(4);
epsrel = max(sqrt(epmach),0.1d-07);
[dumvar1,a,b,alfa,beta,integr,epsabs,epsrel,result,abserr,neval,ier,limit,lenw,last,iwork,work]=dqaws(@df0ws,a,b,alfa,beta,integr,epsabs,epsrel,result,abserr,neval,ier,limit,lenw,last,iwork,work);
ierv(1) = fix(ier);
ip = 0;
error = abs(exact0-result);
if( ier==0 && error<=epsrel.*abs(exact0) )
ip = 1;
end;
if( ip==0 )
ipass = 0;
end;
[lun,dumvar2,kprint,ip,exact0,result,abserr,neval,ierv]=dprin(lun,0,kprint,ip,exact0,result,abserr,neval,ierv,1);
[dumvar1,a,b,alfa,beta,integr,epsabs,epsrel,result,abserr,neval,ier,dumvar13,dumvar14,last,iwork,work]=dqaws(@df0ws,a,b,alfa,beta,integr,epsabs,epsrel,result,abserr,neval,ier,2,8,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,exact0,result,abserr,neval,ierv]=dprin(lun,1,kprint,ip,exact0,result,abserr,neval,ierv,1);
[uflow ]=d1mach(1);
[dumvar1,a,b,alfa,beta,integr,uflow,dumvar8,result,abserr,neval,ier,limit,lenw,last,iwork,work]=dqaws(@df0ws,a,b,alfa,beta,integr,uflow,0.0d+00,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,exact0,result,abserr,neval,ierv]=dprin(lun,2,kprint,ip,exact0,result,abserr,neval,ierv,2);
[dumvar1,a,b,alfa,beta,integr,epsabs,epsrel,result,abserr,neval,ier,limit,lenw,last,iwork,work]=dqaws(@df1ws,a,b,alfa,beta,integr,epsabs,epsrel,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,exact1,result,abserr,neval,ierv]=dprin(lun,3,kprint,ip,exact1,result,abserr,neval,ierv,2);
integr = 0;
[dumvar1,a,b,alfa,beta,integr,epsabs,epsrel,result,abserr,neval,ier,limit,lenw,last,iwork,work]=dqaws(@df1ws,a,b,alfa,beta,integr,epsabs,epsrel,result,abserr,neval,ier,limit,lenw,last,iwork,work);
ierv(1) = fix(ier);
ip = 0;
if( ier==6 )
ip = 1;
end;
if( ip==0 )
ipass = 0;
end;
[lun,dumvar2,kprint,ip,exact0,result,abserr,neval,ierv]=dprin(lun,6,kprint,ip,exact0,result,abserr,neval,ierv,1);
if( kprint>=1 )
if( ipass==0 )
writef(lun,[ '\n ' ' SOME TEST(S) IN CDQAWS FAILED' '\n ' ]);
elseif( kprint>=2 ) ;
writef(lun,[ '\n ' ' ALL TEST(S) IN CDQAWS PASSED' '\n ' ]);
end;
end;
end %subroutine cdqaws

Contact us at files@mathworks.com