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. ***/