static int
gnewton_iterate (void * vstate, gsl_multiroot_function_fdf * fdf, gsl_vector * x, gsl_vector * f, gsl_matrix * J, gsl_vector * dx)
{
gnewton_state_t * state = (gnewton_state_t *) vstate;
int signum ;
double t, phi0, phi1;
size_t i;
size_t n = fdf->n ;
gsl_matrix_memcpy (state->lu, J);
gsl_linalg_LU_decomp (state->lu, state->permutation, &signum);
{
int status = gsl_linalg_LU_solve (state->lu, state->permutation, f, state->d);
if (status)
return status;
}
t = 1;
phi0 = state->phi;
new_step:
for (i = 0; i < n; i++)
{
double di = gsl_vector_get (state->d, i);
double xi = gsl_vector_get (x, i);
gsl_vector_set (state->x_trial, i, xi - t*di);
}
{
int status = GSL_MULTIROOT_FN_EVAL_F (fdf, state->x_trial, f);
if (status != GSL_SUCCESS)
{
return GSL_EBADFUNC;
}
}
phi1 = enorm (f);
if (phi1 > phi0 && t > GSL_DBL_EPSILON)
{
/* full step goes uphill, take a reduced step instead */
double theta = phi1 / phi0;
double u = (sqrt(1.0 + 6.0 * theta) - 1.0) / (3.0 * theta);
t *= u ;
goto new_step;
}
/* copy x_trial into x */
gsl_vector_memcpy (x, state->x_trial);
for (i = 0; i < n; i++)
{
double di = gsl_vector_get (state->d, i);
gsl_vector_set (dx, i, -t*di);
}
{
int status = GSL_MULTIROOT_FN_EVAL_DF (fdf, x, J);
if (status != GSL_SUCCESS)
{
return GSL_EBADFUNC;
}
}
state->phi = phi1;
return GSL_SUCCESS;
}
static int
iterate (void *vstate, gsl_multiroot_function_fdf * fdf, gsl_vector * x, gsl_vector * f, gsl_matrix * J, gsl_vector * dx, int scale)
{
hybridj_state_t *state = (hybridj_state_t *) vstate;
const double fnorm = state->fnorm;
gsl_matrix *q = state->q;
gsl_matrix *r = state->r;
gsl_vector *tau = state->tau;
gsl_vector *diag = state->diag;
gsl_vector *qtf = state->qtf;
gsl_vector *x_trial = state->x_trial;
gsl_vector *f_trial = state->f_trial;
gsl_vector *df = state->df;
gsl_vector *qtdf = state->qtdf;
gsl_vector *rdx = state->rdx;
gsl_vector *w = state->w;
gsl_vector *v = state->v;
double prered, actred;
double pnorm, fnorm1, fnorm1p;
double ratio;
double p1 = 0.1, p5 = 0.5, p001 = 0.001, p0001 = 0.0001;
/* Compute qtf = Q^T f */
compute_qtf (q, f, qtf);
/* Compute dogleg step */
dogleg (r, qtf, diag, state->delta, state->newton, state->gradient, dx);
/* Take a trial step */
compute_trial_step (x, dx, state->x_trial);
pnorm = scaled_enorm (diag, dx);
if (state->iter == 1)
{
if (pnorm < state->delta)
{
state->delta = pnorm;
}
}
/* Evaluate function at x + p */
{
int status = GSL_MULTIROOT_FN_EVAL_F (fdf, x_trial, f_trial);
if (status != GSL_SUCCESS)
{
return GSL_EBADFUNC;
}
}
/* Set df = f_trial - f */
compute_df (f_trial, f, df);
/* Compute the scaled actual reduction */
fnorm1 = enorm (f_trial);
actred = compute_actual_reduction (fnorm, fnorm1);
/* Compute rdx = R dx */
compute_rdx (r, dx, rdx);
/* Compute the scaled predicted reduction phi1p = |Q^T f + R dx| */
fnorm1p = enorm_sum (qtf, rdx);
prered = compute_predicted_reduction (fnorm, fnorm1p);
/* Compute the ratio of the actual to predicted reduction */
if (prered > 0)
{
ratio = actred / prered;
}
else
{
ratio = 0;
}
/* Update the step bound */
if (ratio < p1)
{
state->ncsuc = 0;
state->ncfail++;
state->delta *= p5;
}
else
{
state->ncfail = 0;
state->ncsuc++;
if (ratio >= p5 || state->ncsuc > 1)
state->delta = GSL_MAX (state->delta, pnorm / p5);
if (fabs (ratio - 1) <= p1)
state->delta = pnorm / p5;
}
/* Test for successful iteration */
if (ratio >= p0001)
{
gsl_vector_memcpy (x, x_trial);
gsl_vector_memcpy (f, f_trial);
state->fnorm = fnorm1;
state->iter++;
}
/* Determine the progress of the iteration */
state->nslow1++;
if (actred >= p001)
state->nslow1 = 0;
if (actred >= p1)
state->nslow2 = 0;
if (state->ncfail == 2)
{
{
int status = GSL_MULTIROOT_FN_EVAL_DF (fdf, x, J);
if (status != GSL_SUCCESS)
{
return GSL_EBADFUNC;
}
}
state->nslow2++;
if (state->iter == 1)
{
if (scale)
compute_diag (J, diag);
state->delta = compute_delta (diag, x);
}
else
{
if (scale)
update_diag (J, diag);
}
/* Factorize J into QR decomposition */
gsl_linalg_QR_decomp (J, tau);
gsl_linalg_QR_unpack (J, tau, q, r);
return GSL_SUCCESS;
}
/* Compute qtdf = Q^T df, w = (Q^T df - R dx)/|dx|, v = D^2 dx/|dx| */
compute_qtf (q, df, qtdf);
compute_wv (qtdf, rdx, dx, diag, pnorm, w, v);
/* Rank-1 update of the jacobian Q'R' = Q(R + w v^T) */
gsl_linalg_QR_update (q, r, w, v);
/* No progress as measured by jacobian evaluations */
if (state->nslow2 == 5)
{
return GSL_ENOPROGJ;
}
/* No progress as measured by function evaluations */
if (state->nslow1 == 10)
{
return GSL_ENOPROG;
}
return GSL_SUCCESS;
}
