Code covered by the BSD License  

Highlights from
slatec

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

[lun,kprint,ipass]=qn79qx(lun,kprint,ipass);
function [lun,kprint,ipass]=qn79qx(lun,kprint,ipass);
persistent a ansmlv b cor err fatal ierr kontrl nfct req tol ; 

if isempty(kontrl), kontrl=0; end;
if isempty(ierr), ierr=0; end;
if isempty(nfct), nfct=0; end;
if isempty(a), a=0; end;
if isempty(ansmlv), ansmlv=0; end;
if isempty(b), b=0; end;
if isempty(cor), cor=0; end;
if isempty(err), err=0; end;
if isempty(req), req=0; end;
if isempty(tol), tol=0; end;
if isempty(fatal), fatal=false; end;
if( kprint>=2 )
writef(lun,['1', '\n ' ,' QNC79 Quick Check' ' \n']);
end;
tol = sqrt(r1mach(4));
ipass = 1;
a = 1.0e0;
b = 4.0e0;
err = tol./100.0e0;
[dumvar1,a,b,err,ansmlv,ierr,nfct]=qnc79(@fqd1,a,b,err,ansmlv,ierr,nfct);
cor = 2.0e0;
if( abs(ansmlv-cor)<=tol && ierr==1 )
if( kprint>=3 )
writef(lun,[ '\n ' ,' Accuracy test of QNC79 ','%s', '\n ' ,' A = ','%10.5f','   B = ','%10.5f', '\n ' ,' Computed result = ','%14.7f','   Exact result = ','%14.7f', '\n ' ,' Tolerance = ','%14.7f','   IERR = ','%2i','   Number of function evals = ','%5i', '\n '  ' \n'], 'PASSED' , a , b , ansmlv , cor ,err , ierr , nfct);
end;
else;
ipass = 0;
if( kprint>=2 )
writef(lun,[ '\n ' ,' Accuracy test of QNC79 ','%s', '\n ' ,' A = ','%10.5f','   B = ','%10.5f', '\n ' ,' Computed result = ','%14.7f','   Exact result = ','%14.7f', '\n ' ,' Tolerance = ','%14.7f','   IERR = ','%2i','   Number of function evals = ','%5i', '\n '  ' \n'], 'FAILED' , a , b , ansmlv , cor ,err , ierr , nfct);
end;
end;
a = 0.0e0;
b = 4.0e0.*atan(1.0e0);
err = tol./10.0e0;
[dumvar1,a,b,err,ansmlv,ierr,nfct]=qnc79(@fqd2,a,b,err,ansmlv,ierr,nfct);
cor =(exp(b)-1.0e0)./101.0e0;
if( abs(ansmlv-cor)<=tol && ierr==1 )
if( kprint>=3 )
writef(lun,[ '\n ' ,' Accuracy test of QNC79 ','%s', '\n ' ,' A = ','%10.5f','   B = ','%10.5f', '\n ' ,' Computed result = ','%14.7f','   Exact result = ','%14.7f', '\n ' ,' Tolerance = ','%14.7f','   IERR = ','%2i','   Number of function evals = ','%5i', '\n '  ' \n'], 'PASSED' , a , b , ansmlv , cor ,err , ierr , nfct);
end;
else;
ipass = 0;
if( kprint>=2 )
writef(lun,[ '\n ' ,' Accuracy test of QNC79 ','%s', '\n ' ,' A = ','%10.5f','   B = ','%10.5f', '\n ' ,' Computed result = ','%14.7f','   Exact result = ','%14.7f', '\n ' ,' Tolerance = ','%14.7f','   IERR = ','%2i','   Number of function evals = ','%5i', '\n '  ' \n'], 'FAILED' , a , b , ansmlv , cor ,err , ierr , nfct);
end;
end;
[kontrl]=xgetf(kontrl);
if( kprint<=2 )
xsetf(0);
else;
xsetf(1);
end;
fatal = false;
if( kprint>=3 )
writef(lun,[ '\n ' ,' Test error returns', '\n ' ,' 2 error messages expected', '\n '  ' \n']);
end;
a = 0.0e0;
b = 1.0e0;
cor = 2.0e0;
err = 100.0e0.*r1mach(4);
req = err;
[dumvar1,a,b,err,ansmlv,ierr,nfct]=qnc79(@fqd1,a,b,err,ansmlv,ierr,nfct);
if( ierr==2 )
if( kprint>=3 )
writef(lun,[' Test of QNC79 ','%s', '\n ' ,' REQ =','%10.2f',repmat(' ',1,5),'ANS =','%20.13f',repmat(' ',1,5),'IERR =','%2i',repmat(' ',1,5),'       should be 2', '\n ' ,' ERR =','%10.2f',' CORRECT =','%20.13f', '\n '  ' \n'], 'PASSED' , req , ansmlv ,ierr , err , cor);
end;
else;
if( kprint>=2 )
writef(lun,[' Test of QNC79 ','%s', '\n ' ,' REQ =','%10.2f',repmat(' ',1,5),'ANS =','%20.13f',repmat(' ',1,5),'IERR =','%2i',repmat(' ',1,5),'       should be 2', '\n ' ,' ERR =','%10.2f',' CORRECT =','%20.13f', '\n '  ' \n'], 'FAILED' , req , ansmlv ,ierr , err , cor);
end;
ipass = 0;
fatal = true;
end;
a = 2.0e0;
b = a.*(1.0e0+r1mach(4));
cor = 0.0e0;
err = tol;
[dumvar1,a,b,err,ansmlv,ierr,nfct]=qnc79(@fqd1,a,b,err,ansmlv,ierr,nfct);
if( ierr==-1 && ansmlv==0.0e0 )
if( kprint>=3 )
writef(lun,[' Test of A and B nearly equal ','%s' ' \n'], 'PASSED');
end;
else;
ipass = 0;
fatal = true;
if( kprint>=2 )
writef(lun,[' Test of A and B nearly equal ','%s' ' \n'], 'FAILED');
end;
end;
[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 ' ,' QNC79 PASSED ALL TESTS*' ' \n']);
end;
if( ipass==0 && kprint>=2 )
writef(lun,[ '\n ' ,' QNC79 FAILED SOME TESTS' ' \n']);
end;
return;
%format ('1'/' QNC79 Quick Check');
%format [' Accuracy test of QNC79 ',a/' A = ',f10.5,'   B = ',f10.5/' Computed result = ',e14.7,'   Exact result = ',e14.7/' Tolerance = ',e14.7,'   IERR = ',i2,'   Number of function evals = ',i5];
%format [' Test error returns'/' 2 error messages expected'];
%format (' Test of QNC79 ',a/' REQ =',e10.2,5X,'ANS =',e20.13,5X,'IERR =',i2,5X,'       should be 2'/' ERR =',e10.2,' CORRECT =',e20.13];
%format (' Test of A and B nearly equal ',a);
%format [' QNC79 PASSED ALL TESTS*');
%format [' QNC79 FAILED SOME TESTS');
end %subroutine qn79qx

Contact us at files@mathworks.com