| [0b990d] | 1 | // These routines were translated from lbfgs.f by f2c (version 20030320)
 | 
|---|
 | 2 | // and modified by Curtis Janssen.
 | 
|---|
 | 3 | 
 | 
|---|
 | 4 | #ifdef __GNUC__
 | 
|---|
 | 5 | #pragma implementation
 | 
|---|
 | 6 | #endif
 | 
|---|
 | 7 | 
 | 
|---|
 | 8 | #include <math.h>
 | 
|---|
 | 9 | #include <util/class/scexception.h>
 | 
|---|
 | 10 | #include <math/optimize/mcsearch.h>
 | 
|---|
 | 11 | 
 | 
|---|
 | 12 | static inline double min(double a, double b)
 | 
|---|
 | 13 | {
 | 
|---|
 | 14 |   return (a<b)?a:b;
 | 
|---|
 | 15 | }
 | 
|---|
 | 16 | 
 | 
|---|
 | 17 | static inline double max(double a, double b)
 | 
|---|
 | 18 | {
 | 
|---|
 | 19 |   return (a<b)?b:a;
 | 
|---|
 | 20 | }
 | 
|---|
 | 21 | 
 | 
|---|
 | 22 | 
 | 
|---|
 | 23 | using namespace sc;
 | 
|---|
 | 24 | 
 | 
|---|
 | 25 | namespace sc {
 | 
|---|
 | 26 | 
 | 
|---|
 | 27 | static ClassDesc MCSearch_cd(
 | 
|---|
 | 28 |   typeid(MCSearch),"MCSearch",1,"public LineOpt",
 | 
|---|
 | 29 |   0, create<MCSearch>, 0);
 | 
|---|
 | 30 | 
 | 
|---|
 | 31 | MCSearch::MCSearch(const Ref<KeyVal>& keyval) 
 | 
|---|
 | 32 |   : LineOpt(keyval)
 | 
|---|
 | 33 | { 
 | 
|---|
 | 34 | }
 | 
|---|
 | 35 | 
 | 
|---|
 | 36 | MCSearch::~MCSearch()
 | 
|---|
 | 37 | {
 | 
|---|
 | 38 | }
 | 
|---|
 | 39 | 
 | 
|---|
 | 40 | void
 | 
|---|
 | 41 | MCSearch::mcinit()
 | 
|---|
 | 42 | {
 | 
|---|
 | 43 |   info_ = 0;
 | 
|---|
 | 44 | 
 | 
|---|
 | 45 |   // work area
 | 
|---|
 | 46 |   wa_.reset(new double[function()->dimension()->n()]);
 | 
|---|
 | 47 | }
 | 
|---|
 | 48 | 
 | 
|---|
 | 49 | void
 | 
|---|
 | 50 | MCSearch::init(RefSCVector& direction)
 | 
|---|
 | 51 | {
 | 
|---|
 | 52 |   LineOpt::init(direction);
 | 
|---|
 | 53 |   mcinit();
 | 
|---|
 | 54 | }
 | 
|---|
 | 55 | 
 | 
|---|
 | 56 | void
 | 
|---|
 | 57 | MCSearch::init(RefSCVector& direction, Ref<Function> function)
 | 
|---|
 | 58 | {
 | 
|---|
 | 59 |   LineOpt::init(direction, function);
 | 
|---|
 | 60 |   mcinit();
 | 
|---|
 | 61 | }
 | 
|---|
 | 62 | 
 | 
|---|
 | 63 | int
 | 
|---|
 | 64 | MCSearch::update()
 | 
|---|
 | 65 | {
 | 
|---|
 | 66 |   int n = function()->dimension()->n();
 | 
|---|
 | 67 | 
 | 
|---|
 | 68 |   // function coordinate
 | 
|---|
 | 69 |   auto_vec<double> x(new double[n]);
 | 
|---|
 | 70 |   function()->get_x()->convert(x.get());
 | 
|---|
 | 71 | 
 | 
|---|
 | 72 |   // gradient
 | 
|---|
 | 73 |   auto_vec<double> g(new double[n]);
 | 
|---|
 | 74 |   function()->gradient()->convert(g.get());
 | 
|---|
 | 75 | 
 | 
|---|
 | 76 |   // function value
 | 
|---|
 | 77 |   double f = function()->value();
 | 
|---|
 | 78 | 
 | 
|---|
 | 79 |   // step direction
 | 
|---|
 | 80 |   auto_vec<double> s(new double[n]);
 | 
|---|
 | 81 |   search_direction_->convert(s.get());
 | 
|---|
 | 82 | 
 | 
|---|
 | 83 |   // step size;
 | 
|---|
 | 84 |   double stp;
 | 
|---|
 | 85 |   stp = 1.0;
 | 
|---|
 | 86 | 
 | 
|---|
 | 87 |   // value tolerance
 | 
|---|
 | 88 |   double ftol;
 | 
|---|
 | 89 |   ftol = 1.0e-4;
 | 
|---|
 | 90 | 
 | 
|---|
 | 91 |   // the machine precision
 | 
|---|
 | 92 |   double xtol;
 | 
|---|
 | 93 |   xtol = DBL_EPSILON;
 | 
|---|
 | 94 | 
 | 
|---|
 | 95 |   // maximum number of function evaluations
 | 
|---|
 | 96 |   int maxfev = 20;
 | 
|---|
 | 97 | 
 | 
|---|
 | 98 |   // number of function evaluations
 | 
|---|
 | 99 |   int nfev = 0;
 | 
|---|
 | 100 | 
 | 
|---|
 | 101 |   // controls accuracy of line search routine
 | 
|---|
 | 102 |   gtol_ = 0.9;
 | 
|---|
 | 103 | 
 | 
|---|
 | 104 |   // minimum step size
 | 
|---|
 | 105 |   stpmin_ = DBL_EPSILON;
 | 
|---|
 | 106 | 
 | 
|---|
 | 107 |   // maximum step size
 | 
|---|
 | 108 |   stpmax_ = 1.0e20;
 | 
|---|
 | 109 | 
 | 
|---|
 | 110 |   mcsrch(&n, x.get(), &f,g.get(), s.get(), &stp, &ftol,
 | 
|---|
 | 111 |          &xtol, &maxfev, &info_, &nfev, wa_.get());
 | 
|---|
 | 112 | 
 | 
|---|
 | 113 | //         INFO = 0  IMPROPER INPUT PARAMETERS. 
 | 
|---|
 | 114 |   if (info_ == 0) {
 | 
|---|
 | 115 |       throw ProgrammingError("error in MCSearch: info == 0",
 | 
|---|
 | 116 |                              __FILE__,
 | 
|---|
 | 117 |                              __LINE__,
 | 
|---|
 | 118 |                              class_desc());
 | 
|---|
 | 119 |     }
 | 
|---|
 | 120 | 
 | 
|---|
 | 121 | //         INFO =-1  A RETURN IS MADE TO COMPUTE THE FUNCTION AND GRADIENT. 
 | 
|---|
 | 122 |   if (info_ == -1) {
 | 
|---|
 | 123 |       RefSCVector new_x = function()->get_x()->copy();
 | 
|---|
 | 124 |       new_x->assign(x.get());
 | 
|---|
 | 125 |       function()->set_x(new_x);
 | 
|---|
 | 126 |       return 0;
 | 
|---|
 | 127 |     }
 | 
|---|
 | 128 | 
 | 
|---|
 | 129 | //         INFO = 1  THE SUFFICIENT DECREASE CONDITION AND THE 
 | 
|---|
 | 130 | //                   DIRECTIONAL DERIVATIVE CONDITION HOLD. 
 | 
|---|
 | 131 |   if (info_ == 1) {
 | 
|---|
 | 132 |       return 1;
 | 
|---|
 | 133 |     }
 | 
|---|
 | 134 | 
 | 
|---|
 | 135 | //         INFO = 2  RELATIVE WIDTH OF THE INTERVAL OF UNCERTAINTY 
 | 
|---|
 | 136 | //                   IS AT MOST XTOL. 
 | 
|---|
 | 137 |   if (info_ == 2) {
 | 
|---|
 | 138 |       throw AlgorithmException("error in MCSearch: info == 2",
 | 
|---|
 | 139 |                              __FILE__,
 | 
|---|
 | 140 |                              __LINE__,
 | 
|---|
 | 141 |                              class_desc());
 | 
|---|
 | 142 |       return 1;
 | 
|---|
 | 143 |     }
 | 
|---|
 | 144 | 
 | 
|---|
 | 145 | //         INFO = 3  NUMBER OF CALLS TO FCN HAS REACHED MAXFEV. 
 | 
|---|
 | 146 |   if (info_ == 3) {
 | 
|---|
 | 147 |       throw ProgrammingError("error in MCSearch: info == 3",
 | 
|---|
 | 148 |                              __FILE__,
 | 
|---|
 | 149 |                              __LINE__,
 | 
|---|
 | 150 |                              class_desc());
 | 
|---|
 | 151 |       return 1;
 | 
|---|
 | 152 |     }
 | 
|---|
 | 153 | 
 | 
|---|
 | 154 | //         INFO = 4  THE STEP IS AT THE LOWER BOUND STPMIN. 
 | 
|---|
 | 155 |   if (info_ == 4) {
 | 
|---|
 | 156 |       throw AlgorithmException("error in MCSearch: info == 4",
 | 
|---|
 | 157 |                              __FILE__,
 | 
|---|
 | 158 |                              __LINE__,
 | 
|---|
 | 159 |                              class_desc());
 | 
|---|
 | 160 |       return 1;
 | 
|---|
 | 161 |     }
 | 
|---|
 | 162 | 
 | 
|---|
 | 163 | //         INFO = 5  THE STEP IS AT THE UPPER BOUND STPMAX. 
 | 
|---|
 | 164 |   if (info_ == 5) {
 | 
|---|
 | 165 |       throw AlgorithmException("error in MCSearch: info == 5",
 | 
|---|
 | 166 |                              __FILE__,
 | 
|---|
 | 167 |                              __LINE__,
 | 
|---|
 | 168 |                              class_desc());
 | 
|---|
 | 169 |       return 1;
 | 
|---|
 | 170 |     }
 | 
|---|
 | 171 | 
 | 
|---|
 | 172 | //         INFO = 6  ROUNDING ERRORS PREVENT FURTHER PROGRESS. 
 | 
|---|
 | 173 | //                   THERE MAY NOT BE A STEP WHICH SATISFIES THE 
 | 
|---|
 | 174 | //                   SUFFICIENT DECREASE AND CURVATURE CONDITIONS. 
 | 
|---|
 | 175 | //                   TOLERANCES MAY BE TOO SMALL. 
 | 
|---|
 | 176 |   if (info_ == 6) {
 | 
|---|
 | 177 |       throw AlgorithmException("error in MCSearch: info == 6",
 | 
|---|
 | 178 |                              __FILE__,
 | 
|---|
 | 179 |                              __LINE__,
 | 
|---|
 | 180 |                              class_desc());
 | 
|---|
 | 181 |       return 1;
 | 
|---|
 | 182 |     }
 | 
|---|
 | 183 | 
 | 
|---|
 | 184 |   throw ProgrammingError("error in MCSearch: unknown info",
 | 
|---|
 | 185 |                          __FILE__,
 | 
|---|
 | 186 |                          __LINE__,
 | 
|---|
 | 187 |                          class_desc());
 | 
|---|
 | 188 | 
 | 
|---|
 | 189 |   return 0;
 | 
|---|
 | 190 | }
 | 
|---|
 | 191 | 
 | 
|---|
 | 192 | //     **************************
 | 
|---|
 | 193 | //     LINE SEARCH ROUTINE MCSRCH
 | 
|---|
 | 194 | //     **************************
 | 
|---|
 | 195 | 
 | 
|---|
 | 196 | void
 | 
|---|
 | 197 | MCSearch::mcsrch(int *n, double *x, double *f, 
 | 
|---|
 | 198 |         double *g, double *s, double *stp, double *ftol, 
 | 
|---|
 | 199 |         double *xtol, int *maxfev, int *info, int *nfev, 
 | 
|---|
 | 200 |         double *wa)
 | 
|---|
 | 201 | {
 | 
|---|
 | 202 |     // Initialized data 
 | 
|---|
 | 203 | 
 | 
|---|
 | 204 |     const double p5 = .5;
 | 
|---|
 | 205 |     const double p66 = .66;
 | 
|---|
 | 206 |     const double xtrapf = 4.;
 | 
|---|
 | 207 |     const double zero = 0.;
 | 
|---|
 | 208 | 
 | 
|---|
 | 209 |     // System generated locals 
 | 
|---|
 | 210 |     int i__1;
 | 
|---|
 | 211 |     double d__1;
 | 
|---|
 | 212 | 
 | 
|---|
 | 213 | //                     SUBROUTINE MCSRCH 
 | 
|---|
 | 214 | 
 | 
|---|
 | 215 | //     A slight modification of the subroutine CSRCH of More' and Thuente. 
 | 
|---|
 | 216 | //     The changes are to allow reverse communication, and do not affect 
 | 
|---|
 | 217 | //     the performance of the routine. 
 | 
|---|
 | 218 | 
 | 
|---|
 | 219 | //     THE PURPOSE OF MCSRCH IS TO FIND A STEP WHICH SATISFIES 
 | 
|---|
 | 220 | //     A SUFFICIENT DECREASE CONDITION AND A CURVATURE CONDITION. 
 | 
|---|
 | 221 | 
 | 
|---|
 | 222 | //     AT EACH STAGE THE SUBROUTINE UPDATES AN INTERVAL OF 
 | 
|---|
 | 223 | //     UNCERTAINTY WITH ENDPOINTS STX AND STY. THE INTERVAL OF 
 | 
|---|
 | 224 | //     UNCERTAINTY IS INITIALLY CHOSEN SO THAT IT CONTAINS A 
 | 
|---|
 | 225 | //     MINIMIZER OF THE MODIFIED FUNCTION 
 | 
|---|
 | 226 | 
 | 
|---|
 | 227 | //          F(X+STP*S) - F(X) - FTOL*STP*(GRADF(X)'S). 
 | 
|---|
 | 228 | 
 | 
|---|
 | 229 | //     IF A STEP IS OBTAINED FOR WHICH THE MODIFIED FUNCTION 
 | 
|---|
 | 230 | //     HAS A NONPOSITIVE FUNCTION VALUE AND NONNEGATIVE DERIVATIVE, 
 | 
|---|
 | 231 | //     THEN THE INTERVAL OF UNCERTAINTY IS CHOSEN SO THAT IT 
 | 
|---|
 | 232 | //     CONTAINS A MINIMIZER OF F(X+STP*S). 
 | 
|---|
 | 233 | 
 | 
|---|
 | 234 | //     THE ALGORITHM IS DESIGNED TO FIND A STEP WHICH SATISFIES 
 | 
|---|
 | 235 | //     THE SUFFICIENT DECREASE CONDITION 
 | 
|---|
 | 236 | 
 | 
|---|
 | 237 | //           F(X+STP*S) .LE. F(X) + FTOL*STP*(GRADF(X)'S), 
 | 
|---|
 | 238 | 
 | 
|---|
 | 239 | //     AND THE CURVATURE CONDITION 
 | 
|---|
 | 240 | 
 | 
|---|
 | 241 | //           ABS(GRADF(X+STP*S)'S)) .LE. GTOL*ABS(GRADF(X)'S). 
 | 
|---|
 | 242 | 
 | 
|---|
 | 243 | //     IF FTOL IS LESS THAN GTOL AND IF, FOR EXAMPLE, THE FUNCTION 
 | 
|---|
 | 244 | //     IS BOUNDED BELOW, THEN THERE IS ALWAYS A STEP WHICH SATISFIES 
 | 
|---|
 | 245 | //     BOTH CONDITIONS. IF NO STEP CAN BE FOUND WHICH SATISFIES BOTH 
 | 
|---|
 | 246 | //     CONDITIONS, THEN THE ALGORITHM USUALLY STOPS WHEN ROUNDING 
 | 
|---|
 | 247 | //     ERRORS PREVENT FURTHER PROGRESS. IN THIS CASE STP ONLY 
 | 
|---|
 | 248 | //     SATISFIES THE SUFFICIENT DECREASE CONDITION. 
 | 
|---|
 | 249 | 
 | 
|---|
 | 250 | //     THE SUBROUTINE STATEMENT IS 
 | 
|---|
 | 251 | 
 | 
|---|
 | 252 | //        SUBROUTINE MCSRCH(N,X,F,G,S,STP,FTOL,XTOL, MAXFEV,INFO,NFEV,WA) 
 | 
|---|
 | 253 | //     WHERE 
 | 
|---|
 | 254 | 
 | 
|---|
 | 255 | //       N IS A POSITIVE INTEGER INPUT VARIABLE SET TO THE NUMBER 
 | 
|---|
 | 256 | //         OF VARIABLES. 
 | 
|---|
 | 257 | 
 | 
|---|
 | 258 | //       X IS AN ARRAY OF LENGTH N. ON INPUT IT MUST CONTAIN THE 
 | 
|---|
 | 259 | //         BASE POINT FOR THE LINE SEARCH. ON OUTPUT IT CONTAINS 
 | 
|---|
 | 260 | //         X + STP*S. 
 | 
|---|
 | 261 | 
 | 
|---|
 | 262 | //       F IS A VARIABLE. ON INPUT IT MUST CONTAIN THE VALUE OF F 
 | 
|---|
 | 263 | //         AT X. ON OUTPUT IT CONTAINS THE VALUE OF F AT X + STP*S. 
 | 
|---|
 | 264 | 
 | 
|---|
 | 265 | //       G IS AN ARRAY OF LENGTH N. ON INPUT IT MUST CONTAIN THE 
 | 
|---|
 | 266 | //         GRADIENT OF F AT X. ON OUTPUT IT CONTAINS THE GRADIENT 
 | 
|---|
 | 267 | //         OF F AT X + STP*S. 
 | 
|---|
 | 268 | 
 | 
|---|
 | 269 | //       S IS AN INPUT ARRAY OF LENGTH N WHICH SPECIFIES THE 
 | 
|---|
 | 270 | //         SEARCH DIRECTION. 
 | 
|---|
 | 271 | 
 | 
|---|
 | 272 | //       STP IS A NONNEGATIVE VARIABLE. ON INPUT STP CONTAINS AN 
 | 
|---|
 | 273 | //         INITIAL ESTIMATE OF A SATISFACTORY STEP. ON OUTPUT 
 | 
|---|
 | 274 | //         STP CONTAINS THE FINAL ESTIMATE. 
 | 
|---|
 | 275 | 
 | 
|---|
 | 276 | //       FTOL AND GTOL ARE NONNEGATIVE INPUT VARIABLES. (In this reverse 
 | 
|---|
 | 277 | //         communication implementation GTOL is defined in a COMMON 
 | 
|---|
 | 278 | //         statement.) TERMINATION OCCURS WHEN THE SUFFICIENT DECREASE 
 | 
|---|
 | 279 | //         CONDITION AND THE DIRECTIONAL DERIVATIVE CONDITION ARE 
 | 
|---|
 | 280 | //         SATISFIED. 
 | 
|---|
 | 281 | 
 | 
|---|
 | 282 | //       XTOL IS A NONNEGATIVE INPUT VARIABLE. TERMINATION OCCURS 
 | 
|---|
 | 283 | //         WHEN THE RELATIVE WIDTH OF THE INTERVAL OF UNCERTAINTY 
 | 
|---|
 | 284 | //         IS AT MOST XTOL. 
 | 
|---|
 | 285 | 
 | 
|---|
 | 286 | //       STPMIN AND STPMAX ARE NONNEGATIVE INPUT VARIABLES WHICH 
 | 
|---|
 | 287 | //         SPECIFY LOWER AND UPPER BOUNDS FOR THE STEP. (In this reverse 
 | 
|---|
 | 288 | //         communication implementatin they are defined in a COMMON 
 | 
|---|
 | 289 | //         statement). 
 | 
|---|
 | 290 | 
 | 
|---|
 | 291 | //       MAXFEV IS A POSITIVE INTEGER INPUT VARIABLE. TERMINATION 
 | 
|---|
 | 292 | //         OCCURS WHEN THE NUMBER OF CALLS TO FCN IS AT LEAST 
 | 
|---|
 | 293 | //         MAXFEV BY THE END OF AN ITERATION. 
 | 
|---|
 | 294 | 
 | 
|---|
 | 295 | //       INFO IS AN INTEGER OUTPUT VARIABLE SET AS FOLLOWS: 
 | 
|---|
 | 296 | 
 | 
|---|
 | 297 | //         INFO = 0  IMPROPER INPUT PARAMETERS. 
 | 
|---|
 | 298 | 
 | 
|---|
 | 299 | //         INFO =-1  A RETURN IS MADE TO COMPUTE THE FUNCTION AND GRADIENT. 
 | 
|---|
 | 300 | 
 | 
|---|
 | 301 | //         INFO = 1  THE SUFFICIENT DECREASE CONDITION AND THE 
 | 
|---|
 | 302 | //                   DIRECTIONAL DERIVATIVE CONDITION HOLD. 
 | 
|---|
 | 303 | 
 | 
|---|
 | 304 | //         INFO = 2  RELATIVE WIDTH OF THE INTERVAL OF UNCERTAINTY 
 | 
|---|
 | 305 | //                   IS AT MOST XTOL. 
 | 
|---|
 | 306 | 
 | 
|---|
 | 307 | //         INFO = 3  NUMBER OF CALLS TO FCN HAS REACHED MAXFEV. 
 | 
|---|
 | 308 | 
 | 
|---|
 | 309 | //         INFO = 4  THE STEP IS AT THE LOWER BOUND STPMIN. 
 | 
|---|
 | 310 | 
 | 
|---|
 | 311 | //         INFO = 5  THE STEP IS AT THE UPPER BOUND STPMAX. 
 | 
|---|
 | 312 | 
 | 
|---|
 | 313 | //         INFO = 6  ROUNDING ERRORS PREVENT FURTHER PROGRESS. 
 | 
|---|
 | 314 | //                   THERE MAY NOT BE A STEP WHICH SATISFIES THE 
 | 
|---|
 | 315 | //                   SUFFICIENT DECREASE AND CURVATURE CONDITIONS. 
 | 
|---|
 | 316 | //                   TOLERANCES MAY BE TOO SMALL. 
 | 
|---|
 | 317 | 
 | 
|---|
 | 318 | //       NFEV IS AN INTEGER OUTPUT VARIABLE SET TO THE NUMBER OF 
 | 
|---|
 | 319 | //         CALLS TO FCN. 
 | 
|---|
 | 320 | 
 | 
|---|
 | 321 | //       WA IS A WORK ARRAY OF LENGTH N. 
 | 
|---|
 | 322 | 
 | 
|---|
 | 323 | //     SUBPROGRAMS CALLED 
 | 
|---|
 | 324 | 
 | 
|---|
 | 325 | //       MCSTEP 
 | 
|---|
 | 326 | 
 | 
|---|
 | 327 | //       FORTRAN-SUPPLIED...ABS,MAX,MIN 
 | 
|---|
 | 328 | 
 | 
|---|
 | 329 | //     ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. JUNE 1983 
 | 
|---|
 | 330 | //     JORGE J. MORE', DAVID J. THUENTE 
 | 
|---|
 | 331 | 
 | 
|---|
 | 332 | //     ********** 
 | 
|---|
 | 333 |     // Parameter adjustments 
 | 
|---|
 | 334 |     --wa;
 | 
|---|
 | 335 |     --s;
 | 
|---|
 | 336 |     --g;
 | 
|---|
 | 337 |     --x;
 | 
|---|
 | 338 | 
 | 
|---|
 | 339 |     // Function Body 
 | 
|---|
 | 340 |     if (*info == -1) {
 | 
|---|
 | 341 |         goto L45;
 | 
|---|
 | 342 |     }
 | 
|---|
 | 343 |     infoc = 1;
 | 
|---|
 | 344 | 
 | 
|---|
 | 345 | //     CHECK THE INPUT PARAMETERS FOR ERRORS. 
 | 
|---|
 | 346 | 
 | 
|---|
 | 347 |     if (*n <= 0 || *stp <= zero || *ftol < zero || gtol_ < zero || *xtol 
 | 
|---|
 | 348 |             < zero || stpmin_ < zero || stpmax_ < stpmin_ || *
 | 
|---|
 | 349 |             maxfev <= 0) {
 | 
|---|
 | 350 |         return;
 | 
|---|
 | 351 |     }
 | 
|---|
 | 352 | 
 | 
|---|
 | 353 | //     COMPUTE THE INITIAL GRADIENT IN THE SEARCH DIRECTION 
 | 
|---|
 | 354 | //     AND CHECK THAT S IS A DESCENT DIRECTION. 
 | 
|---|
 | 355 | 
 | 
|---|
 | 356 |     dginit = zero;
 | 
|---|
 | 357 |     i__1 = *n;
 | 
|---|
 | 358 |     for (int j = 1; j <= i__1; ++j) {
 | 
|---|
 | 359 |         dginit += g[j] * s[j];
 | 
|---|
 | 360 | // L10: 
 | 
|---|
 | 361 |     }
 | 
|---|
 | 362 |     if (dginit >= zero) {
 | 
|---|
 | 363 |         ExEnv::out0() << indent
 | 
|---|
 | 364 |                       << "MCSearch: "
 | 
|---|
 | 365 |                       << "The search direction is not a descent direction"
 | 
|---|
 | 366 |                       << std::endl;
 | 
|---|
 | 367 |         return;
 | 
|---|
 | 368 |     }
 | 
|---|
 | 369 | 
 | 
|---|
 | 370 | //     INITIALIZE LOCAL VARIABLES. 
 | 
|---|
 | 371 | 
 | 
|---|
 | 372 |     brackt = false;
 | 
|---|
 | 373 |     stage1 = true;
 | 
|---|
 | 374 |     *nfev = 0;
 | 
|---|
 | 375 |     finit = *f;
 | 
|---|
 | 376 |     dgtest = *ftol * dginit;
 | 
|---|
 | 377 |     width = stpmax_ - stpmin_;
 | 
|---|
 | 378 |     width1 = width / p5;
 | 
|---|
 | 379 |     i__1 = *n;
 | 
|---|
 | 380 |     for (int j = 1; j <= i__1; ++j) {
 | 
|---|
 | 381 |         wa[j] = x[j];
 | 
|---|
 | 382 | // L20: 
 | 
|---|
 | 383 |     }
 | 
|---|
 | 384 | 
 | 
|---|
 | 385 | //     THE VARIABLES STX, FX, DGX CONTAIN THE VALUES OF THE STEP, 
 | 
|---|
 | 386 | //     FUNCTION, AND DIRECTIONAL DERIVATIVE AT THE BEST STEP. 
 | 
|---|
 | 387 | //     THE VARIABLES STY, FY, DGY CONTAIN THE VALUE OF THE STEP, 
 | 
|---|
 | 388 | //     FUNCTION, AND DERIVATIVE AT THE OTHER ENDPOINT OF 
 | 
|---|
 | 389 | //     THE INTERVAL OF UNCERTAINTY. 
 | 
|---|
 | 390 | //     THE VARIABLES STP, F, DG CONTAIN THE VALUES OF THE STEP, 
 | 
|---|
 | 391 | //     FUNCTION, AND DERIVATIVE AT THE CURRENT STEP. 
 | 
|---|
 | 392 | 
 | 
|---|
 | 393 |     stx = zero;
 | 
|---|
 | 394 |     fx = finit;
 | 
|---|
 | 395 |     dgx = dginit;
 | 
|---|
 | 396 |     sty = zero;
 | 
|---|
 | 397 |     fy = finit;
 | 
|---|
 | 398 |     dgy = dginit;
 | 
|---|
 | 399 | 
 | 
|---|
 | 400 | //     START OF ITERATION. 
 | 
|---|
 | 401 | 
 | 
|---|
 | 402 | L30:
 | 
|---|
 | 403 | 
 | 
|---|
 | 404 | //        SET THE MINIMUM AND MAXIMUM STEPS TO CORRESPOND 
 | 
|---|
 | 405 | //        TO THE PRESENT INTERVAL OF UNCERTAINTY. 
 | 
|---|
 | 406 | 
 | 
|---|
 | 407 |     if (brackt) {
 | 
|---|
 | 408 |         stmin = min(stx,sty);
 | 
|---|
 | 409 |         stmax = max(stx,sty);
 | 
|---|
 | 410 |     } else {
 | 
|---|
 | 411 |         stmin = stx;
 | 
|---|
 | 412 |         stmax = *stp + xtrapf * (*stp - stx);
 | 
|---|
 | 413 |     }
 | 
|---|
 | 414 | 
 | 
|---|
 | 415 | //        FORCE THE STEP TO BE WITHIN THE BOUNDS STPMAX AND STPMIN. 
 | 
|---|
 | 416 | 
 | 
|---|
 | 417 |     *stp = max(*stp,stpmin_);
 | 
|---|
 | 418 |     *stp = min(*stp,stpmax_);
 | 
|---|
 | 419 | 
 | 
|---|
 | 420 | //        IF AN UNUSUAL TERMINATION IS TO OCCUR THEN LET 
 | 
|---|
 | 421 | //        STP BE THE LOWEST POINT OBTAINED SO FAR. 
 | 
|---|
 | 422 | 
 | 
|---|
 | 423 |     if (brackt && (*stp <= stmin || *stp >= stmax) || *nfev >= *maxfev - 1 || 
 | 
|---|
 | 424 |             infoc == 0 || brackt && stmax - stmin <= *xtol * stmax) {
 | 
|---|
 | 425 |         *stp = stx;
 | 
|---|
 | 426 |     }
 | 
|---|
 | 427 | 
 | 
|---|
 | 428 | //        EVALUATE THE FUNCTION AND GRADIENT AT STP 
 | 
|---|
 | 429 | //        AND COMPUTE THE DIRECTIONAL DERIVATIVE. 
 | 
|---|
 | 430 | //        We return to main program to obtain F and G. 
 | 
|---|
 | 431 | 
 | 
|---|
 | 432 |     i__1 = *n;
 | 
|---|
 | 433 |     for (int j = 1; j <= i__1; ++j) {
 | 
|---|
 | 434 |         x[j] = wa[j] + *stp * s[j];
 | 
|---|
 | 435 | // L40: 
 | 
|---|
 | 436 |     }
 | 
|---|
 | 437 |     *info = -1;
 | 
|---|
 | 438 |     return;
 | 
|---|
 | 439 | 
 | 
|---|
 | 440 | L45:
 | 
|---|
 | 441 |     *info = 0;
 | 
|---|
 | 442 |     ++(*nfev);
 | 
|---|
 | 443 |     dg = zero;
 | 
|---|
 | 444 |     i__1 = *n;
 | 
|---|
 | 445 |     for (int j = 1; j <= i__1; ++j) {
 | 
|---|
 | 446 |         dg += g[j] * s[j];
 | 
|---|
 | 447 | // L50: 
 | 
|---|
 | 448 |     }
 | 
|---|
 | 449 |     ftest1 = finit + *stp * dgtest;
 | 
|---|
 | 450 | 
 | 
|---|
 | 451 | //        TEST FOR CONVERGENCE. 
 | 
|---|
 | 452 | 
 | 
|---|
 | 453 |     if (brackt && (*stp <= stmin || *stp >= stmax) || infoc == 0) {
 | 
|---|
 | 454 |         *info = 6;
 | 
|---|
 | 455 |     }
 | 
|---|
 | 456 |     if (*stp == stpmax_ && *f <= ftest1 && dg <= dgtest) {
 | 
|---|
 | 457 |         *info = 5;
 | 
|---|
 | 458 |     }
 | 
|---|
 | 459 |     if (*stp == stpmin_ && (*f > ftest1 || dg >= dgtest)) {
 | 
|---|
 | 460 |         *info = 4;
 | 
|---|
 | 461 |     }
 | 
|---|
 | 462 |     if (*nfev >= *maxfev) {
 | 
|---|
 | 463 |         *info = 3;
 | 
|---|
 | 464 |     }
 | 
|---|
 | 465 |     if (brackt && stmax - stmin <= *xtol * stmax) {
 | 
|---|
 | 466 |         *info = 2;
 | 
|---|
 | 467 |     }
 | 
|---|
 | 468 |     if (*f <= ftest1 && fabs(dg) <= gtol_ * (-dginit)) {
 | 
|---|
 | 469 |         *info = 1;
 | 
|---|
 | 470 |     }
 | 
|---|
 | 471 | 
 | 
|---|
 | 472 | //        CHECK FOR TERMINATION. 
 | 
|---|
 | 473 | 
 | 
|---|
 | 474 |     if (*info != 0) {
 | 
|---|
 | 475 |         return;
 | 
|---|
 | 476 |     }
 | 
|---|
 | 477 | 
 | 
|---|
 | 478 | //        IN THE FIRST STAGE WE SEEK A STEP FOR WHICH THE MODIFIED 
 | 
|---|
 | 479 | //        FUNCTION HAS A NONPOSITIVE VALUE AND NONNEGATIVE DERIVATIVE. 
 | 
|---|
 | 480 | 
 | 
|---|
 | 481 |     if (stage1 && *f <= ftest1 && dg >= min(*ftol,gtol_) * dginit) {
 | 
|---|
 | 482 |         stage1 = false;
 | 
|---|
 | 483 |     }
 | 
|---|
 | 484 | 
 | 
|---|
 | 485 | //        A MODIFIED FUNCTION IS USED TO PREDICT THE STEP ONLY IF 
 | 
|---|
 | 486 | //        WE HAVE NOT OBTAINED A STEP FOR WHICH THE MODIFIED 
 | 
|---|
 | 487 | //        FUNCTION HAS A NONPOSITIVE FUNCTION VALUE AND NONNEGATIVE 
 | 
|---|
 | 488 | //        DERIVATIVE, AND IF A LOWER FUNCTION VALUE HAS BEEN 
 | 
|---|
 | 489 | //        OBTAINED BUT THE DECREASE IS NOT SUFFICIENT. 
 | 
|---|
 | 490 | 
 | 
|---|
 | 491 |     if (stage1 && *f <= fx && *f > ftest1) {
 | 
|---|
 | 492 | 
 | 
|---|
 | 493 | //           DEFINE THE MODIFIED FUNCTION AND DERIVATIVE VALUES. 
 | 
|---|
 | 494 | 
 | 
|---|
 | 495 |         fm = *f - *stp * dgtest;
 | 
|---|
 | 496 |         fxm = fx - stx * dgtest;
 | 
|---|
 | 497 |         fym = fy - sty * dgtest;
 | 
|---|
 | 498 |         dgm = dg - dgtest;
 | 
|---|
 | 499 |         dgxm = dgx - dgtest;
 | 
|---|
 | 500 |         dgym = dgy - dgtest;
 | 
|---|
 | 501 | 
 | 
|---|
 | 502 | //           CALL CSTEP TO UPDATE THE INTERVAL OF UNCERTAINTY 
 | 
|---|
 | 503 | //           AND TO COMPUTE THE NEW STEP. 
 | 
|---|
 | 504 | 
 | 
|---|
 | 505 |         mcstep(&stx, &fxm, &dgxm, &sty, &fym, &dgym, stp, &fm, &dgm, &brackt,
 | 
|---|
 | 506 |                  &stmin, &stmax, &infoc);
 | 
|---|
 | 507 | 
 | 
|---|
 | 508 | //           RESET THE FUNCTION AND GRADIENT VALUES FOR F. 
 | 
|---|
 | 509 | 
 | 
|---|
 | 510 |         fx = fxm + stx * dgtest;
 | 
|---|
 | 511 |         fy = fym + sty * dgtest;
 | 
|---|
 | 512 |         dgx = dgxm + dgtest;
 | 
|---|
 | 513 |         dgy = dgym + dgtest;
 | 
|---|
 | 514 |     } else {
 | 
|---|
 | 515 | 
 | 
|---|
 | 516 | //           CALL MCSTEP TO UPDATE THE INTERVAL OF UNCERTAINTY 
 | 
|---|
 | 517 | //           AND TO COMPUTE THE NEW STEP. 
 | 
|---|
 | 518 | 
 | 
|---|
 | 519 |         mcstep(&stx, &fx, &dgx, &sty, &fy, &dgy, stp, f, &dg, &brackt, &
 | 
|---|
 | 520 |                 stmin, &stmax, &infoc);
 | 
|---|
 | 521 |     }
 | 
|---|
 | 522 | 
 | 
|---|
 | 523 | //        FORCE A SUFFICIENT DECREASE IN THE SIZE OF THE 
 | 
|---|
 | 524 | //        INTERVAL OF UNCERTAINTY. 
 | 
|---|
 | 525 | 
 | 
|---|
 | 526 |     if (brackt) {
 | 
|---|
 | 527 |         if ((d__1 = sty - stx, fabs(d__1)) >= p66 * width1) {
 | 
|---|
 | 528 |             *stp = stx + p5 * (sty - stx);
 | 
|---|
 | 529 |         }
 | 
|---|
 | 530 |         width1 = width;
 | 
|---|
 | 531 |         width = (d__1 = sty - stx, fabs(d__1));
 | 
|---|
 | 532 |     }
 | 
|---|
 | 533 | 
 | 
|---|
 | 534 | //        END OF ITERATION. 
 | 
|---|
 | 535 | 
 | 
|---|
 | 536 |     goto L30;
 | 
|---|
 | 537 | 
 | 
|---|
 | 538 | //     LAST LINE OF SUBROUTINE MCSRCH. 
 | 
|---|
 | 539 | 
 | 
|---|
 | 540 | } // mcsrch_ 
 | 
|---|
 | 541 | 
 | 
|---|
 | 542 | void
 | 
|---|
 | 543 | MCSearch::mcstep(double *stx, double *fx, double *dx, 
 | 
|---|
 | 544 |                  double *sty, double *fy, double *dy, double *stp, 
 | 
|---|
 | 545 |                  double *fp, double *dp, bool *brackt, double *stpmin, 
 | 
|---|
 | 546 |                  double *stpmax, int *info)
 | 
|---|
 | 547 | {
 | 
|---|
 | 548 |     // System generated locals 
 | 
|---|
 | 549 |     double d__1, d__2, d__3;
 | 
|---|
 | 550 | 
 | 
|---|
 | 551 | //     SUBROUTINE MCSTEP 
 | 
|---|
 | 552 | 
 | 
|---|
 | 553 | //     THE PURPOSE OF MCSTEP IS TO COMPUTE A SAFEGUARDED STEP FOR 
 | 
|---|
 | 554 | //     A LINESEARCH AND TO UPDATE AN INTERVAL OF UNCERTAINTY FOR 
 | 
|---|
 | 555 | //     A MINIMIZER OF THE FUNCTION. 
 | 
|---|
 | 556 | 
 | 
|---|
 | 557 | //     THE PARAMETER STX CONTAINS THE STEP WITH THE LEAST FUNCTION 
 | 
|---|
 | 558 | //     VALUE. THE PARAMETER STP CONTAINS THE CURRENT STEP. IT IS 
 | 
|---|
 | 559 | //     ASSUMED THAT THE DERIVATIVE AT STX IS NEGATIVE IN THE 
 | 
|---|
 | 560 | //     DIRECTION OF THE STEP. IF BRACKT IS SET TRUE THEN A 
 | 
|---|
 | 561 | //     MINIMIZER HAS BEEN BRACKETED IN AN INTERVAL OF UNCERTAINTY 
 | 
|---|
 | 562 | //     WITH ENDPOINTS STX AND STY. 
 | 
|---|
 | 563 | 
 | 
|---|
 | 564 | //     THE SUBROUTINE STATEMENT IS 
 | 
|---|
 | 565 | 
 | 
|---|
 | 566 | //       SUBROUTINE MCSTEP(STX,FX,DX,STY,FY,DY,STP,FP,DP,BRACKT, 
 | 
|---|
 | 567 | //                        STPMIN,STPMAX,INFO) 
 | 
|---|
 | 568 | 
 | 
|---|
 | 569 | //     WHERE 
 | 
|---|
 | 570 | 
 | 
|---|
 | 571 | //       STX, FX, AND DX ARE VARIABLES WHICH SPECIFY THE STEP, 
 | 
|---|
 | 572 | //         THE FUNCTION, AND THE DERIVATIVE AT THE BEST STEP OBTAINED 
 | 
|---|
 | 573 | //         SO FAR. THE DERIVATIVE MUST BE NEGATIVE IN THE DIRECTION 
 | 
|---|
 | 574 | //         OF THE STEP, THAT IS, DX AND STP-STX MUST HAVE OPPOSITE 
 | 
|---|
 | 575 | //         SIGNS. ON OUTPUT THESE PARAMETERS ARE UPDATED APPROPRIATELY. 
 | 
|---|
 | 576 | 
 | 
|---|
 | 577 | //       STY, FY, AND DY ARE VARIABLES WHICH SPECIFY THE STEP, 
 | 
|---|
 | 578 | //         THE FUNCTION, AND THE DERIVATIVE AT THE OTHER ENDPOINT OF 
 | 
|---|
 | 579 | //         THE INTERVAL OF UNCERTAINTY. ON OUTPUT THESE PARAMETERS ARE 
 | 
|---|
 | 580 | //         UPDATED APPROPRIATELY. 
 | 
|---|
 | 581 | 
 | 
|---|
 | 582 | //       STP, FP, AND DP ARE VARIABLES WHICH SPECIFY THE STEP, 
 | 
|---|
 | 583 | //         THE FUNCTION, AND THE DERIVATIVE AT THE CURRENT STEP. 
 | 
|---|
 | 584 | //         IF BRACKT IS SET TRUE THEN ON INPUT STP MUST BE 
 | 
|---|
 | 585 | //         BETWEEN STX AND STY. ON OUTPUT STP IS SET TO THE NEW STEP. 
 | 
|---|
 | 586 | 
 | 
|---|
 | 587 | //       BRACKT IS A LOGICAL VARIABLE WHICH SPECIFIES IF A MINIMIZER 
 | 
|---|
 | 588 | //         HAS BEEN BRACKETED. IF THE MINIMIZER HAS NOT BEEN BRACKETED 
 | 
|---|
 | 589 | //         THEN ON INPUT BRACKT MUST BE SET FALSE. IF THE MINIMIZER 
 | 
|---|
 | 590 | //         IS BRACKETED THEN ON OUTPUT BRACKT IS SET TRUE. 
 | 
|---|
 | 591 | 
 | 
|---|
 | 592 | //       STPMIN AND STPMAX ARE INPUT VARIABLES WHICH SPECIFY LOWER 
 | 
|---|
 | 593 | //         AND UPPER BOUNDS FOR THE STEP. 
 | 
|---|
 | 594 | 
 | 
|---|
 | 595 | //       INFO IS AN INTEGER OUTPUT VARIABLE SET AS FOLLOWS: 
 | 
|---|
 | 596 | //         IF INFO = 1,2,3,4,5, THEN THE STEP HAS BEEN COMPUTED 
 | 
|---|
 | 597 | //         ACCORDING TO ONE OF THE FIVE CASES BELOW. OTHERWISE 
 | 
|---|
 | 598 | //         INFO = 0, AND THIS INDICATES IMPROPER INPUT PARAMETERS. 
 | 
|---|
 | 599 | 
 | 
|---|
 | 600 | //     SUBPROGRAMS CALLED 
 | 
|---|
 | 601 | 
 | 
|---|
 | 602 | //       FORTRAN-SUPPLIED ... ABS,MAX,MIN,SQRT 
 | 
|---|
 | 603 | 
 | 
|---|
 | 604 | //     ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. JUNE 1983 
 | 
|---|
 | 605 | //     JORGE J. MORE', DAVID J. THUENTE 
 | 
|---|
 | 606 | 
 | 
|---|
 | 607 |     *info = 0;
 | 
|---|
 | 608 | 
 | 
|---|
 | 609 | //     CHECK THE INPUT PARAMETERS FOR ERRORS. 
 | 
|---|
 | 610 | 
 | 
|---|
 | 611 |     if (*brackt && (*stp <= min(*stx,*sty) || *stp >= max(*stx,*sty)) || *dx *
 | 
|---|
 | 612 |              (*stp - *stx) >= 0.f || *stpmax < *stpmin) {
 | 
|---|
 | 613 |         return;
 | 
|---|
 | 614 |     }
 | 
|---|
 | 615 | 
 | 
|---|
 | 616 | //     DETERMINE IF THE DERIVATIVES HAVE OPPOSITE SIGN. 
 | 
|---|
 | 617 | 
 | 
|---|
 | 618 |     sgnd = *dp * (*dx / fabs(*dx));
 | 
|---|
 | 619 | 
 | 
|---|
 | 620 | //     FIRST CASE. A HIGHER FUNCTION VALUE. 
 | 
|---|
 | 621 | //     THE MINIMUM IS BRACKETED. IF THE CUBIC STEP IS CLOSER 
 | 
|---|
 | 622 | //     TO STX THAN THE QUADRATIC STEP, THE CUBIC STEP IS TAKEN, 
 | 
|---|
 | 623 | //     ELSE THE AVERAGE OF THE CUBIC AND QUADRATIC STEPS IS TAKEN. 
 | 
|---|
 | 624 | 
 | 
|---|
 | 625 |     if (*fp > *fx) {
 | 
|---|
 | 626 |         *info = 1;
 | 
|---|
 | 627 |         bound = true;
 | 
|---|
 | 628 |         theta = (*fx - *fp) * 3 / (*stp - *stx) + *dx + *dp;
 | 
|---|
 | 629 | // Computing MAX 
 | 
|---|
 | 630 |         d__1 = fabs(theta), d__2 = fabs(*dx), d__1 = max(d__1,d__2), d__2 = fabs(
 | 
|---|
 | 631 |                 *dp);
 | 
|---|
 | 632 |         s = max(d__1,d__2);
 | 
|---|
 | 633 | // Computing 2nd power 
 | 
|---|
 | 634 |         d__1 = theta / s;
 | 
|---|
 | 635 |         gamma = s * sqrt(d__1 * d__1 - *dx / s * (*dp / s));
 | 
|---|
 | 636 |         if (*stp < *stx) {
 | 
|---|
 | 637 |             gamma = -gamma;
 | 
|---|
 | 638 |         }
 | 
|---|
 | 639 |         p = gamma - *dx + theta;
 | 
|---|
 | 640 |         q = gamma - *dx + gamma + *dp;
 | 
|---|
 | 641 |         r__ = p / q;
 | 
|---|
 | 642 |         stpc = *stx + r__ * (*stp - *stx);
 | 
|---|
 | 643 |         stpq = *stx + *dx / ((*fx - *fp) / (*stp - *stx) + *dx) / 2 * (*stp - 
 | 
|---|
 | 644 |                 *stx);
 | 
|---|
 | 645 |         if ((d__1 = stpc - *stx, fabs(d__1)) < (d__2 = stpq - *stx, fabs(d__2)))
 | 
|---|
 | 646 |                  {
 | 
|---|
 | 647 |             stpf = stpc;
 | 
|---|
 | 648 |         } else {
 | 
|---|
 | 649 |             stpf = stpc + (stpq - stpc) / 2;
 | 
|---|
 | 650 |         }
 | 
|---|
 | 651 |         *brackt = true;
 | 
|---|
 | 652 | 
 | 
|---|
 | 653 | //     SECOND CASE. A LOWER FUNCTION VALUE AND DERIVATIVES OF 
 | 
|---|
 | 654 | //     OPPOSITE SIGN. THE MINIMUM IS BRACKETED. IF THE CUBIC 
 | 
|---|
 | 655 | //     STEP IS CLOSER TO STX THAN THE QUADRATIC (SECANT) STEP, 
 | 
|---|
 | 656 | //     THE CUBIC STEP IS TAKEN, ELSE THE QUADRATIC STEP IS TAKEN. 
 | 
|---|
 | 657 | 
 | 
|---|
 | 658 |     } else if (sgnd < 0.f) {
 | 
|---|
 | 659 |         *info = 2;
 | 
|---|
 | 660 |         bound = false;
 | 
|---|
 | 661 |         theta = (*fx - *fp) * 3 / (*stp - *stx) + *dx + *dp;
 | 
|---|
 | 662 | // Computing MAX 
 | 
|---|
 | 663 |         d__1 = fabs(theta), d__2 = fabs(*dx), d__1 = max(d__1,d__2), d__2 = fabs(
 | 
|---|
 | 664 |                 *dp);
 | 
|---|
 | 665 |         s = max(d__1,d__2);
 | 
|---|
 | 666 | // Computing 2nd power 
 | 
|---|
 | 667 |         d__1 = theta / s;
 | 
|---|
 | 668 |         gamma = s * sqrt(d__1 * d__1 - *dx / s * (*dp / s));
 | 
|---|
 | 669 |         if (*stp > *stx) {
 | 
|---|
 | 670 |             gamma = -gamma;
 | 
|---|
 | 671 |         }
 | 
|---|
 | 672 |         p = gamma - *dp + theta;
 | 
|---|
 | 673 |         q = gamma - *dp + gamma + *dx;
 | 
|---|
 | 674 |         r__ = p / q;
 | 
|---|
 | 675 |         stpc = *stp + r__ * (*stx - *stp);
 | 
|---|
 | 676 |         stpq = *stp + *dp / (*dp - *dx) * (*stx - *stp);
 | 
|---|
 | 677 |         if ((d__1 = stpc - *stp, fabs(d__1)) > (d__2 = stpq - *stp, fabs(d__2)))
 | 
|---|
 | 678 |                  {
 | 
|---|
 | 679 |             stpf = stpc;
 | 
|---|
 | 680 |         } else {
 | 
|---|
 | 681 |             stpf = stpq;
 | 
|---|
 | 682 |         }
 | 
|---|
 | 683 |         *brackt = true;
 | 
|---|
 | 684 | 
 | 
|---|
 | 685 | //     THIRD CASE. A LOWER FUNCTION VALUE, DERIVATIVES OF THE 
 | 
|---|
 | 686 | //     SAME SIGN, AND THE MAGNITUDE OF THE DERIVATIVE DECREASES. 
 | 
|---|
 | 687 | //     THE CUBIC STEP IS ONLY USED IF THE CUBIC TENDS TO INFINITY 
 | 
|---|
 | 688 | //     IN THE DIRECTION OF THE STEP OR IF THE MINIMUM OF THE CUBIC 
 | 
|---|
 | 689 | //     IS BEYOND STP. OTHERWISE THE CUBIC STEP IS DEFINED TO BE 
 | 
|---|
 | 690 | //     EITHER STPMIN OR STPMAX. THE QUADRATIC (SECANT) STEP IS ALSO 
 | 
|---|
 | 691 | //     COMPUTED AND IF THE MINIMUM IS BRACKETED THEN THE THE STEP 
 | 
|---|
 | 692 | //     CLOSEST TO STX IS TAKEN, ELSE THE STEP FARTHEST AWAY IS TAKEN. 
 | 
|---|
 | 693 | 
 | 
|---|
 | 694 |     } else if (fabs(*dp) < fabs(*dx)) {
 | 
|---|
 | 695 |         *info = 3;
 | 
|---|
 | 696 |         bound = true;
 | 
|---|
 | 697 |         theta = (*fx - *fp) * 3 / (*stp - *stx) + *dx + *dp;
 | 
|---|
 | 698 | // Computing MAX 
 | 
|---|
 | 699 |         d__1 = fabs(theta), d__2 = fabs(*dx), d__1 = max(d__1,d__2), d__2 = fabs(
 | 
|---|
 | 700 |                 *dp);
 | 
|---|
 | 701 |         s = max(d__1,d__2);
 | 
|---|
 | 702 | 
 | 
|---|
 | 703 | //        THE CASE GAMMA = 0 ONLY ARISES IF THE CUBIC DOES NOT TEND 
 | 
|---|
 | 704 | //        TO INFINITY IN THE DIRECTION OF THE STEP. 
 | 
|---|
 | 705 | 
 | 
|---|
 | 706 | // Computing MAX 
 | 
|---|
 | 707 | // Computing 2nd power 
 | 
|---|
 | 708 |         d__3 = theta / s;
 | 
|---|
 | 709 |         d__1 = 0., d__2 = d__3 * d__3 - *dx / s * (*dp / s);
 | 
|---|
 | 710 |         gamma = s * sqrt((max(d__1,d__2)));
 | 
|---|
 | 711 |         if (*stp > *stx) {
 | 
|---|
 | 712 |             gamma = -gamma;
 | 
|---|
 | 713 |         }
 | 
|---|
 | 714 |         p = gamma - *dp + theta;
 | 
|---|
 | 715 |         q = gamma + (*dx - *dp) + gamma;
 | 
|---|
 | 716 |         r__ = p / q;
 | 
|---|
 | 717 |         if (r__ < 0.f && gamma != 0.f) {
 | 
|---|
 | 718 |             stpc = *stp + r__ * (*stx - *stp);
 | 
|---|
 | 719 |         } else if (*stp > *stx) {
 | 
|---|
 | 720 |             stpc = *stpmax;
 | 
|---|
 | 721 |         } else {
 | 
|---|
 | 722 |             stpc = *stpmin;
 | 
|---|
 | 723 |         }
 | 
|---|
 | 724 |         stpq = *stp + *dp / (*dp - *dx) * (*stx - *stp);
 | 
|---|
 | 725 |         if (*brackt) {
 | 
|---|
 | 726 |             if ((d__1 = *stp - stpc, fabs(d__1)) < (d__2 = *stp - stpq, fabs(
 | 
|---|
 | 727 |                     d__2))) {
 | 
|---|
 | 728 |                 stpf = stpc;
 | 
|---|
 | 729 |             } else {
 | 
|---|
 | 730 |                 stpf = stpq;
 | 
|---|
 | 731 |             }
 | 
|---|
 | 732 |         } else {
 | 
|---|
 | 733 |             if ((d__1 = *stp - stpc, fabs(d__1)) > (d__2 = *stp - stpq, fabs(
 | 
|---|
 | 734 |                     d__2))) {
 | 
|---|
 | 735 |                 stpf = stpc;
 | 
|---|
 | 736 |             } else {
 | 
|---|
 | 737 |                 stpf = stpq;
 | 
|---|
 | 738 |             }
 | 
|---|
 | 739 |         }
 | 
|---|
 | 740 | 
 | 
|---|
 | 741 | //     FOURTH CASE. A LOWER FUNCTION VALUE, DERIVATIVES OF THE 
 | 
|---|
 | 742 | //     SAME SIGN, AND THE MAGNITUDE OF THE DERIVATIVE DOES 
 | 
|---|
 | 743 | //     NOT DECREASE. IF THE MINIMUM IS NOT BRACKETED, THE STEP 
 | 
|---|
 | 744 | //     IS EITHER STPMIN OR STPMAX, ELSE THE CUBIC STEP IS TAKEN. 
 | 
|---|
 | 745 | 
 | 
|---|
 | 746 |     } else {
 | 
|---|
 | 747 |         *info = 4;
 | 
|---|
 | 748 |         bound = false;
 | 
|---|
 | 749 |         if (*brackt) {
 | 
|---|
 | 750 |             theta = (*fp - *fy) * 3 / (*sty - *stp) + *dy + *dp;
 | 
|---|
 | 751 | // Computing MAX 
 | 
|---|
 | 752 |             d__1 = fabs(theta), d__2 = fabs(*dy), d__1 = max(d__1,d__2), d__2 = 
 | 
|---|
 | 753 |                     fabs(*dp);
 | 
|---|
 | 754 |             s = max(d__1,d__2);
 | 
|---|
 | 755 | // Computing 2nd power 
 | 
|---|
 | 756 |             d__1 = theta / s;
 | 
|---|
 | 757 |             gamma = s * sqrt(d__1 * d__1 - *dy / s * (*dp / s));
 | 
|---|
 | 758 |             if (*stp > *sty) {
 | 
|---|
 | 759 |                 gamma = -gamma;
 | 
|---|
 | 760 |             }
 | 
|---|
 | 761 |             p = gamma - *dp + theta;
 | 
|---|
 | 762 |             q = gamma - *dp + gamma + *dy;
 | 
|---|
 | 763 |             r__ = p / q;
 | 
|---|
 | 764 |             stpc = *stp + r__ * (*sty - *stp);
 | 
|---|
 | 765 |             stpf = stpc;
 | 
|---|
 | 766 |         } else if (*stp > *stx) {
 | 
|---|
 | 767 |             stpf = *stpmax;
 | 
|---|
 | 768 |         } else {
 | 
|---|
 | 769 |             stpf = *stpmin;
 | 
|---|
 | 770 |         }
 | 
|---|
 | 771 |     }
 | 
|---|
 | 772 | 
 | 
|---|
 | 773 | //     UPDATE THE INTERVAL OF UNCERTAINTY. THIS UPDATE DOES NOT 
 | 
|---|
 | 774 | //     DEPEND ON THE NEW STEP OR THE CASE ANALYSIS ABOVE. 
 | 
|---|
 | 775 | 
 | 
|---|
 | 776 |     if (*fp > *fx) {
 | 
|---|
 | 777 |         *sty = *stp;
 | 
|---|
 | 778 |         *fy = *fp;
 | 
|---|
 | 779 |         *dy = *dp;
 | 
|---|
 | 780 |     } else {
 | 
|---|
 | 781 |         if (sgnd < 0.) {
 | 
|---|
 | 782 |             *sty = *stx;
 | 
|---|
 | 783 |             *fy = *fx;
 | 
|---|
 | 784 |             *dy = *dx;
 | 
|---|
 | 785 |         }
 | 
|---|
 | 786 |         *stx = *stp;
 | 
|---|
 | 787 |         *fx = *fp;
 | 
|---|
 | 788 |         *dx = *dp;
 | 
|---|
 | 789 |     }
 | 
|---|
 | 790 | 
 | 
|---|
 | 791 | //     COMPUTE THE NEW STEP AND SAFEGUARD IT. 
 | 
|---|
 | 792 | 
 | 
|---|
 | 793 |     stpf = min(*stpmax,stpf);
 | 
|---|
 | 794 |     stpf = max(*stpmin,stpf);
 | 
|---|
 | 795 |     *stp = stpf;
 | 
|---|
 | 796 |     if (*brackt && bound) {
 | 
|---|
 | 797 |         if (*sty > *stx) {
 | 
|---|
 | 798 | // Computing MIN 
 | 
|---|
 | 799 |             d__1 = *stx + (*sty - *stx) * .66;
 | 
|---|
 | 800 |             *stp = min(d__1,*stp);
 | 
|---|
 | 801 |         } else {
 | 
|---|
 | 802 | // Computing MAX 
 | 
|---|
 | 803 |             d__1 = *stx + (*sty - *stx) * .66;
 | 
|---|
 | 804 |             *stp = max(d__1,*stp);
 | 
|---|
 | 805 |         }
 | 
|---|
 | 806 |     }
 | 
|---|
 | 807 |     return;
 | 
|---|
 | 808 | 
 | 
|---|
 | 809 | //     LAST LINE OF SUBROUTINE MCSTEP. 
 | 
|---|
 | 810 | 
 | 
|---|
 | 811 | } // mcstep_ 
 | 
|---|
 | 812 | 
 | 
|---|
 | 813 | }
 | 
|---|
 | 814 | 
 | 
|---|