Actual source code: search.c

  1: /*$Id: search.c,v 1.27 2001/03/23 23:24:18 balay 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,double *stx,double *fx,double *dx,
 67:     double *sty,double *fy,double *dy,double *stp,double *fp,double *dp)
 68: {
 69:   SNES_UM_LS *neP = (SNES_UM_LS*)snes->data;
 70:   double     gamma1,p,q,r,s,sgnd,stpc,stpf,stpq,theta;
 71:   double     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/PetscAbsDouble(*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(PetscAbsDouble(theta),PetscAbsDouble(*dx));
 95:     s = PetscMax(s,PetscAbsDouble(*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 (PetscAbsDouble(stpc-*stx) < PetscAbsDouble(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(PetscAbsDouble(theta),PetscAbsDouble(*dx));
121:     s = PetscMax(s,PetscAbsDouble(*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 (PetscAbsDouble(stpc-*stp) > PetscAbsDouble(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 (PetscAbsDouble(*dp) < PetscAbsDouble(*dx)) {
145:     neP->infoc = 3;
146:     bound = 1;
147:     theta = 3*(*fx - *fp)/(*stp - *stx) + *dx + *dp;
148:     s = PetscMax(PetscAbsDouble(theta),PetscAbsDouble(*dx));
149:     s = PetscMax(s,PetscAbsDouble(*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 (PetscAbsDouble(*stp-stpc) < PetscAbsDouble(*stp-stpq)) stpf = stpc;
164:       else                                                       stpf = stpq;
165:     }
166:     else {
167:       if (PetscAbsDouble(*stp-stpc) > PetscAbsDouble(*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(PetscAbsDouble(theta),PetscAbsDouble(*dy));
183:       s = PetscMax(s,PetscAbsDouble(*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: }