// Last two ints before fcnData are for the array index baselines.
public static int hybrd(Func <int, double[], double[], int, int, int, fcnData> fcn,
int n, double[] x,
double[] fvec, double xtol, int maxfev, int ml, int mu, double epsfcn,
double[] diag, int mode, double factor, int nprint, int nfev,
double[] fjac, int ldfjac, double[] r, int lr, double[] qtf, double[] wa1,
double[] wa2, double[] wa3, double[] wa4, int fjacIndex, int rIndex, int qtfIndex, int wa1Index, int wa2Index, int wa3Index, int wa4Index)
//****************************************************************************80
//
// Purpose:
//
// hybrd() finds a zero of a system of N nonlinear equations.
//
// Discussion:
//
// The purpose of HYBRD is to find a zero of a system of
// N nonlinear functions in N variables by a modification
// of the Powell hybrid method.
//
// The user must provide FCN, which calculates the functions.
//
// The jacobian is calculated by a forward-difference approximation.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 08 April 2010
//
// Author:
//
// Original FORTRAN77 version by Jorge More, Burt Garbow, Ken Hillstrom.
// C++ version by John Burkardt.
//
// Reference:
//
// Jorge More, Burton Garbow, Kenneth Hillstrom,
// User Guide for MINPACK-1,
// Technical Report ANL-80-74,
// Argonne National Laboratory, 1980.
//
// Parameters:
//
// fcn is the name of the user-supplied subroutine which
// calculates the functions. fcn must be declared
// in an external statement in the user calling
// program, and should be written as follows.
//
// subroutine fcn(n,x,fvec,iflag)
// integer n,iflag
// double precision x(n),fvec(n)
// ----------
// calculate the functions at x and
// return this vector in fvec.
// ---------
// return
// end
//
// the value of iflag should not be changed by fcn unless
// the user wants to terminate execution of hybrd.
// in this case set iflag to a negative integer.
//
// Input, int N, the number of functions and variables.
//
// Input/output, double X[N]. On input an initial estimate of the solution.
// On output, the final estimate of the solution.
//
// Output, double FVEC[N], the functions evaluated at the output value of X.
//
// Input, double XTOL, a nonnegative value. Termination occurs when the
// relative error between two consecutive iterates is at most XTOL.
//
// Input, int MAXFEV. Termination occurs when the number of calls to FCN
// is at least MAXFEV by the end of an iteration.
//
// Input, int ML, specifies the number of subdiagonals within the band of
// the jacobian matrix. If the jacobian is not banded, set
// ml to at least n - 1.
//
// mu is a nonnegative integer input variable which specifies
// the number of superdiagonals within the band of the
// jacobian matrix. if the jacobian is not banded, set
// mu to at least n - 1.
//
// epsfcn is an input variable used in determining a suitable
// step length for the forward-difference approximation. this
// approximation assumes that the relative errors in the
// functions are of the order of epsfcn. if epsfcn is less
// than the machine precision, it is assumed that the relative
// errors in the functions are of the order of the machine
// precision.
//
// diag is an array of length n. if mode = 1 (see
// below), diag is internally set. if mode = 2, diag
// must contain positive entries that serve as
// multiplicative scale factors for the variables.
//
// mode is an integer input variable. if mode = 1, the
// variables will be scaled internally. if mode = 2,
// the scaling is specified by the input diag. other
// values of mode are equivalent to mode = 1.
//
// factor is a positive input variable used in determining the
// initial step bound. this bound is set to the product of
// factor and the euclidean norm of diag*x if nonzero, or else
// to factor itself. in most cases factor should lie in the
// interval (.1,100.). 100. is a generally recommended value.
//
// nprint is an integer input variable that enables controlled
// printing of iterates if it is positive. in this case,
// fcn is called with iflag = 0 at the beginning of the first
// iteration and every nprint iterations thereafter and
// immediately prior to return, with x and fvec available
// for printing. if nprint is not positive, no special calls
// of fcn with iflag = 0 are made.
//
// info is an integer output variable. if the user has
// terminated execution, info is set to the (negative)
// value of iflag. see description of fcn. otherwise,
// info is set as follows.
//
// info = 0 improper input parameters.
//
// info = 1 relative error between two consecutive iterates
// is at most xtol.
//
// info = 2 number of calls to fcn has reached or exceeded
// maxfev.
//
// info = 3 xtol is too small. no further improvement in
// the approximate solution x is possible.
//
// info = 4 iteration is not making good progress, as
// measured by the improvement from the last
// five jacobian evaluations.
//
// info = 5 iteration is not making good progress, as
// measured by the improvement from the last
// ten iterations.
//
// nfev is an integer output variable set to the number of
// calls to fcn.
//
// fjac is an output n by n array which contains the
// orthogonal matrix q produced by the qr factorization
// of the final approximate jacobian.
//
// ldfjac is a positive integer input variable not less than n
// which specifies the leading dimension of the array fjac.
//
// r is an output array of length lr which contains the
// upper triangular matrix produced by the qr factorization
// of the final approximate jacobian, stored rowwise.
//
// lr is a positive integer input variable not less than
// (n*(n+1))/2.
//
// qtf is an output array of length n which contains
// the vector (q transpose)*fvec.
//
// wa1, wa2, wa3, and wa4 are work arrays of length n.
//
{
double delta = 0;
int[] iwa = new int[1];
int j;
const double p001 = 0.001;
const double p0001 = 0.0001;
const double p1 = 0.1;
const double p5 = 0.5;
double xnorm = 0;
//
// Certain loops in this function were kept closer to their original FORTRAN77
// format, to avoid confusing issues with the array index L. These loops are
// marked "DO NOT ADJUST", although they certainly could be adjusted (carefully)
// once the initial translated code is tested.
//
//
// EPSMCH is the machine precision.
//
double epsmch = typeMethods.r8_epsilon();
int info = 0;
int iflag = 0;
nfev = 0;
switch (n)
{
//
// Check the input parameters.
//
case <= 0:
info = 0;
return(info);
}
switch (xtol)
{
case < 0.0:
info = 0;
return(info);
}
switch (maxfev)
{
case <= 0:
info = 0;
return(info);
}
switch (ml)
{
case < 0:
info = 0;
return(info);
}
switch (mu)
{
case < 0:
info = 0;
return(info);
}
switch (factor)
{
case <= 0.0:
info = 0;
return(info);
}
if (ldfjac < n)
{
info = 0;
return(info);
}
if (lr < n * (n + 1) / 2)
{
info = 0;
return(info);
}
switch (mode)
{
case 2:
{
for (j = 0; j < n; j++)
{
switch (diag[j])
{
case <= 0.0:
info = 0;
return(info);
}
}
break;
}
}
//
// Evaluate the function at the starting point and calculate its norm.
//
iflag = 1;
fcnData res = fcn(n, x, fvec, iflag, 0, 0);
fvec = res.fvec;
iflag = res.iflag;
nfev = 1;
switch (iflag)
{
case < 0:
info = iflag;
return(info);
}
double fnorm = Helpers.enorm(n, fvec);
//
// Determine the number of calls to FCN needed to compute the jacobian matrix.
//
int msum = Math.Min(ml + mu + 1, n);
//
// Initialize iteration counter and monitors.
//
int iter = 1;
int ncsuc = 0;
int ncfail = 0;
int nslow1 = 0;
int nslow2 = 0;
//
// Beginning of the outer loop.
//
for (;;)
{
bool jeval = true;
//
// Calculate the jacobian matrix.
//
iflag = 2;
fdjac1(fcn, n, x, fvec, fjac, ldfjac, ref iflag, ml, mu, epsfcn, wa1, wa2, fjacIndex: fjacIndex, wa1Index: wa1Index, wa2Index: wa2Index);
nfev += msum;
switch (iflag)
{
case < 0:
info = iflag;
return(info);
}
//
// Compute the QR factorization of the jacobian.
//
int tmpi = 1;
QRSolve.qrfac(n, n, ref fjac, ldfjac, false, ref iwa, ref tmpi, ref wa1, ref wa2, rdiagIndex: wa1Index, acnormIndex: wa2Index);
switch (iter)
{
//
// On the first iteration and if MODE is 1, scale according
// to the norms of the columns of the initial jacobian.
//
case 1:
{
switch (mode)
{
case 1:
{
for (j = 0; j < n; j++)
{
if (wa2[wa2Index + j] != 0.0)
{
diag[j] = wa2[wa2Index + j];
}
else
{
diag[j] = 1.0;
}
}
break;
}
}
//
// On the first iteration, calculate the norm of the scaled X
// and initialize the step bound DELTA.
//
for (j = 0; j < n; j++)
{
wa3[wa3Index + j] = diag[j] * x[j];
}
xnorm = Helpers.enorm(n, wa3);
delta = xnorm switch
{
0.0 => factor,
_ => factor * xnorm
};
break;
}
}
//
// Form Q' * FVEC and store in QTF.
//
int i;
for (i = 0; i < n; i++)
{
qtf[qtfIndex + i] = fvec[i];
}
double temp;
double sum;
for (j = 0; j < n; j++)
{
if (fjac[fjacIndex + j + j * ldfjac] == 0.0)
{
continue;
}
sum = 0.0;
for (i = j; i < n; i++)
{
sum += fjac[fjacIndex + i + j * ldfjac] * qtf[qtfIndex + i];
}
temp = -sum / fjac[fjacIndex + j + j * ldfjac];
for (i = j; i < n; i++)
{
qtf[qtfIndex + i] += fjac[fjacIndex + i + j * ldfjac] * temp;
}
}
//
// Copy the triangular factor of the QR factorization into R.
//
// DO NOT ADJUST THIS LOOP, BECAUSE OF L.
//
int l;
for (j = 1; j <= n; j++)
{
l = j;
for (i = 1; i <= j - 1; i++)
{
r[rIndex + (l - 1)] = fjac[fjacIndex + (i - 1) + (j - 1) * ldfjac];
l = l + n - i;
}
r[rIndex + (l - 1)] = wa1[wa1Index + (j - 1)];
switch (wa1[wa1Index + (j - 1)])
{
case 0.0:
Console.WriteLine(" Matrix is singular.");
break;
}
}
//
// Accumulate the orthogonal factor in FJAC.
//
QRSolve.qform(n, n, ref fjac, ldfjac, qIndex: fjacIndex);
switch (mode)
{
//
// Rescale if necessary.
//
case 1:
{
for (j = 0; j < n; j++)
{
diag[j] = Math.Max(diag[j], wa2[wa2Index + j]);
}
break;
}
}
//
// Beginning of the inner loop.
//
for (;;)
{
switch (nprint)
{
//
// If requested, call FCN to enable printing of iterates.
//
case > 0:
{
switch ((iter - 1) % nprint)
{
case 0:
{
iflag = 0;
fcn(n, x, fvec, iflag, 0, 0);
switch (iflag)
{
case < 0:
info = iflag;
return(info);
}
break;
}
}
break;
}
}
//
// Determine the direction P.
//
dogleg(n, r, lr, diag, qtf, delta, ref wa1, wa2, wa3, rIndex: rIndex, qtbIndex: qtfIndex, xIndex: wa1Index, wa1Index: wa2Index, wa2Index: wa3Index);
//
// Store the direction P and X + P. Calculate the norm of P.
//
for (j = 0; j < n; j++)
{
wa1[wa1Index + j] = -wa1[j];
wa2[wa2Index + j] = x[j] + wa1[j];
wa3[wa3Index + j] = diag[j] * wa1[wa1Index + j];
}
double pnorm = Helpers.enorm(n, wa3);
delta = iter switch
{
//
// On the first iteration, adjust the initial step bound.
//
1 => Math.Min(delta, pnorm),
_ => delta
};
//
// Evaluate the function at X + P and calculate its norm.
//
iflag = 1;
fcn(n, wa2, wa4, iflag, wa2Index, wa4Index);
nfev += 1;
switch (iflag)
{
case < 0:
info = iflag;
return(info);
}
double fnorm1 = Helpers.enorm(n, wa4);
//
// Compute the scaled actual reduction.
//
double actred;
if (fnorm1 < fnorm)
{
actred = 1.0 - fnorm1 / fnorm * (fnorm1 / fnorm);
}
else
{
actred = -1.0;
}
//
// Compute the scaled predicted reduction.
//
// DO NOT ADJUST THIS LOOP, BECAUSE OF L.
//
l = 1;
for (i = 1; i <= n; i++)
{
sum = 0.0;
for (j = i; j <= n; j++)
{
sum += r[rIndex + (l - 1)] * wa1[wa1Index + (j - 1)];
l += 1;
}
wa3[i - 1] = qtf[i - 1] + sum;
}
temp = Helpers.enorm(n, wa3);
double prered;
if (temp < fnorm)
{
prered = 1.0 - temp / fnorm * (temp / fnorm);
}
else
{
prered = 0.0;
}
double ratio = prered switch
{
//
// Compute the ratio of the actual to the predicted reduction.
//
> 0.0 => actred / prered,
_ => 0.0
};
switch (ratio)
{
//
// Update the step bound.
//
case < p1:
ncsuc = 0;
ncfail += 1;
delta = p5 * delta;
break;
default:
{
ncfail = 0;
ncsuc += 1;
if (p5 <= ratio || 1 < ncsuc)
{
delta = Math.Max(delta, pnorm / p5);
}
delta = Math.Abs(ratio - 1.0) switch
{
<= p1 => pnorm / p5,
_ => delta
};
break;
}
}
public static void fdjac2(Func <int, int, double[], double[], int, fcnData> fcn,
int m, int n, double[] x, double[] fvec, double[] fjac, int ldfjac,
ref int iflag, double epsfcn, double[] wa)
//****************************************************************************80
//
// Purpose:
//
// fdjac2() estimates an M by N Jacobian matrix using forward differences.
//
// Discussion:
//
// This function computes a forward-difference approximation
// to the M by N jacobian matrix associated with a specified
// problem of M functions in N variables.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 05 April 2010
//
// Author:
//
// Original FORTRAN77 version by Jorge More, Burt Garbow, Ken Hillstrom.
// C++ version by John Burkardt.
//
// Reference:
//
// Jorge More, Burton Garbow, Kenneth Hillstrom,
// User Guide for MINPACK-1,
// Technical Report ANL-80-74,
// Argonne National Laboratory, 1980.
//
// Parameters:
//
// fcn is the name of the user-supplied subroutine which
// calculates the functions. fcn must be declared
// in an external statement in the user calling
// program, and should be written as follows.
//
// subroutine fcn(m,n,x,fvec,iflag)
// integer m,n,iflag
// double precision x(n),fvec(m)
// ----------
// calculate the functions at x and
// return this vector in fvec.
// ----------
// return
// end
//
// the value of iflag should not be changed by fcn unless
// the user wants to terminate execution of fdjac2.
// in this case set iflag to a negative integer.
//
// Input, int M, the number of functions.
//
// Input, int N, the number of variables. N must not exceed M.
//
// Input, double X[N], the point at which the jacobian is to be estimated.
//
// fvec is an input array of length m which must contain the
// functions evaluated at x.
//
// fjac is an output m by n array which contains the
// approximation to the jacobian matrix evaluated at x.
//
// ldfjac is a positive integer input variable not less than m
// which specifies the leading dimension of the array fjac.
//
// iflag is an integer variable which can be used to terminate
// the execution of fdjac2. see description of fcn.
//
// epsfcn is an input variable used in determining a suitable
// step length for the forward-difference approximation. this
// approximation assumes that the relative errors in the
// functions are of the order of epsfcn. if epsfcn is less
// than the machine precision, it is assumed that the relative
// errors in the functions are of the order of the machine
// precision.
//
// Workspace, double WA[M].
//
{
int j;
//
// EPSMCH is the machine precision.
//
double epsmch = typeMethods.r8_epsilon();
double eps = Math.Sqrt(Math.Max(epsfcn, epsmch));
for (j = 0; j < n; j++)
{
double temp = x[j];
double h = temp switch
{
0.0 => eps,
_ => eps *Math.Abs(temp)
};
x[j] = temp + h;
fcnData r = fcn(m, n, x, wa, iflag);
iflag = r.iflag;
fvec = r.fvec;
if (iflag < 0)
{
break;
}
x[j] = temp;
int i;
for (i = 0; i < m; i++)
{
fjac[i + j * ldfjac] = (wa[i] - fvec[i]) / h;
}
}
}
}
private static void hybrd1_test()
//****************************************************************************80
//
// Purpose:
//
// HYBRD1_TEST tests HYBRD1.
//
// Discussion:
//
// This is an example of what your main program would look
// like if you wanted to use MINPACK to solve N nonlinear equations
// in N unknowns. In this version, we avoid computing the jacobian
// matrix, and request that MINPACK approximate it for us.
//
// The set of nonlinear equations is:
//
// x1 * x1 - 10 * x1 + x2 * x2 + 8 = 0
// x1 * x2 * x2 + x1 - 10 * x2 + 8 = 0
//
// with solution x1 = x2 = 1
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 08 April 2010
//
// Author:
//
// John Burkardt
//
{
const int n = 2;
const double tol = 0.00001;
const int lwa = n * (3 * n + 13) / 2;
double[] fvec = new double[n];
double[] wa = new double[lwa];
double[] x = new double[n];
Console.WriteLine("");
Console.WriteLine("HYBRD1_TEST");
Console.WriteLine(" HYBRD1 solves a nonlinear system of equations.");
x[0] = 3.0;
x[1] = 0.0;
typeMethods.r8vec_print(n, x, " Initial X");
const int iflag = 1;
fcnData res = hybrd1_f(n, x, fvec, iflag, 0, 0);
fvec = res.fvec;
typeMethods.r8vec_print(n, fvec, " F(X)");
int info = Minpack.hybrd1(hybrd1_f, n, x, fvec, tol, wa, lwa);
Console.WriteLine("");
Console.WriteLine(" Returned value of INFO = " + info + "");
typeMethods.r8vec_print(n, x, " X");
typeMethods.r8vec_print(n, fvec, " F(X)");
}
// Last two ints before fcnData are the array index baseline for each array
public static void fdjac1(Func <int, double[], double[], int, int, int, fcnData> fcn,
int n, double[] x, double[] fvec, double[] fjac, int ldfjac, ref int iflag,
int ml, int mu, double epsfcn, double[] wa1, double[] wa2, int fjacIndex = 0, int wa1Index = 0, int wa2Index = 0)
//****************************************************************************80
//
// Purpose:
//
// fdjac1() estimates an N by N Jacobian matrix using forward differences.
//
// Discussion:
//
// This function computes a forward-difference approximation
// to the N by N jacobian matrix associated with a specified
// problem of N functions in N variables.
//
// If the jacobian has a banded form, then function evaluations are saved
// by only approximating the nonzero terms.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 05 April 2010
//
// Author:
//
// Original FORTRAN77 version by Jorge More, Burt Garbow, Ken Hillstrom.
// C++ version by John Burkardt.
//
// Reference:
//
// Jorge More, Burton Garbow, Kenneth Hillstrom,
// User Guide for MINPACK-1,
// Technical Report ANL-80-74,
// Argonne National Laboratory, 1980.
//
// Parameters:
//
// fcn is the name of the user-supplied subroutine which
// calculates the functions. fcn must be declared
// in an external statement in the user calling
// program, and should be written as follows.
//
// subroutine fcn(n,x,fvec,iflag)
// integer n,iflag
// double precision x(n),fvec(n)
// ----------
// calculate the functions at x and
// return this vector in fvec.
// ----------
// return
// end
//
// the value of iflag should not be changed by fcn unless
// the user wants to terminate execution of fdjac1.
// in this case set iflag to a negative integer.
//
// Input, int N, the number of functions and variables.
//
// Input, double X[N], the evaluation point.
//
// Input, double FVEC[N], the functions evaluated at X.
//
// Output, double FJAC[N*N], the approximate jacobian matrix at X.
//
// ldfjac is a positive integer input variable not less than n
// which specifies the leading dimension of the array fjac.
//
// iflag is an integer variable which can be used to terminate
// the execution of fdjac1. see description of fcn.
//
// ml is a nonnegative integer input variable which specifies
// the number of subdiagonals within the band of the
// jacobian matrix. if the jacobian is not banded, set
// ml to at least n - 1.
//
// epsfcn is an input variable used in determining a suitable
// step length for the forward-difference approximation. this
// approximation assumes that the relative errors in the
// functions are of the order of epsfcn. if epsfcn is less
// than the machine precision, it is assumed that the relative
// errors in the functions are of the order of the machine
// precision.
//
// mu is a nonnegative integer input variable which specifies
// the number of superdiagonals within the band of the
// jacobian matrix. if the jacobian is not banded, set
// mu to at least n - 1.
//
// wa1 and wa2 are work arrays of length n. if ml + mu + 1 is at
// least n, then the jacobian is considered dense, and wa2 is
// not referenced.
{
double h = 0;
int i;
int j;
//
// EPSMCH is the machine precision.
//
double epsmch = typeMethods.r8_epsilon();
double eps = Math.Sqrt(Math.Max(epsfcn, epsmch));
int msum = ml + mu + 1;
//
// Computation of dense approximate jacobian.
//
if (n <= msum)
{
for (j = 0; j < n; j++)
{
double temp = x[j];
h = h switch
{
0.0 => eps,
_ => eps *Math.Abs(temp)
};
x[j] = temp + h;
fcnData r = fcn(n, x, wa1, iflag, 0, wa2Index);
iflag = r.iflag;
fvec = r.fvec;
if (iflag < 0)
{
break;
}
x[j] = temp;
for (i = 0; i < n; i++)
{
fjac[fjacIndex + i + j * ldfjac] = (wa1[wa1Index + i] - fvec[i]) / h;
}
}
}
//
// Computation of a banded approximate jacobian.
//
else
{
int k;
for (k = 0; k < msum; k++)
{
for (j = k; j < n; j += msum)
{
wa2[wa2Index + j] = x[j];
h = h switch
{
0.0 => eps,
_ => eps *Math.Abs(wa2[wa2Index + j])
};
x[j] = wa2[wa2Index + j] + h;
}
fcn(n, x, wa1, iflag, 0, wa1Index);
if (iflag < 0)
{
break;
}
for (j = k; j < n; j += msum)
{
x[j] = wa2[wa2Index + j];
h = h switch
{
0.0 => eps,
_ => eps *Math.Abs(wa2[wa2Index + j])
};
for (i = 0; i < n; i++)
{
if (j - mu <= i && i <= j + ml)
{
fjac[fjacIndex + i + j * ldfjac] = (wa1[wa1Index + i] - fvec[i]) / h;
}
else
{
fjac[fjacIndex + i + j * ldfjac] = 0.0;
}
}
}
}
}
}
