void lmmin(const int n, double* x, const int m, const void* data,
void (*evaluate)(const double* par, const int m_dat,
const void* data, double* fvec, int* userbreak),
const lm_control_struct* C, lm_status_struct* S)
{
int j, i;
double actred, dirder, fnorm, fnorm1, gnorm, pnorm, prered, ratio, step,
sum, temp, temp1, temp2, temp3;
/*** Initialize internal variables. ***/
int maxfev = C->patience * (n+1);
int inner_success; /* flag for loop control */
double lmpar = 0; /* Levenberg-Marquardt parameter */
double delta = 0;
double xnorm = 0;
double eps = sqrt(MAX(C->epsilon, LM_MACHEP)); /* for forward differences */
int nout = C->n_maxpri == -1 ? n : MIN(C->n_maxpri, n);
/* Reinterpret C->msgfile=NULL as stdout (which is unavailable for
compile-time initialization of lm_control_double and similar). */
FILE* msgfile = C->msgfile ? C->msgfile : stdout;
/*** Default status info; must be set before first return statement. ***/
S->outcome = 0; /* status code */
S->userbreak = 0;
S->nfev = 0; /* function evaluation counter */
/*** Check input parameters for errors. ***/
if (n <= 0) {
fprintf(stderr, "lmmin: invalid number of parameters %i\n", n);
S->outcome = 10;
return;
}
if (m < n) {
fprintf(stderr, "lmmin: number of data points (%i) "
"smaller than number of parameters (%i)\n",
m, n);
S->outcome = 10;
return;
}
if (C->ftol < 0 || C->xtol < 0 || C->gtol < 0) {
fprintf(stderr,
"lmmin: negative tolerance (at least one of %g %g %g)\n",
C->ftol, C->xtol, C->gtol);
S->outcome = 10;
return;
}
if (maxfev <= 0) {
fprintf(stderr, "lmmin: nonpositive function evaluations limit %i\n",
maxfev);
S->outcome = 10;
return;
}
if (C->stepbound <= 0) {
fprintf(stderr, "lmmin: nonpositive stepbound %g\n", C->stepbound);
S->outcome = 10;
return;
}
if (C->scale_diag != 0 && C->scale_diag != 1) {
fprintf(stderr, "lmmin: logical variable scale_diag=%i, "
"should be 0 or 1\n",
C->scale_diag);
S->outcome = 10;
return;
}
/*** Allocate work space. ***/
/* Allocate total workspace with just one system call */
char* ws;
if ((ws = (char *)malloc((2*m + 5*n + m*n) * sizeof(double) +
n * sizeof(int))) == NULL) {
S->outcome = 9;
return;
}
/* Assign workspace segments. */
char* pws = ws;
double* fvec = (double*)pws;
pws += m * sizeof(double) / sizeof(char);
double* diag = (double*)pws;
pws += n * sizeof(double) / sizeof(char);
double* qtf = (double*)pws;
pws += n * sizeof(double) / sizeof(char);
double* fjac = (double*)pws;
pws += n * m * sizeof(double) / sizeof(char);
double* wa1 = (double*)pws;
pws += n * sizeof(double) / sizeof(char);
double* wa2 = (double*)pws;
pws += n * sizeof(double) / sizeof(char);
double* wa3 = (double*)pws;
pws += n * sizeof(double) / sizeof(char);
double* wf = (double*)pws;
pws += m * sizeof(double) / sizeof(char);
int* Pivot = (int*)pws;
//pws += n * sizeof(int) / sizeof(char);
/* Initialize diag. */
if (!C->scale_diag)
for (j = 0; j < n; j++)
diag[j] = 1;
/*** Evaluate function at starting point and calculate norm. ***/
if (C->verbosity) {
fprintf(msgfile, "lmmin start ");
lm_print_pars(nout, x, msgfile);
}
(*evaluate)(x, m, data, fvec, &(S->userbreak));
if (C->verbosity > 4)
for (i = 0; i < m; ++i)
fprintf(msgfile, " fvec[%4i] = %18.8g\n", i, fvec[i]);
S->nfev = 1;
if (S->userbreak)
goto terminate;
fnorm = lm_enorm(m, fvec);
if (C->verbosity)
fprintf(msgfile, " fnorm = %18.8g\n", fnorm);
if (!isfinite(fnorm)) {
S->outcome = 12; /* nan */
goto terminate;
} else if (fnorm <= LM_DWARF) {
S->outcome = 0; /* sum of squares almost zero, nothing to do */
goto terminate;
}
/*** The outer loop: compute gradient, then descend. ***/
for (int outer = 0;; ++outer) {
/** Calculate the Jacobian. **/
for (j = 0; j < n; j++) {
temp = x[j];
step = MAX(eps * eps, eps * fabs(temp));
x[j] += step; /* replace temporarily */
(*evaluate)(x, m, data, wf, &(S->userbreak));
++(S->nfev);
if (S->userbreak)
goto terminate;
for (i = 0; i < m; i++)
fjac[j*m+i] = (wf[i] - fvec[i]) / step;
x[j] = temp; /* restore */
}
if (C->verbosity >= 10) {
/* print the entire matrix */
printf("\nlmmin Jacobian\n");
for (i = 0; i < m; i++) {
printf(" ");
for (j = 0; j < n; j++)
printf("%.5e ", fjac[j*m+i]);
printf("\n");
}
}
/** Compute the QR factorization of the Jacobian. **/
/* fjac is an m by n array. The upper n by n submatrix of fjac is made
* to contain an upper triangular matrix R with diagonal elements of
* nonincreasing magnitude such that
*
* P^T*(J^T*J)*P = R^T*R
*
* (NOTE: ^T stands for matrix transposition),
*
* where P is a permutation matrix and J is the final calculated
* Jacobian. Column j of P is column Pivot(j) of the identity matrix.
* The lower trapezoidal part of fjac contains information generated
* during the computation of R.
*
* Pivot is an integer array of length n. It defines a permutation
* matrix P such that jac*P = Q*R, where jac is the final calculated
* Jacobian, Q is orthogonal (not stored), and R is upper triangular
* with diagonal elements of nonincreasing magnitude. Column j of P
* is column Pivot(j) of the identity matrix.
*/
lm_qrfac(m, n, fjac, Pivot, wa1, wa2, wa3);
/* return values are Pivot, wa1=rdiag, wa2=acnorm */
/** Form Q^T * fvec, and store first n components in qtf. **/
for (i = 0; i < m; i++)
wf[i] = fvec[i];
for (j = 0; j < n; j++) {
temp3 = fjac[j*m+j];
if (temp3 != 0) {
sum = 0;
for (i = j; i < m; i++)
sum += fjac[j*m+i] * wf[i];
temp = -sum / temp3;
for (i = j; i < m; i++)
wf[i] += fjac[j*m+i] * temp;
}
fjac[j*m+j] = wa1[j];
qtf[j] = wf[j];
}
/** Compute norm of scaled gradient and detect degeneracy. **/
gnorm = 0;
for (j = 0; j < n; j++) {
if (wa2[Pivot[j]] == 0)
continue;
sum = 0;
for (i = 0; i <= j; i++)
sum += fjac[j*m+i] * qtf[i];
gnorm = MAX(gnorm, fabs(sum / wa2[Pivot[j]] / fnorm));
}
if (gnorm <= C->gtol) {
S->outcome = 4;
goto terminate;
}
/** Initialize or update diag and delta. **/
if (!outer) { /* first iteration only */
if (C->scale_diag) {
/* diag := norms of the columns of the initial Jacobian */
for (j = 0; j < n; j++)
diag[j] = wa2[j] ? wa2[j] : 1;
/* xnorm := || D x || */
for (j = 0; j < n; j++)
wa3[j] = diag[j] * x[j];
xnorm = lm_enorm(n, wa3);
if (C->verbosity >= 2) {
fprintf(msgfile, "lmmin diag ");
lm_print_pars(nout, x, msgfile); // xnorm
fprintf(msgfile, " xnorm = %18.8g\n", xnorm);
}
/* Only now print the header for the loop table. */
if (C->verbosity >= 3) {
fprintf(msgfile, " o i lmpar prered"
" ratio dirder delta"
" pnorm fnorm");
for (i = 0; i < nout; ++i)
fprintf(msgfile, " p%i", i);
fprintf(msgfile, "\n");
}
} else {
xnorm = lm_enorm(n, x);
}
if (!isfinite(xnorm)) {
S->outcome = 12; /* nan */
goto terminate;
}
/* Initialize the step bound delta. */
if (xnorm)
delta = C->stepbound * xnorm;
else
delta = C->stepbound;
} else {
if (C->scale_diag) {
for (j = 0; j < n; j++)
diag[j] = MAX(diag[j], wa2[j]);
}
}
/** The inner loop. **/
int inner = 0;
do {
/** Determine the Levenberg-Marquardt parameter. **/
lm_lmpar(n, fjac, m, Pivot, diag, qtf, delta, &lmpar,
wa1, wa2, wf, wa3);
/* used return values are fjac (partly), lmpar, wa1=x, wa3=diag*x */
/* Predict scaled reduction. */
pnorm = lm_enorm(n, wa3);
if (!isfinite(pnorm)) {
S->outcome = 12; /* nan */
goto terminate;
}
temp2 = lmpar * SQR(pnorm / fnorm);
for (j = 0; j < n; j++) {
wa3[j] = 0;
for (i = 0; i <= j; i++)
wa3[i] -= fjac[j*m+i] * wa1[Pivot[j]];
}
temp1 = SQR(lm_enorm(n, wa3) / fnorm);
if (!isfinite(temp1)) {
S->outcome = 12; /* nan */
goto terminate;
}
prered = temp1 + 2*temp2;
dirder = -temp1 + temp2; /* scaled directional derivative */
/* At first call, adjust the initial step bound. */
if (!outer && pnorm < delta)
delta = pnorm;
/** Evaluate the function at x + p. **/
for (j = 0; j < n; j++)
wa2[j] = x[j] - wa1[j];
(*evaluate)(wa2, m, data, wf, &(S->userbreak));
++(S->nfev);
if (S->userbreak)
goto terminate;
fnorm1 = lm_enorm(m, wf);
if (!isfinite(fnorm1)) {
S->outcome = 12; /* nan */
goto terminate;
}
/** Evaluate the scaled reduction. **/
/* Actual scaled reduction. */
actred = 1 - SQR(fnorm1 / fnorm);
/* Ratio of actual to predicted reduction. */
ratio = prered ? actred / prered : 0;
if (C->verbosity == 2) {
fprintf(msgfile, "lmmin (%i:%i) ", outer, inner);
lm_print_pars(nout, wa2, msgfile); // fnorm1,
} else if (C->verbosity >= 3) {
printf("%3i %2i %9.2g %9.2g %14.6g"
" %9.2g %10.3e %10.3e %21.15e",
outer, inner, lmpar, prered, ratio,
dirder, delta, pnorm, fnorm1);
for (i = 0; i < nout; ++i)
fprintf(msgfile, " %16.9g", wa2[i]);
fprintf(msgfile, "\n");
}
/* Update the step bound. */
if (ratio <= 0.25) {
if (actred >= 0)
temp = 0.5;
else if (actred > -99) /* -99 = 1-1/0.1^2 */
temp = MAX(dirder / (2*dirder + actred), 0.1);
else
temp = 0.1;
delta = temp * MIN(delta, pnorm / 0.1);
lmpar /= temp;
} else if (ratio >= 0.75) {
delta = 2 * pnorm;
lmpar *= 0.5;
} else if (!lmpar) {
delta = 2 * pnorm;
}
/** On success, update solution, and test for convergence. **/
inner_success = ratio >= 1e-4;
if (inner_success) {
/* Update x, fvec, and their norms. */
if (C->scale_diag) {
for (j = 0; j < n; j++) {
x[j] = wa2[j];
wa2[j] = diag[j] * x[j];
}
} else {
for (j = 0; j < n; j++)
x[j] = wa2[j];
}
for (i = 0; i < m; i++)
fvec[i] = wf[i];
xnorm = lm_enorm(n, wa2);
if (!isfinite(xnorm)) {
S->outcome = 12; /* nan */
goto terminate;
}
fnorm = fnorm1;
}
/* Convergence tests. */
S->outcome = 0;
if (fnorm <= LM_DWARF)
goto terminate; /* success: sum of squares almost zero */
/* Test two criteria (both may be fulfilled). */
if (fabs(actred) <= C->ftol && prered <= C->ftol && ratio <= 2)
S->outcome = 1; /* success: x almost stable */
if (delta <= C->xtol * xnorm)
S->outcome += 2; /* success: sum of squares almost stable */
if (S->outcome != 0) {
goto terminate;
}
/** Tests for termination and stringent tolerances. **/
if (S->nfev >= maxfev) {
S->outcome = 5;
goto terminate;
}
if (fabs(actred) <= LM_MACHEP && prered <= LM_MACHEP &&
ratio <= 2) {
S->outcome = 6;
goto terminate;
}
if (delta <= LM_MACHEP * xnorm) {
S->outcome = 7;
goto terminate;
}
if (gnorm <= LM_MACHEP) {
S->outcome = 8;
goto terminate;
}
/** End of the inner loop. Repeat if iteration unsuccessful. **/
++inner;
} while (!inner_success);
}; /*** End of the outer loop. ***/
terminate:
S->fnorm = lm_enorm(m, fvec);
if (C->verbosity >= 2)
printf("lmmin outcome (%i) xnorm %g ftol %g xtol %g\n", S->outcome,
xnorm, C->ftol, C->xtol);
if (C->verbosity & 1) {
fprintf(msgfile, "lmmin final ");
lm_print_pars(nout, x, msgfile); // S->fnorm,
fprintf(msgfile, " fnorm = %18.8g\n", S->fnorm);
}
if (S->userbreak) /* user-requested break */
S->outcome = 11;
/*** Deallocate the workspace. ***/
free(ws);
} /*** lmmin. ***/
void lmmin(
const int n, double *const x, const int m, const double* y,
const void *const data,
void (*const evaluate)(
const double *const par, const int m_dat, const void *const data,
double *const fvec, int *const userbreak),
const lm_control_struct *const C, lm_status_struct *const S)
{
int j, i;
double actred, dirder, fnorm, fnorm1, gnorm, pnorm,
prered, ratio, step, sum, temp, temp1, temp2, temp3;
static double p1 = 0.1, p0001 = 1.0e-4;
int maxfev = C->patience * (n+1);
int inner_success; /* flag for loop control */
double lmpar = 0; /* Levenberg-Marquardt parameter */
double delta = 0;
double xnorm = 0;
double eps = sqrt(MAX(C->epsilon, LM_MACHEP)); /* for forward differences */
int nout = C->n_maxpri==-1 ? n : MIN(C->n_maxpri, n);
/* The workaround msgfile=NULL is needed for default initialization */
FILE* msgfile = C->msgfile ? C->msgfile : stdout;
/* Default status info; must be set ahead of first return statements */
S->outcome = 0; /* status code */
S->userbreak = 0;
S->nfev = 0; /* function evaluation counter */
/*** Check input parameters for errors. ***/
if ( n < 0 ) {
fprintf(stderr, "lmmin: invalid number of parameters %i\n", n);
S->outcome = 10; /* invalid parameter */
return;
}
if (m < n) {
fprintf(stderr, "lmmin: number of data points (%i) "
"smaller than number of parameters (%i)\n", m, n);
S->outcome = 10;
return;
}
if (C->ftol < 0 || C->xtol < 0 || C->gtol < 0) {
fprintf(stderr,
"lmmin: negative tolerance (at least one of %g %g %g)\n",
C->ftol, C->xtol, C->gtol);
S->outcome = 10;
return;
}
if (maxfev <= 0) {
fprintf(stderr, "lmmin: nonpositive function evaluations limit %i\n",
maxfev);
S->outcome = 10;
return;
}
if (C->stepbound <= 0) {
fprintf(stderr, "lmmin: nonpositive stepbound %g\n", C->stepbound);
S->outcome = 10;
return;
}
if (C->scale_diag != 0 && C->scale_diag != 1) {
fprintf(stderr, "lmmin: logical variable scale_diag=%i, "
"should be 0 or 1\n", C->scale_diag);
S->outcome = 10;
return;
}
/*** Allocate work space. ***/
/* Allocate total workspace with just one system call */
char *ws;
if ( ( ws = static_cast<char *>(malloc(
(2*m+5*n+m*n)*sizeof(double) + n*sizeof(int)) ) ) == NULL ) {
S->outcome = 9;
return;
}
/* Assign workspace segments. */
char *pws = ws;
double *fvec = (double*) pws; pws += m * sizeof(double)/sizeof(char);
double *diag = (double*) pws; pws += n * sizeof(double)/sizeof(char);
double *qtf = (double*) pws; pws += n * sizeof(double)/sizeof(char);
double *fjac = (double*) pws; pws += n*m*sizeof(double)/sizeof(char);
double *wa1 = (double*) pws; pws += n * sizeof(double)/sizeof(char);
double *wa2 = (double*) pws; pws += n * sizeof(double)/sizeof(char);
double *wa3 = (double*) pws; pws += n * sizeof(double)/sizeof(char);
double *wf = (double*) pws; pws += m * sizeof(double)/sizeof(char);
int *ipvt = (int*) pws; /*pws += n * sizeof(int) /sizeof(char);*/
/* Initialize diag */ // TODO: check whether this is still needed
if (!C->scale_diag) {
for (j = 0; j < n; j++)
diag[j] = 1.;
}
/*** Evaluate function at starting point and calculate norm. ***/
if( C->verbosity&1 )
fprintf(msgfile, "lmmin start (ftol=%g gtol=%g xtol=%g)\n",
C->ftol, C->gtol, C->xtol);
if( C->verbosity&2 )
lm_print_pars(nout, x, msgfile);
(*evaluate)(x, m, data, fvec, &(S->userbreak));
if( C->verbosity&8 )
{
if (y) {
for( i=0; i<m; ++i )
fprintf(msgfile, " i, f, y-f: %4i %18.8g %18.8g\n",
i, fvec[i], y[i]-fvec[i]);
} else {
for( i=0; i<m; ++i )
fprintf(msgfile, " i, f: %4i %18.8g\n", i, fvec[i]);
}
}
S->nfev = 1;
if ( S->userbreak )
goto terminate;
if ( n == 0 ) {
S->outcome = 13; /* won't fit */
goto terminate;
}
fnorm = lm_fnorm(m, fvec, y);
if( C->verbosity&2 )
fprintf(msgfile, " fnorm = %24.16g\n", fnorm);
if( !isfinite(fnorm) ){
if( C->verbosity )
fprintf(msgfile, "nan case 1\n");
S->outcome = 12; /* nan */
goto terminate;
} else if( fnorm <= LM_DWARF ){
S->outcome = 0; /* sum of squares almost zero, nothing to do */
goto terminate;
}
/*** The outer loop: compute gradient, then descend. ***/
for( int outer=0; ; ++outer ) {
/*** [outer] Calculate the Jacobian. ***/
for (j = 0; j < n; j++) {
temp = x[j];
step = MAX(eps*eps, eps * fabs(temp));
x[j] += step; /* replace temporarily */
(*evaluate)(x, m, data, wf, &(S->userbreak));
++(S->nfev);
if ( S->userbreak )
goto terminate;
for (i = 0; i < m; i++)
fjac[j*m+i] = (wf[i] - fvec[i]) / step;
x[j] = temp; /* restore */
}
if ( C->verbosity&16 ) {
/* print the entire matrix */
printf("Jacobian\n");
for (i = 0; i < m; i++) {
printf(" ");
for (j = 0; j < n; j++)
printf("%.5e ", fjac[j*m+i]);
printf("\n");
}
}
/*** [outer] Compute the QR factorization of the Jacobian. ***/
/* fjac is an m by n array. The upper n by n submatrix of fjac
* is made to contain an upper triangular matrix R with diagonal
* elements of nonincreasing magnitude such that
*
* P^T*(J^T*J)*P = R^T*R
*
* (NOTE: ^T stands for matrix transposition),
*
* where P is a permutation matrix and J is the final calculated
* Jacobian. Column j of P is column ipvt(j) of the identity matrix.
* The lower trapezoidal part of fjac contains information generated
* during the computation of R.
*
* ipvt is an integer array of length n. It defines a permutation
* matrix P such that jac*P = Q*R, where jac is the final calculated
* Jacobian, Q is orthogonal (not stored), and R is upper triangular
* with diagonal elements of nonincreasing magnitude. Column j of P
* is column ipvt(j) of the identity matrix.
*/
lm_qrfac(m, n, fjac, ipvt, wa1, wa2, wa3);
/* return values are ipvt, wa1=rdiag, wa2=acnorm */
/*** [outer] Form Q^T * fvec, and store first n components in qtf. ***/
if (y)
for (i = 0; i < m; i++)
wf[i] = fvec[i] - y[i];
else
for (i = 0; i < m; i++)
wf[i] = fvec[i];
for (j = 0; j < n; j++) {
temp3 = fjac[j*m+j];
if (temp3 != 0) {
sum = 0;
for (i = j; i < m; i++)
sum += fjac[j*m+i] * wf[i];
temp = -sum / temp3;
for (i = j; i < m; i++)
wf[i] += fjac[j*m+i] * temp;
}
fjac[j*m+j] = wa1[j];
qtf[j] = wf[j];
}
/*** [outer] Compute norm of scaled gradient and detect degeneracy. ***/
gnorm = 0;
for (j = 0; j < n; j++) {
if (wa2[ipvt[j]] == 0)
continue;
sum = 0;
for (i = 0; i <= j; i++)
sum += fjac[j*m+i] * qtf[i];
gnorm = MAX(gnorm, fabs( sum / wa2[ipvt[j]] / fnorm ));
}
if (gnorm <= C->gtol) {
S->outcome = 4;
goto terminate;
}
/*** [outer] Initialize / update diag and delta. ***/
if ( !outer ) {
/* first iteration only */
if (C->scale_diag) {
/* diag := norms of the columns of the initial Jacobian */
for (j = 0; j < n; j++)
diag[j] = wa2[j] ? wa2[j] : 1;
/* xnorm := || D x || */
for (j = 0; j < n; j++)
wa3[j] = diag[j] * x[j];
xnorm = lm_enorm(n, wa3);
} else {
xnorm = lm_enorm(n, x);
}
if( !isfinite(xnorm) ){
if( C->verbosity )
fprintf(msgfile, "nan case 2\n");
S->outcome = 12; /* nan */
goto terminate;
}
/* initialize the step bound delta. */
if ( xnorm )
delta = C->stepbound * xnorm;
else
delta = C->stepbound;
/* only now print the header for the loop table */
if( C->verbosity&2 ) {
fprintf(msgfile, " #o #i lmpar prered actred"
" ratio dirder delta"
" pnorm fnorm");
for (i = 0; i < nout; ++i)
fprintf(msgfile, " p%i", i);
fprintf(msgfile, "\n");
}
} else {
if (C->scale_diag) {
for (j = 0; j < n; j++)
diag[j] = MAX( diag[j], wa2[j] );
}
}
/*** The inner loop. ***/
int inner = 0;
do {
/*** [inner] Determine the Levenberg-Marquardt parameter. ***/
lm_lmpar(n, fjac, m, ipvt, diag, qtf, delta, &lmpar,
wa1, wa2, wf, wa3);
/* used return values are fjac (partly), lmpar, wa1=x, wa3=diag*x */
/* predict scaled reduction */
pnorm = lm_enorm(n, wa3);
if( !isfinite(pnorm) ){
if( C->verbosity )
fprintf(msgfile, "nan case 3\n");
S->outcome = 12; /* nan */
goto terminate;
}
temp2 = lmpar * SQR( pnorm / fnorm );
for (j = 0; j < n; j++) {
wa3[j] = 0;
for (i = 0; i <= j; i++)
wa3[i] -= fjac[j*m+i] * wa1[ipvt[j]];
}
temp1 = SQR( lm_enorm(n, wa3) / fnorm );
if( !isfinite(temp1) ){
if( C->verbosity )
fprintf(msgfile, "nan case 4\n");
S->outcome = 12; /* nan */
goto terminate;
}
prered = temp1 + 2 * temp2;
dirder = -temp1 + temp2; /* scaled directional derivative */
/* at first call, adjust the initial step bound. */
if ( !outer && !inner && pnorm < delta )
delta = pnorm;
/*** [inner] Evaluate the function at x + p. ***/
for (j = 0; j < n; j++)
wa2[j] = x[j] - wa1[j];
(*evaluate)( wa2, m, data, wf, &(S->userbreak) );
++(S->nfev);
if ( S->userbreak )
goto terminate;
fnorm1 = lm_fnorm(m, wf, y);
// exceptionally, for this norm we do not test for infinity
// because we can deal with it without terminating.
/*** [inner] Evaluate the scaled reduction. ***/
/* actual scaled reduction (supports even the case fnorm1=infty) */
if (p1 * fnorm1 < fnorm)
actred = 1 - SQR(fnorm1 / fnorm);
else
actred = -1;
/* ratio of actual to predicted reduction */
ratio = prered ? actred/prered : 0;
if( C->verbosity&32 ) {
if (y) {
for( i=0; i<m; ++i )
fprintf(msgfile, " i, f, y-f: %4i %18.8g %18.8g\n",
i, fvec[i], y[i]-fvec[i]);
} else {
for( i=0; i<m; ++i )
fprintf(msgfile, " i, f, y-f: %4i %18.8g\n",
i, fvec[i]);
}
}
if( C->verbosity&2 ) {
printf("%3i %2i %9.2g %9.2g %9.2g %14.6g"
" %9.2g %10.3e %10.3e %21.15e",
outer, inner, lmpar, prered, actred, ratio,
dirder, delta, pnorm, fnorm1);
for (i = 0; i < nout; ++i)
fprintf(msgfile, " %16.9g", wa2[i]);
fprintf(msgfile, "\n");
}
/* update the step bound */
if (ratio <= 0.25) {
if (actred >= 0)
temp = 0.5;
else
temp = 0.5 * dirder / (dirder + 0.5 * actred);
if (p1 * fnorm1 >= fnorm || temp < p1)
temp = p1;
delta = temp * MIN(delta, pnorm / p1);
lmpar /= temp;
} else if (lmpar == 0 || ratio >= 0.75) {
delta = 2 * pnorm;
lmpar *= 0.5;
}
/*** [inner] On success, update solution, and test for convergence. ***/
inner_success = ratio >= p0001;
if ( inner_success ) {
/* update x, fvec, and their norms */
if (C->scale_diag) {
for (j = 0; j < n; j++) {
x[j] = wa2[j];
wa2[j] = diag[j] * x[j];
}
} else {
for (j = 0; j < n; j++)
x[j] = wa2[j];
}
for (i = 0; i < m; i++)
fvec[i] = wf[i];
xnorm = lm_enorm(n, wa2);
if( !isfinite(xnorm) ){
if( C->verbosity )
fprintf(msgfile, "nan case 6\n");
S->outcome = 12; /* nan */
goto terminate;
}
fnorm = fnorm1;
}
/* convergence tests */
S->outcome = 0;
if( fnorm<=LM_DWARF )
goto terminate; /* success: sum of squares almost zero */
/* test two criteria (both may be fulfilled) */
if (fabs(actred) <= C->ftol && prered <= C->ftol && ratio <= 2)
S->outcome = 1; /* success: x almost stable */
if (delta <= C->xtol * xnorm)
S->outcome += 2; /* success: sum of squares almost stable */
if (S->outcome != 0) {
goto terminate;
}
/*** [inner] Tests for termination and stringent tolerances. ***/
if ( S->nfev >= maxfev ){
S->outcome = 5;
goto terminate;
}
if ( fabs(actred) <= LM_MACHEP &&
prered <= LM_MACHEP && ratio <= 2 ){
S->outcome = 6;
goto terminate;
}
if ( delta <= LM_MACHEP*xnorm ){
S->outcome = 7;
goto terminate;
}
if ( gnorm <= LM_MACHEP ){
S->outcome = 8;
goto terminate;
}
/*** [inner] End of the loop. Repeat if iteration unsuccessful. ***/
++inner;
} while ( !inner_success );
/*** [outer] End of the loop. ***/
};
terminate:
S->fnorm = lm_fnorm(m, fvec, y);
if( C->verbosity&1 )
fprintf(msgfile, "lmmin terminates with outcome %i\n", S->outcome);
if( C->verbosity&2 )
lm_print_pars(nout, x, msgfile);
if( C->verbosity&8 ) {
if (y) {
for( i=0; i<m; ++i )
fprintf(msgfile, " i, f, y-f: %4i %18.8g %18.8g\n",
i, fvec[i], y[i]-fvec[i] );
} else {
for( i=0; i<m; ++i )
fprintf(msgfile, " i, f, y-f: %4i %18.8g\n", i, fvec[i]);
}
}
if( C->verbosity&2 )
fprintf(msgfile, " fnorm=%24.16g xnorm=%24.16g\n", S->fnorm, xnorm);
if ( S->userbreak ) /* user-requested break */
S->outcome = 11;
/*** Deallocate the workspace. ***/
free(ws);
} /*** lmmin. ***/
