Actual source code: search.c
1: /*$Id: search.c,v 1.29 2001/08/07 21:31:11 bsmith Exp $*/
3: /*
4: The subroutine mcstep is taken from the work of Jorge Nocedal.
5: this is a variant of More' and Thuente's routine.
7: c subroutine mcstep
8: c
9: c the purpose of mcstep is to compute a safeguarded step for
10: c a linesearch and to update an interval of uncertainty for
11: c a minimizer of the function.
12: c
13: c the parameter stx contains the step with the least function
14: c value. the parameter stp contains the current step. it is
15: c assumed that the derivative at stx is negative in the
16: c direction of the step. if bracket is set true then a
17: c minimizer has been bracketed in an interval of uncertainty
18: c with endpoints stx and sty.
19: c
20: c the subroutine statement is
21: c
22: c subroutine mcstep(stx,fx,dx,sty,fy,dy,stp,fp,dp,bracket,
23: c stpmin,stpmax,info)
24: c
25: c where
26: c
27: c stx, fx, and dx are variables which specify the step,
28: c the function, and the derivative at the best step obtained
29: c so far. the derivative must be negative in the direction
30: c of the step, that is, dx and stp-stx must have opposite
31: c signs. on output these parameters are updated appropriately.
32: c
33: c sty, fy, and dy are variables which specify the step,
34: c the function, and the derivative at the other endpoint of
35: c the interval of uncertainty. on output these parameters are
36: c updated appropriately.
37: c
38: c stp, fp, and dp are variables which specify the step,
39: c the function, and the derivative at the current step.
40: c if bracket is set true then on input stp must be
41: c between stx and sty. on output stp is set to the new step.
42: c
43: c bracket is a logical variable which specifies if a minimizer
44: c has been bracketed. if the minimizer has not been bracketed
45: c then on input bracket must be set false. if the minimizer
46: c is bracketed then on output bracket is set true.
47: c
48: c stpmin and stpmax are input variables which specify lower
49: c and upper bounds for the step.
50: c
51: c info is an integer output variable set as follows:
52: c if info = 1,2,3,4,5, then the step has been computed
53: c according to one of the five cases below. otherwise
54: c info = 0, and this indicates improper input parameters.
55: c
56: c subprograms called
57: c
58: c fortran-supplied ... abs,max,min,sqrt
59: c
60: c argonne national laboratory. minpack project. june 1983
61: c jorge j. more', david j. thuente
62: nc
63: */
64: #include src/snes/impls/umls/umls.h
66: int SNESStep(SNES snes,PetscReal *stx,PetscReal *fx,PetscReal *dx,
67: PetscReal *sty,PetscReal *fy,PetscReal *dy,PetscReal *stp,PetscReal *fp,PetscReal *dp)
68: {
69: SNES_UM_LS *neP = (SNES_UM_LS*)snes->data;
70: PetscReal gamma1,p,q,r,s,sgnd,stpc,stpf,stpq,theta;
71: PetscReal two = 2.0,zero = 0.0;
72: int bound;
75: /* Check the input parameters for errors */
76: neP->infoc = 0;
77: if (neP->bracket && (*stp <= PetscMin(*stx,*sty) || (*stp >= PetscMax(*stx,*sty))))
78: SETERRQ(PETSC_ERR_PLIB,"bad stp in bracket");
79: if (*dx * (*stp-*stx) >= zero) SETERRQ(PETSC_ERR_PLIB,"dx * (stp-stx) >= 0");
80: if (neP->stepmax < neP->stepmin) SETERRQ(PETSC_ERR_PLIB,"stepmax > stepmin");
82: /* Determine if the derivatives have opposite sign */
83: sgnd = *dp * (*dx/PetscAbsReal(*dx));
85: /* Case 1: a higher function value.
86: the minimum is bracketed. if the cubic step is closer
87: to stx than the quadratic step, the cubic step is taken,
88: else the average of the cubic and quadratic steps is taken.
89: */
90: if (*fp > *fx) {
91: neP->infoc = 1;
92: bound = 1;
93: theta = 3 * (*fx - *fp) / (*stp - *stx) + *dx + *dp;
94: s = PetscMax(PetscAbsReal(theta),PetscAbsReal(*dx));
95: s = PetscMax(s,PetscAbsReal(*dp));
96: gamma1 = s*sqrt(pow(theta/s,two) - (*dx/s)*(*dp/s));
97: if (*stp < *stx) gamma1 = -gamma1;
98: p = (gamma1 - *dx) + theta;
99: q = ((gamma1 - *dx) + gamma1) + *dp;
100: r = p/q;
101: stpc = *stx + r*(*stp - *stx);
102: stpq = *stx + ((*dx/((*fx-*fp)/(*stp-*stx)+*dx))*0.5) * (*stp - *stx);
103: if (PetscAbsReal(stpc-*stx) < PetscAbsReal(stpq-*stx)) {
104: stpf = stpc;
105: } else {
106: stpf = stpc + 0.5*(stpq - stpc);
107: }
108: neP->bracket = 1;
109: }
110: /*
111: Case 2: A lower function value and derivatives of
112: opposite sign. the minimum is bracketed. if the cubic
113: step is closer to stx than the quadratic (secant) step,
114: the cubic step is taken, else the quadratic step is taken.
115: */
116: else if (sgnd < zero) {
117: neP->infoc = 2;
118: bound = 0;
119: theta = 3*(*fx - *fp)/(*stp - *stx) + *dx + *dp;
120: s = PetscMax(PetscAbsReal(theta),PetscAbsReal(*dx));
121: s = PetscMax(s,PetscAbsReal(*dp));
122: gamma1 = s*sqrt(pow(theta/s,two) - (*dx/s)*(*dp/s));
123: if (*stp > *stx) gamma1 = -gamma1;
124: p = (gamma1 - *dp) + theta;
125: q = ((gamma1 - *dp) + gamma1) + *dx;
126: r = p/q;
127: stpc = *stp + r*(*stx - *stp);
128: stpq = *stp + (*dp/(*dp-*dx))*(*stx - *stp);
129: if (PetscAbsReal(stpc-*stp) > PetscAbsReal(stpq-*stp)) stpf = stpc;
130: else stpf = stpq;
131: neP->bracket = 1;
132: }
134: /* Case 3: A lower function value, derivatives of the
135: same sign, and the magnitude of the derivative decreases.
136: the cubic step is only used if the cubic tends to infinity
137: in the direction of the step or if the minimum of the cubic
138: is beyond stp. otherwise the cubic step is defined to be
139: either stepmin or stepmax. the quadratic (secant) step is also
140: computed and if the minimum is bracketed then the the step
141: closest to stx is taken, else the step farthest away is taken.
142: */
144: else if (PetscAbsReal(*dp) < PetscAbsReal(*dx)) {
145: neP->infoc = 3;
146: bound = 1;
147: theta = 3*(*fx - *fp)/(*stp - *stx) + *dx + *dp;
148: s = PetscMax(PetscAbsReal(theta),PetscAbsReal(*dx));
149: s = PetscMax(s,PetscAbsReal(*dp));
151: /* The case gamma1 = 0 only arises if the cubic does not tend
152: to infinity in the direction of the step. */
153: gamma1 = s*sqrt(PetscMax(zero,pow(theta/s,two) - (*dx/s)*(*dp/s)));
154: if (*stp > *stx) gamma1 = -gamma1;
155: p = (gamma1 - *dp) + theta;
156: q = (gamma1 + (*dx - *dp)) + gamma1;
157: r = p/q;
158: if (r < zero && gamma1 != zero) stpc = *stp + r*(*stx - *stp);
159: else if (*stp > *stx) stpc = neP->stepmax;
160: else stpc = neP->stepmin;
161: stpq = *stp + (*dp/(*dp-*dx)) * (*stx - *stp);
162: if (neP->bracket) {
163: if (PetscAbsReal(*stp-stpc) < PetscAbsReal(*stp-stpq)) stpf = stpc;
164: else stpf = stpq;
165: }
166: else {
167: if (PetscAbsReal(*stp-stpc) > PetscAbsReal(*stp-stpq)) stpf = stpc;
168: else stpf = stpq;
169: }
170: }
172: /* Case 4: A lower function value, derivatives of the
173: same sign, and the magnitude of the derivative does
174: not decrease. if the minimum is not bracketed, the step
175: is either stpmin or stpmax, else the cubic step is taken.
176: */
177: else {
178: neP->infoc = 4;
179: bound = 0;
180: if (neP->bracket) {
181: theta = 3*(*fp - *fy)/(*sty - *stp) + *dy + *dp;
182: s = PetscMax(PetscAbsReal(theta),PetscAbsReal(*dy));
183: s = PetscMax(s,PetscAbsReal(*dp));
184: gamma1 = s*sqrt(pow(theta/s,two) - (*dy/s)*(*dp/s));
185: if (*stp > *sty) gamma1 = -gamma1;
186: p = (gamma1 - *dp) + theta;
187: q = ((gamma1 - *dp) + gamma1) + *dy;
188: r = p/q;
189: stpc = *stp + r*(*sty - *stp);
190: stpf = stpc;
191: } else if (*stp > *stx) {
192: stpf = neP->stepmax;
193: } else {
194: stpf = neP->stepmin;
195: }
196: }
198: /* Update the interval of uncertainty. This update does not
199: depend on the new step or the case analysis above. */
201: if (*fp > *fx) {
202: *sty = *stp;
203: *fy = *fp;
204: *dy = *dp;
205: } else {
206: if (sgnd < zero) {
207: *sty = *stx;
208: *fy = *fx;
209: *dy = *dx;
210: }
211: *stx = *stp;
212: *fx = *fp;
213: *dx = *dp;
214: }
216: /* Compute the new step and safeguard it */
217: stpf = PetscMin(neP->stepmax,stpf);
218: stpf = PetscMax(neP->stepmin,stpf);
219: *stp = stpf;
220: if (neP->bracket && bound) {
221: if (*sty > *stx) *stp = PetscMin(*stx+0.66*(*sty-*stx),*stp);
222: else *stp = PetscMax(*stx+0.66*(*sty-*stx),*stp);
223: }
224: return(0);
225: }