Code covered by the BSD License  

Highlights from
slatec

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

[lun,num1,kprint,ip,exact,result,abserr,neval,ierv,lierv]=dprin(lun,num1,kprint,ip,exact,result,abserr,neval,ierv,lierv);
function [lun,num1,kprint,ip,exact,result,abserr,neval,ierv,lierv]=dprin(lun,num1,kprint,ip,exact,result,abserr,neval,ierv,lierv);
persistent error ier k ; 

ierv_shape=size(ierv);ierv=reshape(ierv,1,[]);
if isempty(error), error=0; end;
if isempty(ier), ier=0; end;
if isempty(k), k=0; end;
ier = fix(ierv(1));
error = abs(exact-result);
if( kprint>=2 )
if( ip~=1 )
writef(lun,[' TEST ON IER = ','%1i',' FAILED.' ' \n'], num1);
if( num1==0 )
writef(lun,[' WE MUST HAVE IER = 0, ERROR <= ABSERR AND ABSERR.LE','.MAX(EPSABS,EPSREL*ABS(EXACT))' ' \n']);
end;
if( num1>0 )
writef(lun,[' WE MUST HAVE IER = ','%1i' ' \n'], num1);
end;
if( lierv>1 )
for k=(2):(lierv),  writef(lun,[' OR IER =     ',repmat(['%1i',repmat(' ',1,2)] ,1,8) ' \n'],ierv(k)); end;
end;
if( num1==6 )
writef(lun,[' RESULT, ABSERR, NEVAL AND EVENTUALLY LAST SHOULD BE',' ZERO' ' \n']);
end;
writef(lun,[' WE HAVE   ' ' \n']);
writef(lun,[repmat(' ',1,7),'EXACT',repmat(' ',1,11),'RESULT',repmat(' ',1,6),'ERROR',repmat(' ',1,4),'ABSERR',repmat(' ',1,4),'IER     NEVAL', '\n ' ,' ',repmat(' ',1,42),'(EST.ERR.,FLAG,NO F-EVAL)' ' \n']);
if( num1~=5 )
writef(lun,[' ',repmat(['%15.7f',repmat(' ',1,1)] ,1,2),repmat(['%9.2f',repmat(' ',1,1)] ,1,2),'%4i',repmat(' ',1,4),'%6i' ' \n'], exact , result , error , abserr ,ier , neval);
else;
writef(lun,[repmat(' ',1,5),'INFINITY',repmat(' ',1,4),'%15.7f',repmat(' ',1,11),'%9.2f','%5i',repmat(' ',1,4),'%6i' ' \n'], result , abserr , ier , neval);
end;
elseif( kprint>=3 ) ;
writef(lun,[' TEST ON IER = ','%2i',' PASSED' ' \n'], num1);
end;
end;
ierv_shape=zeros(ierv_shape);ierv_shape(:)=ierv(1:numel(ierv_shape));ierv=ierv_shape;
return;
%format (' TEST ON IER = ',i2,' PASSED');
%format (' TEST ON IER = ',i1,' FAILED.');
%format (' WE MUST HAVE IER = 0, ERROR <= ABSERR AND ABSERR.LE','.MAX(EPSABS,EPSREL*ABS(EXACT))');
%format (' WE MUST HAVE IER = ',i1);
%format (' OR IER =     ',8(i1,2X));
%format (' RESULT, ABSERR, NEVAL AND EVENTUALLY LAST SHOULD BE',' ZERO');
%format (' WE HAVE   ');
%format (7X,'EXACT',11X,'RESULT',6X,'ERROR',4X,'ABSERR',4X,'IER     NEVAL',/,' ',42X,'(EST.ERR.,FLAG,NO F-EVAL)');
%format (' ',2(d15.7,1X),2(d9.2,1X),i4,4X,i6);
%format (5X,'INFINITY',4X,d15.7,11X,d9.2,i5,4X,i6);
ierv_shape=zeros(ierv_shape);ierv_shape(:)=ierv(1:numel(ierv_shape));ierv=ierv_shape;
end %subroutine dprin

Contact us