Code covered by the BSD License  

Highlights from
slatec

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

[bsrhresult,xll,xrr,iz,c,a,bh,f,sgn]=bsrh(xll,xrr,iz,c,a,bh,f,sgn);
function [bsrhresult,xll,xrr,iz,c,a,bh,f,sgn]=bsrh(xll,xrr,iz,c,a,bh,f,sgn);
bsrhresult=[];
persistent bsrh dx x xl xr ; 

if isempty(bsrhresult), bsrhresult=0; end;
global cblkt_4; if isempty(cblkt_4), cblkt_4=0; end;
if isempty(dx), dx=0; end;
global cblkt_3; if isempty(cblkt_3), cblkt_3=0; end;
if isempty(x), x=0; end;
if isempty(xl), xl=0; end;
if isempty(xr), xr=0; end;
global cblkt_7; if isempty(cblkt_7), cblkt_7=0; end;
global cblkt_2; if isempty(cblkt_2), cblkt_2=0; end;
global cblkt_6; if isempty(cblkt_6), cblkt_6=0; end;
global cblkt_5; if isempty(cblkt_5), cblkt_5=0; end;
global cblkt_1; if isempty(cblkt_1), cblkt_1=0; end;
%***BEGIN PROLOGUE  BSRH
%***SUBSIDIARY
%***PURPOSE  Subsidiary to BLKTRI
%***LIBRARY   SLATEC
%***TYPE      SINGLE PRECISION (BCRH-S, BSRH-S)
%***AUTHOR  (UNKNOWN)
%***SEE ALSO  BLKTRI
%***ROUTINES CALLED  (NONE)
%***COMMON BLOCKS    CBLKT
%***REVISION HISTORY  (YYMMDD)
%   801001  DATE WRITTEN
%   891214  Prologue converted to Version 4.0 format.  (BAB)
%   900402  Added TYPE section.  (WRB)
%***end PROLOGUE  BSRH
a_shape=size(a);a=reshape(a,1,[]);
c_shape=size(c);c=reshape(c,1,[]);
bh_shape=size(bh);bh=reshape(bh,1,[]);
% common :: ;
%% common /cblkt / npp , k , eps , cnv , nm , ncmplx , ik;
%% common /cblkt / cblkt_1 , cblkt_2 , cblkt_3 , cblkt_4 , cblkt_5 , cblkt_6 , cblkt_7;
%***FIRST EXECUTABLE STATEMENT  BSRH
xl = xll;
xr = xrr;
dx = .5.*abs(xr-xl);
while (1);
x = .5.*(xl+xr);
if( sgn.*f(x,iz,c,a,bh)<0 )
xl = x;
elseif( sgn.*f(x,iz,c,a,bh)==0 ) ;
bsrhresult = .5.*(xl+xr);
a_shape=zeros(a_shape);a_shape(:)=a(1:numel(a_shape));a=a_shape;
c_shape=zeros(c_shape);c_shape(:)=c(1:numel(c_shape));c=c_shape;
bh_shape=zeros(bh_shape);bh_shape(:)=bh(1:numel(bh_shape));bh=bh_shape;
csnil=dbstack(1); csnil=csnil(1).name(1)~='@';
if csnil&&~isempty(inputname(2)), assignin('caller','FUntemp',xrr); evalin('caller',[inputname(2),'=FUntemp;']); end
if csnil&&~isempty(inputname(1)), assignin('caller','FUntemp',xll); evalin('caller',[inputname(1),'=FUntemp;']); end
if csnil&&~isempty(inputname(8)), assignin('caller','FUntemp',sgn); evalin('caller',[inputname(8),'=FUntemp;']); end
if csnil&&~isempty(inputname(3)), assignin('caller','FUntemp',iz); evalin('caller',[inputname(3),'=FUntemp;']); end
if csnil&&~isempty(inputname(7)), assignin('caller','FUntemp',f); evalin('caller',[inputname(7),'=FUntemp;']); end
if csnil&&~isempty(inputname(4)), assignin('caller','FUntemp',c); evalin('caller',[inputname(4),'=FUntemp;']); end
if csnil&&~isempty(inputname(6)), assignin('caller','FUntemp',bh); evalin('caller',[inputname(6),'=FUntemp;']); end
if csnil&&~isempty(inputname(5)), assignin('caller','FUntemp',a); evalin('caller',[inputname(5),'=FUntemp;']); end
return;
else;
xr = x;
end;
dx = .5.*dx;
if( dx<=cblkt_4 )
break;
end;
end;
bsrhresult = .5.*(xl+xr);
a_shape=zeros(a_shape);a_shape(:)=a(1:numel(a_shape));a=a_shape;
c_shape=zeros(c_shape);c_shape(:)=c(1:numel(c_shape));c=c_shape;
bh_shape=zeros(bh_shape);bh_shape(:)=bh(1:numel(bh_shape));bh=bh_shape;
csnil=dbstack(1); csnil=csnil(1).name(1)~='@';
if csnil&&~isempty(inputname(2)), assignin('caller','FUntemp',xrr); evalin('caller',[inputname(2),'=FUntemp;']); end
if csnil&&~isempty(inputname(1)), assignin('caller','FUntemp',xll); evalin('caller',[inputname(1),'=FUntemp;']); end
if csnil&&~isempty(inputname(8)), assignin('caller','FUntemp',sgn); evalin('caller',[inputname(8),'=FUntemp;']); end
if csnil&&~isempty(inputname(3)), assignin('caller','FUntemp',iz); evalin('caller',[inputname(3),'=FUntemp;']); end
if csnil&&~isempty(inputname(7)), assignin('caller','FUntemp',f); evalin('caller',[inputname(7),'=FUntemp;']); end
if csnil&&~isempty(inputname(4)), assignin('caller','FUntemp',c); evalin('caller',[inputname(4),'=FUntemp;']); end
if csnil&&~isempty(inputname(6)), assignin('caller','FUntemp',bh); evalin('caller',[inputname(6),'=FUntemp;']); end
if csnil&&~isempty(inputname(5)), assignin('caller','FUntemp',a); evalin('caller',[inputname(5),'=FUntemp;']); end
end %function bsrh
%DECK BVALU

Contact us at files@mathworks.com