// 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; } } } } } }