source: ThirdParty/mpqc_open/src/lib/math/optimize/mcsearch.cc@ 7516f6

Action_Thermostats Adding_MD_integration_tests Adding_StructOpt_integration_tests AutomationFragmentation_failures Candidate_v1.6.1 ChemicalSpaceEvaluator Enhanced_StructuralOptimization Enhanced_StructuralOptimization_continued Exclude_Hydrogens_annealWithBondGraph Fix_Verbose_Codepatterns ForceAnnealing_with_BondGraph ForceAnnealing_with_BondGraph_continued ForceAnnealing_with_BondGraph_continued_betteresults ForceAnnealing_with_BondGraph_contraction-expansion Gui_displays_atomic_force_velocity JobMarket_RobustOnKillsSegFaults JobMarket_StableWorkerPool PythonUI_with_named_parameters Recreated_GuiChecks StoppableMakroAction TremoloParser_IncreasedPrecision
Last change on this file since 7516f6 was 860145, checked in by Frederik Heber <heber@…>, 8 years ago

Merge commit '0b990dfaa8c6007a996d030163a25f7f5fc8a7e7' as 'ThirdParty/mpqc_open'

  • Property mode set to 100644
File size: 22.3 KB
Line 
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
12static inline double min(double a, double b)
13{
14 return (a<b)?a:b;
15}
16
17static inline double max(double a, double b)
18{
19 return (a<b)?b:a;
20}
21
22
23using namespace sc;
24
25namespace sc {
26
27static ClassDesc MCSearch_cd(
28 typeid(MCSearch),"MCSearch",1,"public LineOpt",
29 0, create<MCSearch>, 0);
30
31MCSearch::MCSearch(const Ref<KeyVal>& keyval)
32 : LineOpt(keyval)
33{
34}
35
36MCSearch::~MCSearch()
37{
38}
39
40void
41MCSearch::mcinit()
42{
43 info_ = 0;
44
45 // work area
46 wa_.reset(new double[function()->dimension()->n()]);
47}
48
49void
50MCSearch::init(RefSCVector& direction)
51{
52 LineOpt::init(direction);
53 mcinit();
54}
55
56void
57MCSearch::init(RefSCVector& direction, Ref<Function> function)
58{
59 LineOpt::init(direction, function);
60 mcinit();
61}
62
63int
64MCSearch::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
196void
197MCSearch::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
402L30:
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
440L45:
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
542void
543MCSearch::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
Note: See TracBrowser for help on using the repository browser.