xref: /petsc/src/tao/linesearch/impls/morethuente/morethuente.c (revision 87f595a510d358797c1cc8101e6f6c6930cb072f)
1 #include "petscvec.h"
2 #include "taosolver.h"
3 #include "tao-private/taolinesearch_impl.h"
4 #include "morethuente.h"
5 
6 /*
7    This algorithm is taken from More' and Thuente, "Line search algorithms
8    with guaranteed sufficient decrease", Argonne National Laboratory,
9    Technical Report MCS-P330-1092.
10 */
11 
12 static PetscErrorCode Tao_mcstep(TaoLineSearch ls,
13 				 PetscReal *stx, PetscReal *fx, PetscReal *dx,
14 				 PetscReal *sty, PetscReal *fy, PetscReal *dy,
15 				 PetscReal *stp, PetscReal *fp, PetscReal *dp);
16 
17 #undef __FUNCT__
18 #define __FUNCT__ "TaoLineSearchDestroy_MT"
19 static PetscErrorCode TaoLineSearchDestroy_MT(TaoLineSearch ls)
20 {
21   PetscErrorCode ierr;
22   TAOLINESEARCH_MT_CTX *mt;
23   PetscFunctionBegin;
24   PetscValidHeaderSpecific(ls,TAOLINESEARCH_CLASSID,1);
25   mt = (TAOLINESEARCH_MT_CTX*)(ls->data);
26   if (mt->x) {
27     ierr = PetscObjectDereference((PetscObject)mt->x); CHKERRQ(ierr);
28   }
29   if (mt->work) {
30     ierr = VecDestroy(&mt->work); CHKERRQ(ierr);
31   }
32   ierr = PetscFree(ls->data);
33   PetscFunctionReturn(0);
34 }
35 
36 #undef __FUNCT__
37 #define __FUNCT__ "TaoLineSearchSetFromOptions_MT"
38 static PetscErrorCode TaoLineSearchSetFromOptions_MT(TaoLineSearch ls)
39 {
40   PetscFunctionBegin;
41 
42   PetscValidHeaderSpecific(ls,TAOLINESEARCH_CLASSID,1);
43 
44   PetscFunctionReturn(0);
45 }
46 
47 
48 #undef __FUNCT__
49 #define __FUNCT__ "TaoLineSearchView_MT"
50 static PetscErrorCode TaoLineSearchView_MT(TaoLineSearch ls, PetscViewer pv)
51 {
52     PetscErrorCode ierr;
53     PetscBool isascii;
54     PetscFunctionBegin;
55     ierr = PetscObjectTypeCompare((PetscObject)pv, PETSCVIEWERASCII, &isascii); CHKERRQ(ierr);
56     if (isascii) {
57 	ierr = PetscViewerASCIIPrintf(pv,"  maxf=%D, ftol=%g, gtol=%g\n",ls->max_funcs,(double)ls->rtol,(double)ls->ftol); CHKERRQ(ierr);
58     } else {
59       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Viewer type %s not supported for MoreThuente TaoLineSearch",((PetscObject)pv)->type_name);
60     }
61     PetscFunctionReturn(0);
62 }
63 
64 #undef __FUNCT__
65 #define __FUNCT__ "TaoLineSearchApply_MT"
66 /* @ TaoApply_LineSearch - This routine takes step length of 1.0.
67 
68    Input Parameters:
69 +  tao - TaoSolver context
70 .  X - current iterate (on output X contains new iterate, X + step*S)
71 .  f - objective function evaluated at X
72 .  G - gradient evaluated at X
73 -  D - search direction
74 
75 
76    Info is set to 0.
77 
78 @ */
79 
80 static PetscErrorCode TaoLineSearchApply_MT(TaoLineSearch ls, Vec x, PetscReal *f, Vec g, Vec s)
81 {
82     PetscErrorCode ierr;
83     TAOLINESEARCH_MT_CTX *mt;
84 
85     PetscReal    xtrapf = 4.0;
86     PetscReal   finit, width, width1, dginit, fm, fxm, fym, dgm, dgxm, dgym;
87     PetscReal    dgx, dgy, dg, dg2, fx, fy, stx, sty, dgtest;
88     PetscReal ftest1=0.0, ftest2=0.0;
89     PetscInt  i, stage1,n1,n2,nn1,nn2;
90     PetscReal bstepmin1, bstepmin2, bstepmax;
91     PetscBool g_computed=PETSC_FALSE;; /* to prevent extra gradient computation */
92 
93     PetscFunctionBegin;
94     PetscValidHeaderSpecific(ls,TAOLINESEARCH_CLASSID,1);
95     PetscValidHeaderSpecific(x,VEC_CLASSID,2);
96     PetscValidScalarPointer(f,3);
97     PetscValidHeaderSpecific(g,VEC_CLASSID,4);
98     PetscValidHeaderSpecific(s,VEC_CLASSID,5);
99 
100     /* comm,type,size checks are done in interface TaoLineSearchApply */
101     mt = (TAOLINESEARCH_MT_CTX*)(ls->data);
102 
103     ls->reason = TAOLINESEARCH_CONTINUE_ITERATING;
104 
105     /* Check work vector */
106     if (!mt->work) {
107       ierr = VecDuplicate(x,&mt->work); CHKERRQ(ierr);
108       mt->x = x;
109       ierr = PetscObjectReference((PetscObject)mt->x); CHKERRQ(ierr);
110     }
111     /* If x has changed, then recreate work */
112     else if (x != mt->x) {
113       ierr = VecDestroy(&mt->work); CHKERRQ(ierr);
114       ierr = VecDuplicate(x,&mt->work); CHKERRQ(ierr);
115       ierr = PetscObjectDereference((PetscObject)mt->x); CHKERRQ(ierr);
116       mt->x = x;
117       ierr = PetscObjectReference((PetscObject)mt->x); CHKERRQ(ierr);
118     }
119 
120 
121     if (ls->bounded) {
122 	/* Compute step length needed to make all variables equal a bound */
123 	/* Compute the smallest steplength that will make one nonbinding variable
124 	   equal the bound */
125 	ierr = VecGetLocalSize(ls->upper,&n1); CHKERRQ(ierr);
126 	ierr = VecGetLocalSize(mt->x, &n2); CHKERRQ(ierr);
127 	ierr = VecGetSize(ls->upper,&nn1); CHKERRQ(ierr);
128 	ierr = VecGetSize(mt->x,&nn2); CHKERRQ(ierr);
129 	if (n1 != n2 || nn1 != nn2) {
130 	    SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Variable vector not compatible with bounds vector");
131 	}
132 	ierr = VecScale(s,-1.0); CHKERRQ(ierr);
133 	ierr = VecBoundGradientProjection(s,x,ls->lower,ls->upper,s); CHKERRQ(ierr);
134 	ierr = VecScale(s,-1.0); CHKERRQ(ierr);
135 	ierr = VecStepBoundInfo(x,ls->lower,ls->upper,s,&bstepmin1,&bstepmin2,&bstepmax);
136 	CHKERRQ(ierr);
137 	ls->stepmax = PetscMin(bstepmax,1.0e15);
138     }
139 
140     ierr = VecDot(g,s,&dginit);
141 
142     if (PetscIsInfOrNanReal(dginit)) {
143       ierr = PetscInfo1(ls,"Initial Line Search step * g is Inf or Nan (%g)\n",(double)dginit); CHKERRQ(ierr);
144       ls->reason=TAOLINESEARCH_FAILED_INFORNAN;
145       PetscFunctionReturn(0);
146     }
147     if (dginit >= 0.0) {
148       ierr = PetscInfo1(ls,"Initial Line Search step * g is not descent direction (%g)\n",(double)dginit); CHKERRQ(ierr);
149       ls->reason = TAOLINESEARCH_FAILED_ASCENT;
150       PetscFunctionReturn(0);
151     }
152 
153 
154     /* Initialization */
155     mt->bracket = 0;
156     stage1 = 1;
157     finit = *f;
158     dgtest = ls->ftol * dginit;
159     width = ls->stepmax - ls->stepmin;
160     width1 = width * 2.0;
161     ierr = VecCopy(x,mt->work);CHKERRQ(ierr);
162     /* Variable dictionary:
163      stx, fx, dgx - the step, function, and derivative at the best step
164      sty, fy, dgy - the step, function, and derivative at the other endpoint
165                    of the interval of uncertainty
166      step, f, dg - the step, function, and derivative at the current step */
167 
168     stx = 0.0;
169     fx  = finit;
170     dgx = dginit;
171     sty = 0.0;
172     fy  = finit;
173     dgy = dginit;
174 
175     ls->step=ls->initstep;
176     for (i=0; i< ls->max_funcs; i++) {
177     /* Set min and max steps to correspond to the interval of uncertainty */
178       if (mt->bracket) {
179 	ls->stepmin = PetscMin(stx,sty);
180 	ls->stepmax = PetscMax(stx,sty);
181       }
182       else {
183 	ls->stepmin = stx;
184 	ls->stepmax = ls->step + xtrapf * (ls->step - stx);
185       }
186 
187       /* Force the step to be within the bounds */
188       ls->step = PetscMax(ls->step,ls->stepmin);
189       ls->step = PetscMin(ls->step,ls->stepmax);
190 
191       /* If an unusual termination is to occur, then let step be the lowest
192 	 point obtained thus far */
193       if ((stx!=0) && (((mt->bracket) && (ls->step <= ls->stepmin || ls->step >= ls->stepmax)) ||
194         ((mt->bracket) && (ls->stepmax - ls->stepmin <= ls->rtol * ls->stepmax)) ||
195 		       ((ls->nfeval+ls->nfgeval) >= ls->max_funcs - 1) || (mt->infoc == 0))) {
196 	ls->step = stx;
197       }
198 
199       ierr = VecCopy(x,mt->work); CHKERRQ(ierr);
200       ierr = VecAXPY(mt->work,ls->step,s); CHKERRQ(ierr);   /* W = X + step*S */
201 
202       if (ls->bounded) {
203 	  ierr = VecMedian(ls->lower, mt->work, ls->upper, mt->work);CHKERRQ(ierr);
204       }
205       if (ls->usegts) {
206 	ierr = TaoLineSearchComputeObjectiveAndGTS(ls,mt->work,f,&dg); CHKERRQ(ierr);
207 	g_computed=PETSC_FALSE;
208       } else {
209 	ierr = TaoLineSearchComputeObjectiveAndGradient(ls,mt->work,f,g); CHKERRQ(ierr);
210 	g_computed=PETSC_TRUE;
211 	if (ls->bounded) {
212 	  ierr = VecDot(g,x,&dg); CHKERRQ(ierr);
213 	  ierr = VecDot(g,mt->work,&dg2); CHKERRQ(ierr);
214 	  dg = (dg2 - dg)/ls->step;
215 	} else {
216 	  ierr = VecDot(g,s,&dg); CHKERRQ(ierr);
217 	}
218       }
219 
220       if (0 == i) {
221 	ls->f_fullstep=*f;
222       }
223 
224 
225 
226       if (PetscIsInfOrNanReal(*f) || PetscIsInfOrNanReal(dg)) {
227 	/* User provided compute function generated Not-a-Number, assume
228 	 domain violation and set function value and directional
229 	 derivative to infinity. */
230 	*f = TAO_INFINITY;
231 	dg = TAO_INFINITY;
232       }
233 
234       ftest1 = finit + ls->step * dgtest;
235       if (ls->bounded) {
236 	  ftest2 = finit + ls->step * dgtest * ls->ftol;
237       }
238       /* Convergence testing */
239       if (((*f - ftest1 <= 1.0e-10 * PetscAbsReal(finit)) &&
240 	   (PetscAbsReal(dg) + ls->gtol*dginit <= 0.0))) {
241 	ierr = PetscInfo(ls, "Line search success: Sufficient decrease and directional deriv conditions hold\n"); CHKERRQ(ierr);
242 	ls->reason = TAOLINESEARCH_SUCCESS;
243 	break;
244       }
245 
246       /* Check Armijo if beyond the first breakpoint */
247       if (ls->bounded && (*f <= ftest2) && (ls->step >= bstepmin2)) {
248 	  ierr = PetscInfo(ls,"Line search success: Sufficient decrease.\n"); CHKERRQ(ierr);
249 	  break;
250       }
251 
252       /* Checks for bad cases */
253       if (((mt->bracket) && (ls->step <= ls->stepmin||ls->step >= ls->stepmax)) || (!mt->infoc)) {
254 	ierr = PetscInfo(ls,"Rounding errors may prevent further progress.  May not be a step satisfying\n"); CHKERRQ(ierr);
255 	ierr = PetscInfo(ls,"sufficient decrease and curvature conditions. Tolerances may be too small.\n"); CHKERRQ(ierr);
256 	ls->reason = TAOLINESEARCH_HALTED_OTHER;
257 	break;
258       }
259       if ((ls->step == ls->stepmax) && (*f <= ftest1) && (dg <= dgtest)) {
260 	ierr = PetscInfo1(ls,"Step is at the upper bound, stepmax (%g)\n",(double)ls->stepmax); CHKERRQ(ierr);
261 	ls->reason = TAOLINESEARCH_HALTED_UPPERBOUND;
262 	break;
263       }
264       if ((ls->step == ls->stepmin) && (*f >= ftest1) && (dg >= dgtest)) {
265 	ierr = PetscInfo1(ls,"Step is at the lower bound, stepmin (%g)\n",(double)ls->stepmin); CHKERRQ(ierr);
266 	ls->reason = TAOLINESEARCH_HALTED_LOWERBOUND;
267 	break;
268       }
269       if ((mt->bracket) && (ls->stepmax - ls->stepmin <= ls->rtol*ls->stepmax)){
270 	ierr = PetscInfo1(ls,"Relative width of interval of uncertainty is at most rtol (%g)\n",(double)ls->rtol); CHKERRQ(ierr);
271 	ls->reason = TAOLINESEARCH_HALTED_RTOL;
272 	break;
273       }
274 
275       /* In the first stage, we seek a step for which the modified function
276 	 has a nonpositive value and nonnegative derivative */
277       if ((stage1) && (*f <= ftest1) && (dg >= dginit * PetscMin(ls->ftol, ls->gtol))) {
278 	stage1 = 0;
279       }
280 
281       /* A modified function is used to predict the step only if we
282 	 have not obtained a step for which the modified function has a
283 	 nonpositive function value and nonnegative derivative, and if a
284 	 lower function value has been obtained but the decrease is not
285 	 sufficient */
286 
287       if ((stage1) && (*f <= fx) && (*f > ftest1)) {
288 	fm   = *f - ls->step * dgtest;	/* Define modified function */
289 	fxm  = fx - stx * dgtest;	        /* and derivatives */
290 	fym  = fy - sty * dgtest;
291 	dgm  = dg - dgtest;
292 	dgxm = dgx - dgtest;
293 	dgym = dgy - dgtest;
294 
295 	/* if (dgxm * (ls->step - stx) >= 0.0) */
296 	/* Update the interval of uncertainty and compute the new step */
297 	ierr = Tao_mcstep(ls,&stx,&fxm,&dgxm,&sty,&fym,&dgym,&ls->step,&fm,&dgm);CHKERRQ(ierr);
298 
299 	fx  = fxm + stx * dgtest;	/* Reset the function and */
300 	fy  = fym + sty * dgtest;	/* gradient values */
301 	dgx = dgxm + dgtest;
302 	dgy = dgym + dgtest;
303       }
304       else {
305 	/* Update the interval of uncertainty and compute the new step */
306 	ierr = Tao_mcstep(ls,&stx,&fx,&dgx,&sty,&fy,&dgy,&ls->step,f,&dg);CHKERRQ(ierr);
307       }
308 
309       /* Force a sufficient decrease in the interval of uncertainty */
310       if (mt->bracket) {
311 	if (PetscAbsReal(sty - stx) >= 0.66 * width1) ls->step = stx + 0.5*(sty - stx);
312 	width1 = width;
313 	width = PetscAbsReal(sty - stx);
314       }
315     }
316     if ((ls->nfeval+ls->nfgeval) > ls->max_funcs) {
317       ierr = PetscInfo2(ls,"Number of line search function evals (%D) > maximum (%D)\n",(ls->nfeval+ls->nfgeval),ls->max_funcs); CHKERRQ(ierr);
318       ls->reason = TAOLINESEARCH_HALTED_MAXFCN;
319     }
320 
321     /* Finish computations */
322     ierr = PetscInfo2(ls,"%D function evals in line search, step = %g\n",(ls->nfeval+ls->nfgeval),(double)ls->step); CHKERRQ(ierr);
323 
324     /* Set new solution vector and compute gradient if needed */
325     ierr = VecCopy(mt->work,x); CHKERRQ(ierr);
326     if (!g_computed) {
327       ierr = TaoLineSearchComputeGradient(ls,mt->work,g); CHKERRQ(ierr);
328     }
329 
330     PetscFunctionReturn(0);
331 }
332 
333 EXTERN_C_BEGIN
334 #undef __FUNCT__
335 #define __FUNCT__ "TaoLineSearchCreate_MT"
336 PetscErrorCode TaoLineSearchCreate_MT(TaoLineSearch ls)
337 {
338     PetscErrorCode ierr;
339     TAOLINESEARCH_MT_CTX *ctx;
340     PetscFunctionBegin;
341     PetscValidHeaderSpecific(ls,TAOLINESEARCH_CLASSID,1);
342     ierr = PetscNewLog(ls,&ctx); CHKERRQ(ierr);
343     ctx->bracket=0;
344     ctx->infoc=1;
345     ls->data = (void*)ctx;
346     ls->initstep = 1.0;
347     ls->ops->setup=0;
348     ls->ops->apply=TaoLineSearchApply_MT;
349     ls->ops->view =TaoLineSearchView_MT;
350     ls->ops->destroy=TaoLineSearchDestroy_MT;
351     ls->ops->setfromoptions=TaoLineSearchSetFromOptions_MT;
352 
353     PetscFunctionReturn(0);
354 }
355 EXTERN_C_END
356 
357 
358 
359 /*
360      The subroutine mcstep is taken from the work of Jorge Nocedal.
361      this is a variant of More' and Thuente's routine.
362 
363      subroutine mcstep
364 
365      the purpose of mcstep is to compute a safeguarded step for
366      a linesearch and to update an interval of uncertainty for
367      a minimizer of the function.
368 
369      the parameter stx contains the step with the least function
370      value. the parameter stp contains the current step. it is
371      assumed that the derivative at stx is negative in the
372      direction of the step. if bracket is set true then a
373      minimizer has been bracketed in an interval of uncertainty
374      with endpoints stx and sty.
375 
376      the subroutine statement is
377 
378      subroutine mcstep(stx,fx,dx,sty,fy,dy,stp,fp,dp,bracket,
379                        stpmin,stpmax,info)
380 
381      where
382 
383        stx, fx, and dx are variables which specify the step,
384          the function, and the derivative at the best step obtained
385          so far. The derivative must be negative in the direction
386          of the step, that is, dx and stp-stx must have opposite
387          signs. On output these parameters are updated appropriately.
388 
389        sty, fy, and dy are variables which specify the step,
390          the function, and the derivative at the other endpoint of
391          the interval of uncertainty. On output these parameters are
392          updated appropriately.
393 
394        stp, fp, and dp are variables which specify the step,
395          the function, and the derivative at the current step.
396          If bracket is set true then on input stp must be
397          between stx and sty. On output stp is set to the new step.
398 
399        bracket is a logical variable which specifies if a minimizer
400          has been bracketed.  If the minimizer has not been bracketed
401          then on input bracket must be set false.  If the minimizer
402          is bracketed then on output bracket is set true.
403 
404        stpmin and stpmax are input variables which specify lower
405          and upper bounds for the step.
406 
407        info is an integer output variable set as follows:
408          if info = 1,2,3,4,5, then the step has been computed
409          according to one of the five cases below. otherwise
410          info = 0, and this indicates improper input parameters.
411 
412      subprograms called
413 
414        fortran-supplied ... abs,max,min,sqrt
415 
416      argonne national laboratory. minpack project. june 1983
417      jorge j. more', david j. thuente
418 
419 */
420 
421 #undef __FUNCT__
422 #define __FUNCT__ "Tao_mcstep"
423 static PetscErrorCode Tao_mcstep(TaoLineSearch ls,
424                               PetscReal *stx, PetscReal *fx, PetscReal *dx,
425 		              PetscReal *sty, PetscReal *fy, PetscReal *dy,
426 			      PetscReal *stp, PetscReal *fp, PetscReal *dp)
427 {
428   TAOLINESEARCH_MT_CTX *mtP = (TAOLINESEARCH_MT_CTX *) ls->data;
429   PetscReal gamma1, p, q, r, s, sgnd, stpc, stpf, stpq, theta;
430   PetscInt bound;
431 
432   PetscFunctionBegin;
433 
434   /* Check the input parameters for errors */
435   mtP->infoc = 0;
436   if (mtP->bracket && (*stp <= PetscMin(*stx,*sty) || (*stp >= PetscMax(*stx,*sty)))) SETERRQ(PETSC_COMM_SELF,1,"bad stp in bracket");
437   if (*dx * (*stp-*stx) >= 0.0) SETERRQ(PETSC_COMM_SELF,1,"dx * (stp-stx) >= 0.0");
438   if (ls->stepmax < ls->stepmin) SETERRQ(PETSC_COMM_SELF,1,"stepmax > stepmin");
439 
440   /* Determine if the derivatives have opposite sign */
441   sgnd = *dp * (*dx / PetscAbsReal(*dx));
442 
443   if (*fp > *fx) {
444     /* Case 1: a higher function value.
445      The minimum is bracketed. If the cubic step is closer
446      to stx than the quadratic step, the cubic step is taken,
447      else the average of the cubic and quadratic steps is taken. */
448 
449     mtP->infoc = 1;
450     bound = 1;
451     theta = 3 * (*fx - *fp) / (*stp - *stx) + *dx + *dp;
452     s = PetscMax(PetscAbsReal(theta),PetscAbsReal(*dx));
453     s = PetscMax(s,PetscAbsReal(*dp));
454     gamma1 = s*PetscSqrtScalar(PetscPowScalar(theta/s,2.0) - (*dx/s)*(*dp/s));
455     if (*stp < *stx) gamma1 = -gamma1;
456     /* Can p be 0?  Check */
457     p = (gamma1 - *dx) + theta;
458     q = ((gamma1 - *dx) + gamma1) + *dp;
459     r = p/q;
460     stpc = *stx + r*(*stp - *stx);
461     stpq = *stx + ((*dx/((*fx-*fp)/(*stp-*stx)+*dx))*0.5) * (*stp - *stx);
462 
463     if (PetscAbsReal(stpc-*stx) < PetscAbsReal(stpq-*stx)) {
464       stpf = stpc;
465     }
466     else {
467       stpf = stpc + 0.5*(stpq - stpc);
468     }
469     mtP->bracket = 1;
470   }
471   else if (sgnd < 0.0) {
472     /* Case 2: A lower function value and derivatives of
473      opposite sign. The minimum is bracketed. If the cubic
474      step is closer to stx than the quadratic (secant) step,
475      the cubic step is taken, else the quadratic step is taken. */
476 
477     mtP->infoc = 2;
478     bound = 0;
479     theta = 3*(*fx - *fp)/(*stp - *stx) + *dx + *dp;
480     s = PetscMax(PetscAbsReal(theta),PetscAbsReal(*dx));
481     s = PetscMax(s,PetscAbsReal(*dp));
482     gamma1 = s*PetscSqrtScalar(PetscPowScalar(theta/s,2.0) - (*dx/s)*(*dp/s));
483     if (*stp > *stx) gamma1 = -gamma1;
484     p = (gamma1 - *dp) + theta;
485     q = ((gamma1 - *dp) + gamma1) + *dx;
486     r = p/q;
487     stpc = *stp + r*(*stx - *stp);
488     stpq = *stp + (*dp/(*dp-*dx))*(*stx - *stp);
489 
490     if (PetscAbsReal(stpc-*stp) > PetscAbsReal(stpq-*stp)) {
491       stpf = stpc;
492     }
493     else {
494       stpf = stpq;
495     }
496     mtP->bracket = 1;
497   }
498   else if (PetscAbsReal(*dp) < PetscAbsReal(*dx)) {
499     /* Case 3: A lower function value, derivatives of the
500      same sign, and the magnitude of the derivative decreases.
501      The cubic step is only used if the cubic tends to infinity
502      in the direction of the step or if the minimum of the cubic
503      is beyond stp. Otherwise the cubic step is defined to be
504      either stepmin or stepmax. The quadratic (secant) step is also
505      computed and if the minimum is bracketed then the the step
506      closest to stx is taken, else the step farthest away is taken. */
507 
508     mtP->infoc = 3;
509     bound = 1;
510     theta = 3*(*fx - *fp)/(*stp - *stx) + *dx + *dp;
511     s = PetscMax(PetscAbsReal(theta),PetscAbsReal(*dx));
512     s = PetscMax(s,PetscAbsReal(*dp));
513 
514     /* The case gamma1 = 0 only arises if the cubic does not tend
515        to infinity in the direction of the step. */
516     gamma1 = s*PetscSqrtScalar(PetscMax(0.0,PetscPowScalar(theta/s,2.0) - (*dx/s)*(*dp/s)));
517     if (*stp > *stx) gamma1 = -gamma1;
518     p = (gamma1 - *dp) + theta;
519     q = (gamma1 + (*dx - *dp)) + gamma1;
520     r = p/q;
521     if (r < 0.0 && gamma1 != 0.0) stpc = *stp + r*(*stx - *stp);
522     else if (*stp > *stx)        stpc = ls->stepmax;
523     else                         stpc = ls->stepmin;
524     stpq = *stp + (*dp/(*dp-*dx)) * (*stx - *stp);
525 
526     if (mtP->bracket) {
527       if (PetscAbsReal(*stp-stpc) < PetscAbsReal(*stp-stpq)) {
528 	stpf = stpc;
529       }
530       else {
531 	stpf = stpq;
532       }
533     }
534     else {
535       if (PetscAbsReal(*stp-stpc) > PetscAbsReal(*stp-stpq)) {
536 	stpf = stpc;
537       }
538       else {
539 	stpf = stpq;
540       }
541     }
542   }
543   else {
544     /* Case 4: A lower function value, derivatives of the
545        same sign, and the magnitude of the derivative does
546        not decrease. If the minimum is not bracketed, the step
547        is either stpmin or stpmax, else the cubic step is taken. */
548 
549     mtP->infoc = 4;
550     bound = 0;
551     if (mtP->bracket) {
552       theta = 3*(*fp - *fy)/(*sty - *stp) + *dy + *dp;
553       s = PetscMax(PetscAbsReal(theta),PetscAbsReal(*dy));
554       s = PetscMax(s,PetscAbsReal(*dp));
555       gamma1 = s*PetscSqrtScalar(PetscPowScalar(theta/s,2.0) - (*dy/s)*(*dp/s));
556       if (*stp > *sty) gamma1 = -gamma1;
557       p = (gamma1 - *dp) + theta;
558       q = ((gamma1 - *dp) + gamma1) + *dy;
559       r = p/q;
560       stpc = *stp + r*(*sty - *stp);
561       stpq = *stp + (*dp/(*dp-*dx)) * (*stx - *stp);
562 
563       stpf = stpc;
564     }
565     else if (*stp > *stx) {
566       stpf = ls->stepmax;
567     }
568     else {
569       stpf = ls->stepmin;
570     }
571   }
572 
573   /* Update the interval of uncertainty.  This update does not
574      depend on the new step or the case analysis above. */
575 
576   if (*fp > *fx) {
577     *sty = *stp;
578     *fy = *fp;
579     *dy = *dp;
580   }
581   else {
582     if (sgnd < 0.0) {
583       *sty = *stx;
584       *fy = *fx;
585       *dy = *dx;
586     }
587     *stx = *stp;
588     *fx = *fp;
589     *dx = *dp;
590   }
591 
592   /* Compute the new step and safeguard it. */
593   stpf = PetscMin(ls->stepmax,stpf);
594   stpf = PetscMax(ls->stepmin,stpf);
595   *stp = stpf;
596   if (mtP->bracket && bound) {
597     if (*sty > *stx) {
598       *stp = PetscMin(*stx+0.66*(*sty-*stx),*stp);
599     }
600     else {
601       *stp = PetscMax(*stx+0.66*(*sty-*stx),*stp);
602     }
603   }
604   PetscFunctionReturn(0);
605 }
606