public static void dstzr(ref E0000_E0001_Data data, double zxlo, double zxhi, double zabstl, double zreltl)
{
data.xlo = zxlo;
data.xhi = zxhi;
data.zabstl = zabstl;
data.zreltl = zreltl;
dstzr(ref data);
}
public static void dstinv(ref E0000_E0001_Data data, double zsmall_, double zbig_, double zabsst_,
double zrelst_, double zstpmu_, double zabsto_, double zrelto_)
{
data.zsmall = zsmall_;
data.zbig = zbig_;
data.zabsst = zabsst_;
data.zrelst = zrelst_;
data.zstpmu = zstpmu_;
data.zabsto = zabsto_;
data.zrelto = zrelto_;
dstinv(ref data);
}
public static void E0000(int IENTRY, ref E0000_E0001_Data data)
//****************************************************************************80
//
// Purpose:
//
// E0000 is a reverse-communication zero bounder.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 14 February 2021
//
// Author:
//
// Barry Brown, James Lovato, Kathy Russell.
//
{
switch (IENTRY)
{
case 0: goto DINVR;
case 1: goto DSTINV;
}
DINVR:
switch (data.status)
{
case > 0:
goto S310;
}
data.e0000vars.qcond = !qxmon(data.e0000vars.small, data.x, data.e0000vars.big);
switch (data.e0000vars.qcond)
{
case true:
throw new Exception(" SMALL, X, BIG not monotone in INVR");
}
data.e0000vars.xsave = data.x;
//
// See that SMALL and BIG bound the zero and set QINCR
//
data.x = data.e0000vars.small;
//
// GET-FUNCTION-VALUE
//
data.e0000vars.i99999 = 1;
goto S300;
S10:
data.e0000vars.fsmall = data.fx;
data.x = data.e0000vars.big;
//
// GET-FUNCTION-VALUE
//
data.e0000vars.i99999 = 2;
goto S300;
S20:
data.e0000vars.fbig = data.fx;
data.e0000vars.qincr = data.e0000vars.fbig > data.e0000vars.fsmall;
switch (data.e0000vars.qincr)
{
case false:
goto S50;
}
switch (data.e0000vars.fsmall)
{
case <= 0.0e0:
goto S30;
}
data.status = -1;
data.qleft = data.qhi = true;
return;
S30:
switch (data.e0000vars.fbig)
{
case >= 0.0e0:
goto S40;
}
data.status = -1;
data.qleft = data.qhi = false;
return;
S40:
goto S80;
S50:
switch (data.e0000vars.fsmall)
{
case >= 0.0e0:
goto S60;
}
data.status = -1;
data.qleft = true;
data.qhi = false;
return;
S60:
switch (data.e0000vars.fbig)
{
case <= 0.0e0:
goto S70;
}
data.status = -1;
data.qleft = false;
data.qhi = true;
return;
S80:
S70:
data.x = data.e0000vars.xsave;
data.e0000vars.step = Math.Max(data.e0000vars.absstp, data.e0000vars.relstp * Math.Abs(data.x));
//
// YY = F(X) - Y
// GET-FUNCTION-VALUE
//
data.e0000vars.i99999 = 3;
goto S300;
S90:
data.e0000vars.yy = data.fx;
if (data.e0000vars.yy != 0.0e0)
{
goto S100;
}
data.status = 0;
// qok = 1;
return;
S100:
data.e0000vars.qup = data.e0000vars.qincr && data.e0000vars.yy <0.0e0 || !data.e0000vars.qincr && data.e0000vars.yy> 0.0e0;
switch (data.e0000vars.qup)
{
//
// HANDLE CASE IN WHICH WE MUST STEP HIGHER
//
case false:
goto S170;
}
data.e0000vars.xlb = data.e0000vars.xsave;
data.e0000vars.xub = Math.Min(data.e0000vars.xlb + data.e0000vars.step, data.e0000vars.big);
goto S120;
S110:
switch (data.e0000vars.qcond)
{
case true:
goto S150;
}
S120:
//
// YY = F(XUB) - Y
//
data.x = data.e0000vars.xub;
//
// GET-FUNCTION-VALUE
//
data.e0000vars.i99999 = 4;
goto S300;
S130:
data.e0000vars.yy = data.fx;
data.e0000vars.qbdd = data.e0000vars.qincr && data.e0000vars.yy >= 0.0e0 || !data.e0000vars.qincr && data.e0000vars.yy <= 0.0e0;
data.e0000vars.qlim = data.e0000vars.xub >= data.e0000vars.big;
data.e0000vars.qcond = data.e0000vars.qbdd || data.e0000vars.qlim;
switch (data.e0000vars.qcond)
{
case true:
goto S140;
}
data.e0000vars.step = data.e0000vars.stpmul * data.e0000vars.step;
data.e0000vars.xlb = data.e0000vars.xub;
data.e0000vars.xub = Math.Min(data.e0000vars.xlb + data.e0000vars.step, data.e0000vars.big);
S140:
goto S110;
S150:
switch (data.e0000vars.qlim && !data.e0000vars.qbdd)
{
case false:
goto S160;
}
data.status = -1;
data.qleft = false;
data.qhi = !data.e0000vars.qincr;
data.x = data.e0000vars.big;
return;
S160:
goto S240;
S170:
//
// HANDLE CASE IN WHICH WE MUST STEP LOWER
//
data.e0000vars.xub = data.e0000vars.xsave;
data.e0000vars.xlb = Math.Max(data.e0000vars.xub - data.e0000vars.step, data.e0000vars.small);
goto S190;
S180:
switch (data.e0000vars.qcond)
{
case true:
goto S220;
}
S190:
//
// YY = F(XLB) - Y
//
data.x = data.e0000vars.xlb;
//
// GET-FUNCTION-VALUE
//
data.e0000vars.i99999 = 5;
goto S300;
S200:
data.e0000vars.yy = data.fx;
data.e0000vars.qbdd = data.e0000vars.qincr && data.e0000vars.yy <= 0.0e0 || !data.e0000vars.qincr && data.e0000vars.yy >= 0.0e0;
data.e0000vars.qlim = data.e0000vars.xlb <= data.e0000vars.small;
data.e0000vars.qcond = data.e0000vars.qbdd || data.e0000vars.qlim;
switch (data.e0000vars.qcond)
{
case true:
goto S210;
}
data.e0000vars.step = data.e0000vars.stpmul * data.e0000vars.step;
data.e0000vars.xub = data.e0000vars.xlb;
data.e0000vars.xlb = Math.Max(data.e0000vars.xub - data.e0000vars.step, data.e0000vars.small);
S210:
goto S180;
S220:
switch (data.e0000vars.qlim && !data.e0000vars.qbdd)
{
case false:
goto S230;
}
data.status = -1;
data.qleft = true;
data.qhi = data.e0000vars.qincr;
data.x = data.e0000vars.small;
return;
S240:
S230:
dstzr(ref data, data.e0000vars.xlb, data.e0000vars.xub, data.e0000vars.abstol, data.e0000vars.reltol);
//
// IF WE REACH HERE, XLB AND XUB BOUND THE ZERO OF F.
//
data.status = 0;
goto S260;
S250:
if (data.status != 1)
{
goto S290;
}
S260:
data.qleft = E0000_E0001_Data.E0000Variables.qdum1;
data.qhi = E0000_E0001_Data.E0000Variables.qdum2;
dzror(ref data);
if (data.status != 1)
{
goto S280;
}
//
// GET-FUNCTION-VALUE
//
data.e0000vars.i99999 = 6;
goto S300;
S280:
S270:
goto S250;
S290:
data.x = data.xlo;
data.status = 0;
return;
DSTINV:
data.e0000vars.small = data.zsmall;
data.e0000vars.big = data.zbig;
data.e0000vars.absstp = data.zabsst;
data.e0000vars.relstp = data.zrelst;
data.e0000vars.stpmul = data.zstpmu;
data.e0000vars.abstol = data.zabsto;
data.e0000vars.reltol = data.zrelto;
return;
S300:
//
// TO GET-FUNCTION-VALUE
//
data.status = 1;
return;
S310:
switch (data.e0000vars.i99999)
{
case 1: goto S10;
case 2: goto S20;
case 3: goto S90;
case 4: goto S130;
case 5: goto S200;
case 6: goto S270;
}
}
public static void dzror(ref E0000_E0001_Data data)
//****************************************************************************80
//
// Purpose:
//
// DZROR seeks the zero of a function using reverse communication.
//
// Discussion:
//
// Performs the zero finding. STZROR must have been called before
// this routine in order to set its parameters.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 14 February 2021
//
// Author:
//
// Barry Brown, James Lovato, Kathy Russell.
//
// Parameters:
//
// int STATUS <--> At the beginning of a zero finding problem, STATUS
// should be set to 0 and ZROR invoked. (The value
// of other parameters will be ignored on this call.)
//
// When ZROR needs the function evaluated, it will set
// STATUS to 1 and return. The value of the function
// should be set in FX and ZROR again called without
// changing any of its other parameters.
//
// When ZROR has finished without error, it will return
// with STATUS 0. In that case (XLO,XHI) bound the answe
//
// If ZROR finds an error (which implies that F(XLO)-Y an
// F(XHI)-Y have the same sign, it returns STATUS -1. In
// this case, XLO and XHI are undefined.
//
// double X <-- The value of X at which F(X) is to be evaluated.
//
// double FX --> The value of F(X) calculated when ZROR returns with
// STATUS = 1.
//
// double XLO <-- When ZROR returns with STATUS = 0, XLO bounds the
// inverval in X containing the solution below.
//
// double XHI <-- When ZROR returns with STATUS = 0, XHI bounds the
// inverval in X containing the solution above.
//
// bool QLEFT <-- .TRUE. if the stepping search terminated unsucessfully
// at XLO. If it is .FALSE. the search terminated
// unsucessfully at XHI.
//
// bool QHI <-- .TRUE. if F(X) .GT. Y at the termination of the
// search and .FALSE. if F(X) < Y at the
// termination of the search.
//
{
E0001(0, ref data);
}
public static void dzror(ref E0000_E0001_Data data, double x_)
{
}
public static void dstzr(ref E0000_E0001_Data data)
//****************************************************************************80
//
// Purpose:
//
// DSTXR sets quantities needed by the zero finder.
//
// Discussion:
//
// Double precision SeT ZeRo finder - Reverse communication version
// Function
// Sets quantities needed by ZROR. The function of ZROR
// and the quantities set is given here.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 14 February 2021
//
// Concise Description
//
// Given a function F
// find XLO such that F(XLO) = 0.
// More Precise Description -
// Input condition. F is a double function of a single
// double argument and XLO and XHI are such that
// F(XLO)*F(XHI) <= 0.0
// If the input condition is met, QRZERO returns .TRUE.
// and output values of XLO and XHI satisfy the following
// F(XLO)*F(XHI) <= 0.
// ABS(F(XLO) <= ABS(F(XHI)
// ABS(XLO-XHI) <= TOL(X)
// where
// TOL(X) = MAX(ABSTOL,RELTOL*ABS(X))
// If this algorithm does not find XLO and XHI satisfying
// these conditions then QRZERO returns .FALSE. This
// implies that the input condition was not met.
//
// Parameters:
//
// XLO --> The left endpoint of the interval to be
// searched for a solution.
// XLO is DOUBLE PRECISION
// XHI --> The right endpoint of the interval to be
// for a solution.
// XHI is DOUBLE PRECISION
// ABSTOL, RELTOL --> Two numbers that determine the accuracy
// of the solution. See function for a
// precise definition.
// ABSTOL is DOUBLE PRECISION
// RELTOL is DOUBLE PRECISION
//
// Method
// Algorithm R of the paper 'Two Efficient Algorithms with
// Guaranteed Convergence for Finding a Zero of a Function'
// by J. C. P. Bus and T. J. Dekker in ACM Transactions on
// Mathematical Software, Volume 1, no. 4 page 330
// (Dec. '75) is employed to find the zero of F(X)-Y.
//
{
E0001(1, ref data);
}
public static void dstinv(ref E0000_E0001_Data data)
//****************************************************************************80
//
// Purpose:
//
// DSTINV seeks a value X such that F(X) = Y.
//
// Discussion:
//
// DSTINV is the double precision set inverse finder.
// It uses reverse communication.
//
// Given a monotone function F and a value Y, it finds X
// such that F(X) = Y.
//
// This routine sets quantities needed by INVR.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 14 February 2021
//
// More Precise Description of INVR -
//
// F must be a monotone function, the results of QMFINV are
// otherwise undefined. QINCR must be .TRUE. if F is non-
// decreasing and .FALSE. if F is non-increasing.
// QMFINV will return .TRUE. if and only if F(SMALL) and
// F(BIG) bracket Y, i. e.,
// QINCR is .TRUE. and F(SMALL)<=Y<=F(BIG) or
// QINCR is .FALSE. and F(BIG)<=Y<=F(SMALL)
// if QMFINV returns .TRUE., then the X returned satisfies
// the following condition. let
// TOL(X) = MAX(ABSTOL,RELTOL*ABS(X))
// then if QINCR is .TRUE.,
// F(X-TOL(X)) <= Y <= F(X+TOL(X))
// and if QINCR is .FALSE.
// F(X-TOL(X)) .GE. Y .GE. F(X+TOL(X))
//
// Method
// Compares F(X) with Y for the input value of X then uses QINCR
// to determine whether to step left or right to bound the
// desired x. the initial step size is
// MAX(ABSSTP,RELSTP*ABS(S)) for the input value of X.
// Iteratively steps right or left until it bounds X.
// At each step which doesn't bound X, the step size is doubled.
// The routine is careful never to step beyond SMALL or BIG. If
// it hasn't bounded X at SMALL or BIG, QMFINV returns .FALSE.
// after setting QLEFT and QHI.
// If X is successfully bounded then Algorithm R of the paper
// 'Two Efficient Algorithms with Guaranteed Convergence for
// Finding a Zero of a Function' by J. C. P. Bus and
// T. J. Dekker in ACM Transactions on Mathematical
// Software, Volume 1, No. 4 page 330 (DEC. '75) is employed
// to find the zero of the function F(X)-Y. This is routine
// QRZERO.
//
// Parameters:
//
// double SMALL --> The left endpoint of the interval to be
// searched for a solution.
//
// double BIG --> The right endpoint of the interval to be
// searched for a solution.
//
// double ABSSTP, RELSTP --> The initial step size in the search
// is MAX(ABSSTP,RELSTP*ABS(X)). See algorithm.
//
// double STPMUL --> When a step doesn't bound the zero, the step
// size is multiplied by STPMUL and another step
// taken. A popular value is 2.0
//
// double ABSTOL, RELTOL --> Two numbers that determine the accuracy
// of the solution. See function for a precise definition.
//
{
E0000(1, ref data);
}
