7 #define max(a,b) ((a) > (b) ? (a) : (b))
8 #define min(a,b) ((a) < (b) ? (a) : (b))
10 /* Common Block Declarations */
13 int nres, ndec, nin, nit;
14 /* int nfv; -- now stored in stop->nevals */
18 /* *********************************************************************** */
19 /* SUBROUTINE PLIS ALL SYSTEMS 01/09/22 */
21 /* GENERAL SUBROUTINE FOR LARGE-SCALE BOX CONSTRAINED MINIMIZATION THAT */
22 /* USE THE LIMITED MEMORY VARIABLE METRIC METHOD BASED ON THE STRANG */
26 /* II NF NUMBER OF VARIABLES. */
27 /* II NB CHOICE OF SIMPLE BOUNDS. NB=0-SIMPLE BOUNDS SUPPRESSED. */
28 /* NB>0-SIMPLE BOUNDS ACCEPTED. */
29 /* RI X(NF) VECTOR OF VARIABLES. */
30 /* II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. IX(I)=0-VARIABLE */
31 /* X(I) IS UNBOUNDED. IX(I)=1-LOVER BOUND XL(I).LE.X(I). */
32 /* IX(I)=2-UPPER BOUND X(I).LE.XU(I). IX(I)=3-TWO SIDE BOUND */
33 /* XL(I).LE.X(I).LE.XU(I). IX(I)=5-VARIABLE X(I) IS FIXED. */
34 /* RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. */
35 /* RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. */
36 /* RO GF(NF) GRADIENT OF THE OBJECTIVE FUNCTION. */
37 /* RO S(NF) DIRECTION VECTOR. */
38 /* RU XO(NF) VECTORS OF VARIABLES DIFFERENCE. */
39 /* RI GO(NF) GRADIENTS DIFFERENCE. */
40 /* RA UO(NF) AUXILIARY VECTOR. */
41 /* RA VO(NF) AUXILIARY VECTOR. */
42 /* RI XMAX MAXIMUM STEPSIZE. */
43 /* RI TOLX TOLERANCE FOR CHANGE OF VARIABLES. */
44 /* RI TOLF TOLERANCE FOR CHANGE OF FUNCTION VALUES. */
45 /* RI TOLB TOLERANCE FOR THE FUNCTION VALUE. */
46 /* RI TOLG TOLERANCE FOR THE GRADIENT NORM. */
47 /* RI MINF_EST ESTIMATION OF THE MINIMUM FUNCTION VALUE. */
48 /* RO GMAX MAXIMUM PARTIAL DERIVATIVE. */
49 /* RO F VALUE OF THE OBJECTIVE FUNCTION. */
50 /* II MIT MAXIMUM NUMBER OF ITERATIONS. */
51 /* II MFV MAXIMUM NUMBER OF FUNCTION EVALUATIONS. */
52 /* II IEST ESTIMATION INDICATOR. IEST=0-MINIMUM IS NOT ESTIMATED. */
53 /* IEST=1-MINIMUM IS ESTIMATED BY THE VALUE MINF_EST. */
54 /* II MF NUMBER OF LIMITED MEMORY STEPS. */
55 /* IO ITERM VARIABLE THAT INDICATES THE CAUSE OF TERMINATION. */
56 /* ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN */
57 /* MTESX (USUALLY TWO) SUBSEQUEBT ITERATIONS. */
58 /* ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN */
59 /* MTESF (USUALLY TWO) SUBSEQUEBT ITERATIONS. */
60 /* ITERM=3-IF F IS LESS THAN OR EQUAL TO TOLB. */
61 /* ITERM=4-IF GMAX IS LESS THAN OR EQUAL TO TOLG. */
62 /* ITERM=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED, */
63 /* BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE. */
64 /* ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV. */
65 /* ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED. */
67 /* VARIABLES IN COMMON /STAT/ (STATISTICS) : */
68 /* IO NRES NUMBER OF RESTARTS. */
69 /* IO NDEC NUMBER OF MATRIX DECOMPOSITION. */
70 /* IO NIN NUMBER OF INNER ITERATIONS. */
71 /* IO NIT NUMBER OF ITERATIONS. */
72 /* IO NFV NUMBER OF FUNCTION EVALUATIONS. */
73 /* IO NFG NUMBER OF GRADIENT EVALUATIONS. */
74 /* IO NFH NUMBER OF HESSIAN EVALUATIONS. */
76 /* SUBPROGRAMS USED : */
77 /* S PCBS04 ELIMINATION OF BOX CONSTRAINT VIOLATIONS. */
78 /* S PS1L01 STEPSIZE SELECTION USING LINE SEARCH. */
79 /* S PYADC0 ADDITION OF A BOX CONSTRAINT. */
80 /* S PYFUT1 TEST ON TERMINATION. */
81 /* S PYRMC0 DELETION OF A BOX CONSTRAINT. */
82 /* S PYTRCD COMPUTATION OF PROJECTED DIFFERENCES FOR THE VARIABLE METRIC */
84 /* S PYTRCG COMPUTATION OF THE PROJECTED GRADIENT. */
85 /* S PYTRCS COMPUTATION OF THE PROJECTED DIRECTION VECTOR. */
86 /* S MXDRCB BACKWARD PART OF THE STRANG FORMULA FOR PREMULTIPLICATION */
87 /* OF THE VECTOR X BY AN IMPLICIT BFGS UPDATE. */
88 /* S MXDRCF FORWARD PART OF THE STRANG FORMULA FOR PREMULTIPLICATION */
89 /* OF THE VECTOR X BY AN IMPLICIT BFGS UPDATE. */
90 /* S MXDRSU SHIFT OF COLUMNS OF THE RECTANGULAR MATRICES A AND B. */
91 /* SHIFT OF ELEMENTS OF THE VECTOR U. THESE SHIFTS ARE USED IN */
92 /* THE LIMITED MEMORY BFGS METHOD. */
93 /* S MXUDIR VECTOR AUGMENTED BY THE SCALED VECTOR. */
94 /* RF MXUDOT DOT PRODUCT OF TWO VECTORS. */
95 /* S MXUNEG COPYING OF A VECTOR WITH CHANGE OF THE SIGN. */
96 /* S MXVCOP COPYING OF A VECTOR. */
97 /* S MXVSCL SCALING OF A VECTOR. */
99 /* EXTERNAL SUBROUTINES : */
100 /* SE OBJ COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION. */
101 /* CALLING SEQUENCE: CALL OBJ(NF,X,FF) WHERE NF IS THE NUMBER */
102 /* OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND FF IS */
103 /* THE VALUE OF THE OBJECTIVE FUNCTION. */
104 /* SE DOBJ COMPUTATION OF THE GRADIENT OF THE OBJECTIVE FUNCTION. */
105 /* CALLING SEQUENCE: CALL DOBJ(NF,X,GF) WHERE NF IS THE NUMBER */
106 /* OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND GF(NF) */
107 /* IS THE GRADIENT OF THE OBJECTIVE FUNCTION. */
108 /* -- OBJ and DOBJ are replaced by a single function, objgrad, in NLopt */
111 /* LIMITED MEMORY VARIABLE METRIC METHOD BASED ON THE STRANG */
114 static void plis_(int *nf, int *nb, double *x, int *
115 ix, double *xl, double *xu, double *gf, double *s,
116 double *xo, double *go, double *uo, double *vo,
117 double *xmax, double *tolx, double *tolf, double *
118 tolb, double *tolg, nlopt_stopping *stop,
119 double *minf_est, double *gmax,
120 double *f, int *mit, int *mfv, int *iest, int *mf,
121 int *iterm, stat_common *stat_1,
122 nlopt_func objgrad, void *objgrad_data)
124 /* System generated locals */
128 /* Builtin functions */
130 /* Local variables */
135 double fo, fp, po, pp, ro, rp;
138 double alf1, alf2, eta0, eta9, par1, par2;
139 int mes1, mes2, mes3;
141 int mred, iold, nred;
146 double rmin, rmax, umax, tolp, tols;
149 int iterd, mtesf, ntesf;
151 int iters, irest, inits, kters, maxst;
157 /* Parameter adjustments */
207 *minf_est = -HUGE_VAL;
222 *tolg = 1e-8; /* SGJ: was 1e-6, but this sometimes stops too soon */
225 /* removed by SGJ: this check prevented us from using minf_max <= 0,
226 which doesn't make sense. Instead, if you don't want to have a
227 lower limit, you should set minf_max = -HUGE_VAL */
229 *tolb = *minf_est + 1e-16;
235 /* changed by SGJ: default is no limit (INT_MAX) on # iterations/fevals */
245 kit = -(ires1 * *nf + ires2);
248 /* INITIAL OPERATIONS WITH SIMPLE BOUNDS */
252 for (i__ = 1; i__ <= i__1; ++i__) {
253 if ((ix[i__] == 3 || ix[i__] == 4) && xu[i__] <= xl[i__]) {
256 } else if (ix[i__] == 5 || ix[i__] == 6) {
263 luksan_pcbs04__(nf, &x[1], &ix[1], &xl[1], &xu[1], &eps9, &kbf);
264 luksan_pyadc0__(nf, &n, &x[1], &ix[1], &xl[1], &xu[1], &inew);
269 *f = objgrad(*nf, &x[1], &gf[1], objgrad_data);
273 luksan_pytrcg__(nf, nf, &ix[1], &gf[1], &umax, gmax, &kbf, &iold);
274 luksan_pyfut1__(nf, f, &fo, &umax, gmax, &dmax__, tolx, tolf, tolb, tolg,
275 &kd, &stat_1->nit, &kit, mit, &stop->nevals, mfv, &stat_1->nfg, &mfg,
276 &ntesx, &mtesx, &ntesf, &mtesf, &ites, &ires1, &ires2, &irest, &
281 if (nlopt_stop_time(stop)) { *iterm = 100; goto L11190; }
282 if (kbf > 0 && rmax > 0.) {
283 luksan_pyrmc0__(nf, &n, &ix[1], &gf[1], &eps8, &umax, gmax, &rmax, &
288 /* DIRECTION DETERMINATION */
290 gnorm = sqrt(luksan_mxudot__(nf, &gf[1], &gf[1], &ix[1], &kbf));
295 i__1 = stat_1->nit - kit;
298 irest = max(irest,1);
302 /* DETERMINATION OF THE PARAMETER B */
304 b = luksan_mxudot__(nf, &xo[1], &go[1], &ix[1], &kbf);
306 irest = max(irest,1);
310 luksan_mxuneg__(nf, &gf[1], &s[1], &ix[1], &kbf);
311 luksan_mxdrcb__(nf, &k, &xo[1], &go[1], &uo[1], &vo[1], &s[1], &ix[1], &
313 a = luksan_mxudot__(nf, &go[1], &go[1], &ix[1], &kbf);
316 luksan_mxvscl__(nf, &d__1, &s[1], &s[1]);
318 luksan_mxdrcf__(nf, &k, &xo[1], &go[1], &uo[1], &vo[1], &s[1], &ix[1], &
320 snorm = sqrt(luksan_mxudot__(nf, &s[1], &s[1], &ix[1], &kbf));
324 luksan_mxdrsu__(nf, &k, &xo[1], &go[1], &uo[1]);
329 /* STEEPEST DESCENT DIRECTION */
331 luksan_mxuneg__(nf, &gf[1], &s[1], &ix[1], &kbf);
333 if (kit < stat_1->nit) {
344 /* TEST ON DESCENT DIRECTION AND PREPARATION OF LINE SEARCH */
347 p = luksan_mxudot__(nf, &gf[1], &s[1], &ix[1], &kbf);
353 /* TEST ON DESCENT DIRECTION */
356 irest = max(irest,1);
357 } else if (p + told * gnorm * snorm <= 0.) {
361 /* UNIFORM DESCENT CRITERION */
363 irest = max(irest,1);
367 /* PREPARATION OF LINE SEARCH */
370 rmin = alf1 * gnorm / snorm;
372 d__1 = alf2 * gnorm / snorm, d__2 = *xmax / snorm;
373 rmax = min(d__1,d__2);
382 luksan_pytrcs__(nf, &x[1], &ix[1], &xo[1], &xl[1], &xu[1], &gf[1], &go[1],
383 &s[1], &ro, &fp, &fo, f, &po, &p, &rmax, &eta9, &kbf);
388 luksan_ps1l01__(&r__, &rp, f, &fo, &fp, &p, &po, &pp, minf_est, &maxf, &rmin,
389 &rmax, &tols, &tolp, &par1, &par2, &kd, &ld, &stat_1->nit, &kit, &
390 nred, &mred, &maxst, iest, &inits, &iters, &kters, &mes, &isys);
394 luksan_mxudir__(nf, &r__, &s[1], &xo[1], &x[1], &ix[1], &kbf);
395 luksan_pcbs04__(nf, &x[1], &ix[1], &xl[1], &xu[1], &eps9, &kbf);
396 *f = objgrad(*nf, &x[1], &gf[1], objgrad_data);
399 p = luksan_mxudot__(nf, &gf[1], &s[1], &ix[1], &kbf);
406 luksan_mxvcop__(nf, &xo[1], &x[1]);
407 luksan_mxvcop__(nf, &go[1], &gf[1]);
408 irest = max(irest,1);
412 luksan_pytrcd__(nf, &x[1], &ix[1], &xo[1], &gf[1], &go[1], &r__, f, &fo, &
413 p, &po, &dmax__, &kbf, &kd, &ld, &iters);
416 luksan_mxvine__(nf, &ix[1]);
417 luksan_pyadc0__(nf, &n, &x[1], &ix[1], &xl[1], &xu[1], &inew);
424 /* number of double variables that can be stored in scratch memory
425 ... it's >= 2007, and this is in the context of scientific computation,
426 so assume that at least 10M are available, and that sizeof(double)==8 */
427 #define MEMAVAIL 1310720
429 /* NLopt wrapper around plis_, handling dynamic allocation etc. */
430 nlopt_result luksan_plis(int n, nlopt_func f, void *f_data,
431 const double *lb, const double *ub, /* bounds */
432 double *x, /* in: initial guess, out: minimizer */
434 nlopt_stopping *stop)
437 double *work, *xl, *xu, *xo, *gf, *s, *go, *uo, *vo;
438 double gmax, minf_est;
439 double xmax = 0; /* no maximum */
440 double tolg = 0; /* default gradient tolerance */
441 int iest = 0; /* we have no estimate of min function value */
442 int mit = 0; /* default no limit on #iterations */
443 int mfv = stop->maxeval;
448 ix = (int*) malloc(sizeof(int) * n);
449 if (!ix) return NLOPT_OUT_OF_MEMORY;
451 /* FIXME: what should we set mf to? The example program tlis.for
452 sets it to zero as far as I can tell, but it seems to greatly
453 improve convergence to make it > 0. The computation time
454 per iteration, and of course the memory, seem to go as O(n * mf),
455 and we'll assume that the main limiting factor is the memory.
456 We'll assume that at least MEMAVAIL memory, or 4*n memory, whichever
457 is bigger, is available. */
458 mf = max(MEMAVAIL/n, 4);
459 if (stop->maxeval && stop->maxeval <= mf)
460 mf = max(stop->maxeval - 5, 1); /* mf > maxeval seems not good */
463 work = (double*) malloc(sizeof(double) * (n * 4 + max(n,n*mf)*2 +
471 return NLOPT_OUT_OF_MEMORY;
474 xl = work; xu = xl + n; gf = xu + n; s = gf + n;
475 xo = s + n; go = xo + max(n,n*mf);
476 uo = go + max(n,n*mf); vo = uo + max(n,mf);
478 for (i = 0; i < n; ++i) {
479 int lbu = lb[i] <= -0.99 * HUGE_VAL; /* lb unbounded */
480 int ubu = ub[i] >= 0.99 * HUGE_VAL; /* ub unbounded */
481 ix[i] = lbu ? (ubu ? 0 : 2) : (ubu ? 1 : (lb[i] == ub[i] ? 5 : 3));
486 /* ? xo does not seem to be initialized in the
487 original Fortran code, but it is used upon
488 input to plis if mf > 0 ... perhaps ALLOCATE initializes
489 arrays to zero by default? */
490 memset(xo, 0, sizeof(double) * max(n,n*mf));
492 plis_(&n, &n, x, ix, xl, xu,
493 gf, s, xo, go, uo, vo,
496 /* fixme: pass tol_rel and tol_abs and use NLopt check */
515 case 1: return NLOPT_XTOL_REACHED;
516 case 2: return NLOPT_FTOL_REACHED;
517 case 3: return NLOPT_MINF_MAX_REACHED;
518 case 4: return NLOPT_SUCCESS; /* gradient tolerance reached */
519 case 6: return NLOPT_SUCCESS;
520 case 12: case 13: return NLOPT_MAXEVAL_REACHED;
521 default: return NLOPT_FAILURE;