| [bcrhresult,xll,xrr,iz,c,a,bh,f,sgn]=bcrh(xll,xrr,iz,c,a,bh,f,sgn); |
function [bcrhresult,xll,xrr,iz,c,a,bh,f,sgn]=bcrh(xll,xrr,iz,c,a,bh,f,sgn);
bcrhresult=[];
persistent bcrh dx x xl xr ;
if isempty(bcrhresult), bcrhresult=0; end;
global ccblk_4; if isempty(ccblk_4), ccblk_4=0; end;
if isempty(dx), dx=0; end;
global ccblk_3; if isempty(ccblk_3), ccblk_3=0; end;
if isempty(x), x=0; end;
if isempty(xl), xl=0; end;
if isempty(xr), xr=0; end;
global ccblk_7; if isempty(ccblk_7), ccblk_7=0; end;
global ccblk_2; if isempty(ccblk_2), ccblk_2=0; end;
global ccblk_6; if isempty(ccblk_6), ccblk_6=0; end;
global ccblk_5; if isempty(ccblk_5), ccblk_5=0; end;
global ccblk_1; if isempty(ccblk_1), ccblk_1=0; end;
%***BEGIN PROLOGUE BCRH
%***SUBSIDIARY
%***PURPOSE Subsidiary to CBLKTR
%***LIBRARY SLATEC
%***TYPE SINGLE PRECISION (BCRH-S, BSRH-S)
%***AUTHOR (UNKNOWN)
%***SEE ALSO CBLKTR
%***ROUTINES CALLED (NONE)
%***COMMON BLOCKS CCBLK
%***REVISION HISTORY (YYMMDD)
% 801001 DATE WRITTEN
% 891214 Prologue converted to Version 4.0 format. (BAB)
% 900402 Added TYPE section. (WRB)
%***end PROLOGUE BCRH
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 /ccblk / npp , k , eps , cnv , nm , ncmplx , ik;
%% common /ccblk / ccblk_1 , ccblk_2 , ccblk_3 , ccblk_4 , ccblk_5 , ccblk_6 , ccblk_7;
%***FIRST EXECUTABLE STATEMENT BCRH
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 ) ;
bcrhresult = .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<=ccblk_4 )
break;
end;
end;
bcrhresult = .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
%DECK BDIFF
|
|