| [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
|
|