lbfgsb 0.3.1 → 0.5.0
This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
- checksums.yaml +4 -4
- data/CHANGELOG.md +26 -0
- data/LICENSE.txt +1 -1
- data/README.md +1 -1
- data/ext/lbfgsb/extconf.rb +12 -3
- data/ext/lbfgsb/lbfgsbext.c +66 -45
- data/ext/lbfgsb/lbfgsbext.h +3 -1
- data/ext/lbfgsb/src/blas.c +27 -31
- data/ext/lbfgsb/src/blas.h +5 -5
- data/ext/lbfgsb/src/common.h +16 -0
- data/ext/lbfgsb/src/lbfgsb.c +305 -406
- data/ext/lbfgsb/src/lbfgsb.h +70 -109
- data/ext/lbfgsb/src/linpack.c +69 -68
- data/ext/lbfgsb/src/linpack.h +3 -3
- data/lib/lbfgsb/version.rb +1 -1
- data/lib/lbfgsb.rb +1 -1
- data/sig/lbfgsb.rbs +31 -0
- metadata +9 -12
- data/.github/workflows/build.yml +0 -21
- data/.gitignore +0 -17
- data/.rspec +0 -3
- data/.yardopts +0 -1
- data/Gemfile +0 -8
- data/Rakefile +0 -15
- data/lbfgsb.gemspec +0 -30
data/ext/lbfgsb/src/lbfgsb.c
CHANGED
@@ -43,14 +43,14 @@
|
|
43
43
|
*
|
44
44
|
* March 2011
|
45
45
|
*/
|
46
|
-
|
47
46
|
#include "blas.h"
|
48
47
|
#include "linpack.h"
|
48
|
+
|
49
49
|
#include "lbfgsb.h"
|
50
50
|
|
51
51
|
static double c_b9 = 0.;
|
52
|
-
static
|
53
|
-
static
|
52
|
+
static F77_int c__1 = 1;
|
53
|
+
static F77_int c__11 = 11;
|
54
54
|
static double c_b280 = .001;
|
55
55
|
static double c_b281 = .9;
|
56
56
|
static double c_b282 = .1;
|
@@ -63,11 +63,11 @@ static double c_b282 = .1;
|
|
63
63
|
* constrained optimization problem by calling mainlb.
|
64
64
|
* (The direct method will be used in the subspace minimization.)
|
65
65
|
*
|
66
|
-
* n is an
|
66
|
+
* n is an integer variable.
|
67
67
|
* On entry n is the dimension of the problem.
|
68
68
|
* On exit n is unchanged.
|
69
69
|
*
|
70
|
-
* m is an
|
70
|
+
* m is an integer variable.
|
71
71
|
* On entry m is the maximum number of variable metric corrections
|
72
72
|
* used to define the limited memory matrix.
|
73
73
|
* On exit m is unchanged.
|
@@ -84,7 +84,7 @@ static double c_b282 = .1;
|
|
84
84
|
* On entry u is the upper bound on x.
|
85
85
|
* On exit u is unchanged.
|
86
86
|
*
|
87
|
-
* nbd is an
|
87
|
+
* nbd is an integer array of dimension n.
|
88
88
|
* On entry nbd represents the type of bounds imposed on the
|
89
89
|
* variables, and must be specified as follows:
|
90
90
|
* nbd(i)=0 if x(i) is unbounded,
|
@@ -126,12 +126,12 @@ static double c_b282 = .1;
|
|
126
126
|
* wa is a double precision working array of length
|
127
127
|
* (2mmax + 5)nmax + 12mmax^2 + 12mmax.
|
128
128
|
*
|
129
|
-
* iwa is an
|
129
|
+
* iwa is an integer working array of length 3nmax.
|
130
130
|
*
|
131
131
|
* task is a working string of characters of length 60 indicating
|
132
132
|
* the current job when entering and quitting this subroutine.
|
133
133
|
*
|
134
|
-
* iprint is an
|
134
|
+
* iprint is an integer variable that must be set by the user.
|
135
135
|
* It controls the frequency and type of output generated:
|
136
136
|
* iprint<0 no output is generated;
|
137
137
|
* iprint=0 print only one line at the last iteration;
|
@@ -153,7 +153,7 @@ static double c_b282 = .1;
|
|
153
153
|
* If lsave(3) = .true. then each variable has upper and lower
|
154
154
|
* bounds;
|
155
155
|
*
|
156
|
-
* isave is an
|
156
|
+
* isave is an integer working array of dimension 44.
|
157
157
|
* On exit with 'task' = NEW_X, the following information is
|
158
158
|
* available:
|
159
159
|
* isave(22) = the total number of intervals explored in the
|
@@ -232,15 +232,11 @@ static double c_b282 = .1;
|
|
232
232
|
* Ciyou Zhu
|
233
233
|
* in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
|
234
234
|
*/
|
235
|
-
|
236
|
-
|
237
|
-
|
238
|
-
char *task, long *iprint, char *csave, long *lsave,
|
239
|
-
long *isave, double *dsave)
|
240
|
-
{
|
241
|
-
long i__1;
|
235
|
+
void setulb_(F77_int* n, F77_int* m, double* x, double* l, double* u, F77_int* nbd, double* f, double* g, double* factr, double* pgtol,
|
236
|
+
double* wa, F77_int* iwa, char* task, F77_int* iprint, char* csave, F77_int* lsave, F77_int* isave, double* dsave) {
|
237
|
+
F77_int i__1;
|
242
238
|
|
243
|
-
static
|
239
|
+
static F77_int ld, lr, lt, lz, lwa, lwn, lss, lxp, lws, lwt, lsy, lwy, lsnd;
|
244
240
|
|
245
241
|
/* jlm-jn */
|
246
242
|
--iwa;
|
@@ -287,12 +283,9 @@ int setulb_(long *n, long *m, double *x,
|
|
287
283
|
lt = isave[14];
|
288
284
|
lxp = isave[15];
|
289
285
|
lwa = isave[16];
|
290
|
-
mainlb_(n, m, &x[1], &l[1], &u[1], &nbd[1], f, &g[1], factr, pgtol, &wa[lws],
|
291
|
-
&wa[
|
292
|
-
&
|
293
|
-
&iwa[*n + 1], &iwa[(*n << 1) + 1], task, iprint, csave, &lsave[1],
|
294
|
-
&isave[22], &dsave[1]);
|
295
|
-
return 0;
|
286
|
+
mainlb_(n, m, &x[1], &l[1], &u[1], &nbd[1], f, &g[1], factr, pgtol, &wa[lws], &wa[lwy], &wa[lsy], &wa[lss], &wa[lwt],
|
287
|
+
&wa[lwn], &wa[lsnd], &wa[lz], &wa[lr], &wa[ld], &wa[lt], &wa[lxp], &wa[lwa], &iwa[1], &iwa[*n + 1],
|
288
|
+
&iwa[(*n << 1) + 1], task, iprint, csave, &lsave[1], &isave[22], &dsave[1]);
|
296
289
|
}
|
297
290
|
|
298
291
|
/**
|
@@ -301,11 +294,11 @@ int setulb_(long *n, long *m, double *x,
|
|
301
294
|
* This subroutine solves bound constrained optimization problems by
|
302
295
|
* using the compact formula of the limited memory BFGS updates.
|
303
296
|
*
|
304
|
-
* n is an
|
297
|
+
* n is an integer variable.
|
305
298
|
* On entry n is the number of variables.
|
306
299
|
* On exit n is unchanged.
|
307
300
|
*
|
308
|
-
* m is an
|
301
|
+
* m is an integer variable.
|
309
302
|
* On entry m is the maximum number of variable metric
|
310
303
|
* corrections allowed in the limited memory matrix.
|
311
304
|
* On exit m is unchanged.
|
@@ -322,7 +315,7 @@ int setulb_(long *n, long *m, double *x,
|
|
322
315
|
* On entry u is the upper bound of x.
|
323
316
|
* On exit u is unchanged.
|
324
317
|
*
|
325
|
-
* nbd is an
|
318
|
+
* nbd is an integer array of dimension n.
|
326
319
|
* On entry nbd represents the type of bounds imposed on the
|
327
320
|
* variables, and must be specified as follows:
|
328
321
|
* nbd(i)=0 if x(i) is unbounded,
|
@@ -390,11 +383,11 @@ int setulb_(long *n, long *m, double *x,
|
|
390
383
|
*
|
391
384
|
* sg(m),sgo(m),yg(m),ygo(m) are double precision working arrays.
|
392
385
|
*
|
393
|
-
* index is an
|
386
|
+
* index is an integer working array of dimension n.
|
394
387
|
* In subroutine freev, index is used to store the free and fixed
|
395
388
|
* variables at the Generalized Cauchy Point (GCP).
|
396
389
|
*
|
397
|
-
* iwhere is an
|
390
|
+
* iwhere is an integer working array of dimension n used to record
|
398
391
|
* the status of the vector x for GCP computation.
|
399
392
|
* iwhere(i)=0 or -3 if x(i) is free and has bounds,
|
400
393
|
* 1 if x(i) is fixed at l(i), and l(i) .ne. u(i)
|
@@ -402,7 +395,7 @@ int setulb_(long *n, long *m, double *x,
|
|
402
395
|
* 3 if x(i) is always fixed, i.e., u(i)=x(i)=l(i)
|
403
396
|
* -1 if x(i) is always free, i.e., no bounds on it.
|
404
397
|
*
|
405
|
-
* indx2 is an
|
398
|
+
* indx2 is an integer working array of dimension n.
|
406
399
|
* Within subroutine cauchy, indx2 corresponds to the array iorder.
|
407
400
|
* In subroutine freev, a list of variables entering and leaving
|
408
401
|
* the free set is stored in indx2, and it is passed on to
|
@@ -411,7 +404,7 @@ int setulb_(long *n, long *m, double *x,
|
|
411
404
|
* task is a working string of characters of length 60 indicating
|
412
405
|
* the current job when entering and leaving this subroutine.
|
413
406
|
*
|
414
|
-
* iprint is an
|
407
|
+
* iprint is an integer variable that must be set by the user.
|
415
408
|
* It controls the frequency and type of output generated:
|
416
409
|
* iprint<0 no output is generated;
|
417
410
|
* iprint=0 print only one line at the last iteration;
|
@@ -426,7 +419,7 @@ int setulb_(long *n, long *m, double *x,
|
|
426
419
|
*
|
427
420
|
* lsave is a logical working array of dimension 4.
|
428
421
|
*
|
429
|
-
* isave is an
|
422
|
+
* isave is an integer working array of dimension 23.
|
430
423
|
*
|
431
424
|
* dsave is a double precision working array of dimension 29.
|
432
425
|
*
|
@@ -471,57 +464,51 @@ int setulb_(long *n, long *m, double *x,
|
|
471
464
|
* Ciyou Zhu
|
472
465
|
* in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
|
473
466
|
*/
|
474
|
-
|
475
|
-
|
476
|
-
|
477
|
-
|
478
|
-
|
479
|
-
|
480
|
-
long *iwhere, long *indx2, char *task, long *iprint,
|
481
|
-
char *csave, long *lsave, long *isave, double *dsave)
|
482
|
-
{
|
483
|
-
long ws_dim1, ws_offset, wy_dim1, wy_offset, sy_dim1, sy_offset,
|
484
|
-
ss_dim1, ss_offset, wt_dim1, wt_offset, wn_dim1, wn_offset,
|
485
|
-
snd_dim1, snd_offset, i__1;
|
467
|
+
void mainlb_(F77_int* n, F77_int* m, double* x, double* l, double* u, F77_int* nbd, double* f, double* g, double* factr, double* pgtol,
|
468
|
+
double* ws, double* wy, double* sy, double* ss, double* wt, double* wn, double* snd, double* z__, double* r__,
|
469
|
+
double* d__, double* t, double* xp, double* wa, F77_int* index, F77_int* iwhere, F77_int* indx2, char* task, F77_int* iprint,
|
470
|
+
char* csave, F77_int* lsave, F77_int* isave, double* dsave) {
|
471
|
+
F77_int ws_dim1, ws_offset, wy_dim1, wy_offset, sy_dim1, sy_offset, ss_dim1, ss_offset, wt_dim1, wt_offset, wn_dim1, wn_offset,
|
472
|
+
snd_dim1, snd_offset, i__1;
|
486
473
|
double d__1, d__2;
|
487
|
-
FILE
|
488
|
-
static
|
474
|
+
FILE* itfptr;
|
475
|
+
static F77_int i__, k;
|
489
476
|
static double gd, dr, rr, dtd;
|
490
|
-
static
|
477
|
+
static F77_int col;
|
491
478
|
static double tol;
|
492
|
-
static
|
479
|
+
static F77_int wrk;
|
493
480
|
static double stp, cpu1, cpu2;
|
494
|
-
static
|
481
|
+
static F77_int head;
|
495
482
|
static double fold;
|
496
|
-
static
|
483
|
+
static F77_int nact;
|
497
484
|
static double ddum;
|
498
|
-
static
|
485
|
+
static F77_int info, nseg;
|
499
486
|
static double time;
|
500
|
-
static
|
487
|
+
static F77_int nfgv, ifun, iter;
|
501
488
|
static char word[4];
|
502
489
|
static double time1, time2;
|
503
|
-
static
|
490
|
+
static F77_int iback;
|
504
491
|
static double gdold;
|
505
|
-
static
|
506
|
-
static
|
507
|
-
static
|
492
|
+
static F77_int nfree;
|
493
|
+
static F77_int boxed;
|
494
|
+
static F77_int itail;
|
508
495
|
static double theta;
|
509
496
|
static double dnorm;
|
510
|
-
static
|
497
|
+
static F77_int nskip, iword;
|
511
498
|
static double xstep, stpmx;
|
512
|
-
static
|
499
|
+
static F77_int ileave;
|
513
500
|
static double cachyt;
|
514
|
-
static
|
501
|
+
static F77_int itfile;
|
515
502
|
static double epsmch;
|
516
|
-
static
|
503
|
+
static F77_int updatd;
|
517
504
|
static double sbtime;
|
518
|
-
static
|
519
|
-
static
|
505
|
+
static F77_int prjctd;
|
506
|
+
static F77_int iupdat;
|
520
507
|
static double sbgnrm;
|
521
|
-
static
|
522
|
-
static
|
508
|
+
static F77_int cnstnd;
|
509
|
+
static F77_int nenter;
|
523
510
|
static double lnscht;
|
524
|
-
static
|
511
|
+
static F77_int nintol;
|
525
512
|
|
526
513
|
--indx2;
|
527
514
|
--iwhere;
|
@@ -610,10 +597,9 @@ int mainlb_(long *n, long *m, double *x,
|
|
610
597
|
/* Check the input arguments for errors. */
|
611
598
|
errclb_(n, m, factr, &l[1], &u[1], &nbd[1], task, &info, &k);
|
612
599
|
if (strncmp(task, "ERROR", 5) == 0) {
|
613
|
-
prn3lb_(n, &x[1], f, task, iprint, &info, &itfile, &iter, &nfgv, &nintol,
|
614
|
-
|
615
|
-
|
616
|
-
return 0;
|
600
|
+
prn3lb_(n, &x[1], f, task, iprint, &info, &itfile, &iter, &nfgv, &nintol, &nskip, &nact, &sbgnrm, &c_b9, &nseg, word,
|
601
|
+
&iback, &stp, &xstep, &k, &cachyt, &sbtime, &lnscht);
|
602
|
+
return;
|
617
603
|
}
|
618
604
|
prn1lb_(n, m, &l[1], &u[1], &x[1], iprint, &itfile, &epsmch);
|
619
605
|
/* Initialize iwhere & project x onto the feasible set. */
|
@@ -673,8 +659,8 @@ int mainlb_(long *n, long *m, double *x,
|
|
673
659
|
if (strncmp(task, "STOP", 4) == 0) {
|
674
660
|
if (strncmp(task + 6, "CPU", 3) == 0) {
|
675
661
|
/* restore the previous iterate. */
|
676
|
-
|
677
|
-
|
662
|
+
dcopy_(n, &t[1], &c__1, &x[1], &c__1);
|
663
|
+
dcopy_(n, &r__[1], &c__1, &g[1], &c__1);
|
678
664
|
*f = fold;
|
679
665
|
}
|
680
666
|
goto L999;
|
@@ -689,9 +675,9 @@ L111:
|
|
689
675
|
/* Compute the infinity norm of the (-) projected gradient. */
|
690
676
|
projgr_(n, &l[1], &u[1], &nbd[1], &x[1], &g[1], &sbgnrm);
|
691
677
|
if (*iprint >= 1) {
|
692
|
-
fprintf(stdout, "\nAt iterate%
|
678
|
+
fprintf(stdout, "\nAt iterate%5" PRIdF77INT " f= %12.5E |proj g|= %12.5E\n", iter, *f, sbgnrm);
|
693
679
|
itfptr = fopen("iterate.dat", "a");
|
694
|
-
fprintf(itfptr, " %
|
680
|
+
fprintf(itfptr, " %4" PRIdF77INT " %4" PRIdF77INT " - - - - - - %10.3E %10.3E\n", iter, nfgv, sbgnrm, *f);
|
695
681
|
fclose(itfptr);
|
696
682
|
}
|
697
683
|
if (sbgnrm <= *pgtol) {
|
@@ -703,13 +689,13 @@ L111:
|
|
703
689
|
L222:
|
704
690
|
if (*iprint >= 99) {
|
705
691
|
i__1 = iter + 1;
|
706
|
-
fprintf(stdout, "\n\nITERATION %
|
692
|
+
fprintf(stdout, "\n\nITERATION %5" PRIdF77INT "\n", i__1);
|
707
693
|
}
|
708
694
|
iword = -1;
|
709
695
|
|
710
|
-
if (!
|
696
|
+
if (!cnstnd && col > 0) {
|
711
697
|
/* skip the search for GCP. */
|
712
|
-
|
698
|
+
dcopy_(n, &x[1], &c__1, &z__[1], &c__1);
|
713
699
|
wrk = updatd;
|
714
700
|
nseg = 0;
|
715
701
|
goto L333;
|
@@ -718,10 +704,9 @@ L222:
|
|
718
704
|
* Compute the Generalized Cauchy Point (GCP).
|
719
705
|
*/
|
720
706
|
timer_(&cpu1);
|
721
|
-
cauchy_(n, &x[1], &l[1], &u[1], &nbd[1], &g[1], &indx2[1], &iwhere[1], &t[1],
|
722
|
-
|
723
|
-
|
724
|
-
&wa[(*m << 2) + 1], &wa[*m * 6 + 1], &nseg, iprint, &sbgnrm, &info, &epsmch);
|
707
|
+
cauchy_(n, &x[1], &l[1], &u[1], &nbd[1], &g[1], &indx2[1], &iwhere[1], &t[1], &d__[1], &z__[1], m, &wy[wy_offset],
|
708
|
+
&ws[ws_offset], &sy[sy_offset], &wt[wt_offset], &theta, &col, &head, &wa[1], &wa[(*m << 1) + 1], &wa[(*m << 2) + 1],
|
709
|
+
&wa[*m * 6 + 1], &nseg, iprint, &sbgnrm, &info, &epsmch);
|
725
710
|
if (info != 0) {
|
726
711
|
/* singular triangular system detected; refresh the lbfgs memory. */
|
727
712
|
if (*iprint >= 1) {
|
@@ -762,9 +747,8 @@ L333:
|
|
762
747
|
/* where E = [-I 0] */
|
763
748
|
/* [ 0 I] */
|
764
749
|
if (wrk) {
|
765
|
-
formk_(n, &nfree, &index[1], &nenter, &ileave, &indx2[1], &iupdat, &updatd,
|
766
|
-
|
767
|
-
&sy[sy_offset], &theta, &col, &head, &info);
|
750
|
+
formk_(n, &nfree, &index[1], &nenter, &ileave, &indx2[1], &iupdat, &updatd, &wn[wn_offset], &snd[snd_offset], m,
|
751
|
+
&ws[ws_offset], &wy[wy_offset], &sy[sy_offset], &theta, &col, &head, &info);
|
768
752
|
}
|
769
753
|
if (info != 0) {
|
770
754
|
/* nonpositive definiteness in Cholesky factorization; */
|
@@ -786,16 +770,14 @@ L333:
|
|
786
770
|
}
|
787
771
|
/* compute r=-Z'B(xcp-xk)-Z'g (using wa(2m+1)=W'(xcp-x) */
|
788
772
|
/* from 'cauchy'). */
|
789
|
-
cmprlb_(n, m, &x[1], &g[1], &ws[ws_offset], &wy[wy_offset], &sy[sy_offset],
|
790
|
-
|
791
|
-
&head, &nfree, &cnstnd, &info);
|
773
|
+
cmprlb_(n, m, &x[1], &g[1], &ws[ws_offset], &wy[wy_offset], &sy[sy_offset], &wt[wt_offset], &z__[1], &r__[1], &wa[1],
|
774
|
+
&index[1], &theta, &col, &head, &nfree, &cnstnd, &info);
|
792
775
|
if (info != 0) {
|
793
776
|
goto L444;
|
794
777
|
}
|
795
778
|
/* jlm-jn call the direct method. */
|
796
|
-
subsm_(n, m, &nfree, &index[1], &l[1], &u[1], &nbd[1], &z__[1], &r__[1], &xp[1],
|
797
|
-
|
798
|
-
&head, &iword, &wa[1], &wn[wn_offset], iprint, &info);
|
779
|
+
subsm_(n, m, &nfree, &index[1], &l[1], &u[1], &nbd[1], &z__[1], &r__[1], &xp[1], &ws[ws_offset], &wy[wy_offset], &theta,
|
780
|
+
&x[1], &g[1], &col, &head, &iword, &wa[1], &wn[wn_offset], iprint, &info);
|
799
781
|
L444:
|
800
782
|
if (info != 0) {
|
801
783
|
/* singular triangular system detected; */
|
@@ -828,14 +810,12 @@ L555:
|
|
828
810
|
}
|
829
811
|
timer_(&cpu1);
|
830
812
|
L666:
|
831
|
-
lnsrlb_(n, &l[1], &u[1], &nbd[1], &x[1], f, &fold, &gd, &gdold, &g[1],
|
832
|
-
|
833
|
-
&stpmx, &iter, &ifun, &iback, &nfgv, &info, task, &boxed, &cnstnd,
|
834
|
-
csave, &isave[22], &dsave[17]);
|
813
|
+
lnsrlb_(n, &l[1], &u[1], &nbd[1], &x[1], f, &fold, &gd, &gdold, &g[1], &d__[1], &r__[1], &t[1], &z__[1], &stp, &dnorm, &dtd,
|
814
|
+
&xstep, &stpmx, &iter, &ifun, &iback, &nfgv, &info, task, &boxed, &cnstnd, csave, &isave[22], &dsave[17]);
|
835
815
|
if (info != 0 || iback >= 20) {
|
836
816
|
/* restore the previous iterate. */
|
837
|
-
|
838
|
-
|
817
|
+
dcopy_(n, &t[1], &c__1, &x[1], &c__1);
|
818
|
+
dcopy_(n, &r__[1], &c__1, &g[1], &c__1);
|
839
819
|
*f = fold;
|
840
820
|
if (col == 0) {
|
841
821
|
/* abnormal termination. */
|
@@ -881,8 +861,7 @@ L666:
|
|
881
861
|
/* Compute the infinity norm of the projected (-)gradient. */
|
882
862
|
projgr_(n, &l[1], &u[1], &nbd[1], &x[1], &g[1], &sbgnrm);
|
883
863
|
/* Print iteration information. */
|
884
|
-
prn2lb_(n, &x[1], f, &g[1], iprint, &itfile, &iter, &nfgv, &nact,
|
885
|
-
&sbgnrm, &nseg, word, &iword, &iback, &stp, &xstep);
|
864
|
+
prn2lb_(n, &x[1], f, &g[1], iprint, &itfile, &iter, &nfgv, &nact, &sbgnrm, &nseg, word, &iword, &iback, &stp, &xstep);
|
886
865
|
goto L1000;
|
887
866
|
}
|
888
867
|
L777:
|
@@ -910,13 +889,13 @@ L777:
|
|
910
889
|
for (i__ = 1; i__ <= i__1; ++i__) {
|
911
890
|
r__[i__] = g[i__] - r__[i__];
|
912
891
|
}
|
913
|
-
rr =
|
892
|
+
rr = ddot_(n, &r__[1], &c__1, &r__[1], &c__1);
|
914
893
|
if (stp == 1.) {
|
915
894
|
dr = gd - gdold;
|
916
895
|
ddum = -gdold;
|
917
896
|
} else {
|
918
897
|
dr = (gd - gdold) * stp;
|
919
|
-
|
898
|
+
dscal_(n, &stp, &d__[1], &c__1);
|
920
899
|
ddum = -gdold * stp;
|
921
900
|
}
|
922
901
|
if (dr <= epsmch * ddum) {
|
@@ -934,9 +913,8 @@ L777:
|
|
934
913
|
updatd = TRUE_;
|
935
914
|
++iupdat;
|
936
915
|
/* Update matrices WS and WY and form the middle matrix in B. */
|
937
|
-
matupd_(n, m, &ws[ws_offset], &wy[wy_offset], &sy[sy_offset],
|
938
|
-
|
939
|
-
&theta, &rr, &dr, &stp, &dtd);
|
916
|
+
matupd_(n, m, &ws[ws_offset], &wy[wy_offset], &sy[sy_offset], &ss[ss_offset], &d__[1], &r__[1], &itail, &iupdat, &col, &head,
|
917
|
+
&theta, &rr, &dr, &stp, &dtd);
|
940
918
|
/* Form the upper half of the pds T = theta*SS + L*D^(-1)*L'; */
|
941
919
|
/* Store T in the upper triangular of the array wt; */
|
942
920
|
/* Cholesky factorize T to J*J' with */
|
@@ -967,9 +945,8 @@ L888:
|
|
967
945
|
L999:
|
968
946
|
timer_(&time2);
|
969
947
|
time = time2 - time1;
|
970
|
-
prn3lb_(n, &x[1], f, task, iprint, &info, &itfile, &iter, &nfgv, &nintol,
|
971
|
-
|
972
|
-
&k, &cachyt, &sbtime, &lnscht);
|
948
|
+
prn3lb_(n, &x[1], f, task, iprint, &info, &itfile, &iter, &nfgv, &nintol, &nskip, &nact, &sbgnrm, &time, &nseg, word, &iback,
|
949
|
+
&stp, &xstep, &k, &cachyt, &sbtime, &lnscht);
|
973
950
|
L1000:
|
974
951
|
/* Save local variables. */
|
975
952
|
lsave[1] = prjctd;
|
@@ -1010,7 +987,6 @@ L1000:
|
|
1010
987
|
dsave[14] = stp;
|
1011
988
|
dsave[15] = gdold;
|
1012
989
|
dsave[16] = dtd;
|
1013
|
-
return 0;
|
1014
990
|
}
|
1015
991
|
|
1016
992
|
/**
|
@@ -1019,7 +995,7 @@ L1000:
|
|
1019
995
|
* This subroutine initializes iwhere and projects the initial x to
|
1020
996
|
* the feasible set if necessary.
|
1021
997
|
*
|
1022
|
-
* iwhere is an
|
998
|
+
* iwhere is an integer array of dimension n.
|
1023
999
|
* On entry iwhere is unspecified.
|
1024
1000
|
* On exit iwhere(i)=-1 if x(i) has no bounds
|
1025
1001
|
* 3 if l(i)=u(i)
|
@@ -1035,12 +1011,10 @@ L1000:
|
|
1035
1011
|
* Ciyou Zhu
|
1036
1012
|
* in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
|
1037
1013
|
*/
|
1038
|
-
|
1039
|
-
|
1040
|
-
|
1041
|
-
|
1042
|
-
long i__1;
|
1043
|
-
static long i__, nbdd;
|
1014
|
+
void active_(F77_int* n, double* l, double* u, F77_int* nbd, double* x, F77_int* iwhere, F77_int* iprint, F77_int* prjctd, F77_int* cnstnd,
|
1015
|
+
F77_int* boxed) {
|
1016
|
+
F77_int i__1;
|
1017
|
+
static F77_int i__, nbdd;
|
1044
1018
|
--iwhere;
|
1045
1019
|
--x;
|
1046
1020
|
--nbd;
|
@@ -1080,7 +1054,7 @@ int active_(long *n, double *l, double *u,
|
|
1080
1054
|
if (nbd[i__] == 0) {
|
1081
1055
|
/* this variable is always free */
|
1082
1056
|
iwhere[i__] = -1;
|
1083
|
-
|
1057
|
+
/* otherwise set x(i)=mid(x(i), u(i), l(i)). */
|
1084
1058
|
} else {
|
1085
1059
|
*cnstnd = TRUE_;
|
1086
1060
|
if (nbd[i__] == 2 && u[i__] - l[i__] <= 0.) {
|
@@ -1095,15 +1069,14 @@ int active_(long *n, double *l, double *u,
|
|
1095
1069
|
if (*prjctd) {
|
1096
1070
|
fprintf(stdout, " The initial X is infeasible. Restart with its projection.\n");
|
1097
1071
|
}
|
1098
|
-
if (!
|
1072
|
+
if (!(*cnstnd)) {
|
1099
1073
|
fprintf(stdout, " This problem is unconstrained.\n");
|
1100
1074
|
}
|
1101
1075
|
}
|
1102
1076
|
if (*iprint > 0) {
|
1103
1077
|
fprintf(stdout, "\n");
|
1104
|
-
fprintf(stdout, "At X0 %
|
1078
|
+
fprintf(stdout, "At X0 %9" PRIdF77INT " variables are exactly at the bounds\n", nbdd);
|
1105
1079
|
}
|
1106
|
-
return 0;
|
1107
1080
|
}
|
1108
1081
|
|
1109
1082
|
/**
|
@@ -1113,7 +1086,7 @@ int active_(long *n, double *l, double *u,
|
|
1113
1086
|
* in the compact L-BFGS formula of B and a 2m vector v;
|
1114
1087
|
* it returns the product in p.
|
1115
1088
|
*
|
1116
|
-
* m is an
|
1089
|
+
* m is an integer variable.
|
1117
1090
|
* On entry m is the maximum number of variable metric corrections
|
1118
1091
|
* used to define the limited memory matrix.
|
1119
1092
|
* On exit m is unchanged.
|
@@ -1127,7 +1100,7 @@ int active_(long *n, double *l, double *u,
|
|
1127
1100
|
* the Cholesky factor of (thetaS'S+LD^(-1)L').
|
1128
1101
|
* On exit wt is unchanged.
|
1129
1102
|
*
|
1130
|
-
* col is an
|
1103
|
+
* col is an integer variable.
|
1131
1104
|
* On entry col specifies the number of s-vectors (or y-vectors)
|
1132
1105
|
* stored in the compact L-BFGS formula.
|
1133
1106
|
* On exit col is unchanged.
|
@@ -1140,7 +1113,7 @@ int active_(long *n, double *l, double *u,
|
|
1140
1113
|
* On entry p is unspecified.
|
1141
1114
|
* On exit p is the product Mv.
|
1142
1115
|
*
|
1143
|
-
* info is an
|
1116
|
+
* info is an integer variable.
|
1144
1117
|
* On entry info is unspecified.
|
1145
1118
|
* On exit info = 0 for normal return,
|
1146
1119
|
* = nonzero for abnormal return when the system
|
@@ -1159,11 +1132,9 @@ int active_(long *n, double *l, double *u,
|
|
1159
1132
|
* Ciyou Zhu
|
1160
1133
|
* in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
|
1161
1134
|
*/
|
1162
|
-
|
1163
|
-
|
1164
|
-
|
1165
|
-
long sy_dim1, sy_offset, wt_dim1, wt_offset, i__1, i__2;
|
1166
|
-
static long i__, k, i2;
|
1135
|
+
void bmv_(F77_int* m, double* sy, double* wt, F77_int* col, double* v, double* p, F77_int* info) {
|
1136
|
+
F77_int sy_dim1, sy_offset, wt_dim1, wt_offset, i__1, i__2;
|
1137
|
+
static F77_int i__, k, i2;
|
1167
1138
|
static double sum;
|
1168
1139
|
|
1169
1140
|
wt_dim1 = *m;
|
@@ -1176,7 +1147,7 @@ int bmv_(long *m, double *sy, double *wt, long
|
|
1176
1147
|
--v;
|
1177
1148
|
|
1178
1149
|
if (*col == 0) {
|
1179
|
-
return
|
1150
|
+
return;
|
1180
1151
|
}
|
1181
1152
|
/* PART I: solve [ D^(1/2) O ] [ p1 ] = [ v1 ] */
|
1182
1153
|
/* [ -L*D^(-1/2) J ] [ p2 ] [ v2 ]. */
|
@@ -1193,9 +1164,9 @@ int bmv_(long *m, double *sy, double *wt, long
|
|
1193
1164
|
p[i2] = v[i2] + sum;
|
1194
1165
|
}
|
1195
1166
|
/* Solve the triangular system */
|
1196
|
-
|
1167
|
+
dtrsl_(&wt[wt_offset], m, col, &p[*col + 1], &c__11, info);
|
1197
1168
|
if (*info != 0) {
|
1198
|
-
return
|
1169
|
+
return;
|
1199
1170
|
}
|
1200
1171
|
/* solve D^(1/2)p1=v1. */
|
1201
1172
|
i__1 = *col;
|
@@ -1205,9 +1176,9 @@ int bmv_(long *m, double *sy, double *wt, long
|
|
1205
1176
|
/* PART II: solve [ -D^(1/2) D^(-1/2)*L' ] [ p1 ] = [ p1 ] */
|
1206
1177
|
/* [ 0 J' ] [ p2 ] [ p2 ]. */
|
1207
1178
|
/* solve J^Tp2=p2. */
|
1208
|
-
|
1179
|
+
dtrsl_(&wt[wt_offset], m, col, &p[*col + 1], &c__1, info);
|
1209
1180
|
if (*info != 0) {
|
1210
|
-
return
|
1181
|
+
return;
|
1211
1182
|
}
|
1212
1183
|
/* compute p1=-D^(-1/2)(p1-D^(-1/2)L'p2) */
|
1213
1184
|
/* =-D^(-1/2)p1+D^(-1)L'p2. */
|
@@ -1224,7 +1195,6 @@ int bmv_(long *m, double *sy, double *wt, long
|
|
1224
1195
|
}
|
1225
1196
|
p[i__] += sum;
|
1226
1197
|
}
|
1227
|
-
return 0;
|
1228
1198
|
}
|
1229
1199
|
|
1230
1200
|
/**
|
@@ -1238,10 +1208,10 @@ int bmv_(long *m, double *sy, double *wt, long
|
|
1238
1208
|
*
|
1239
1209
|
* Q(x + s) = g's + 1/2 s'Bs
|
1240
1210
|
*
|
1241
|
-
*
|
1211
|
+
* aF77_int the projected gradient direction P(x-tg,l,u).
|
1242
1212
|
* The routine returns the GCP in xcp.
|
1243
1213
|
*
|
1244
|
-
* n is an
|
1214
|
+
* n is an integer variable.
|
1245
1215
|
* On entry n is the dimension of the problem.
|
1246
1216
|
* On exit n is unchanged.
|
1247
1217
|
*
|
@@ -1257,7 +1227,7 @@ int bmv_(long *m, double *sy, double *wt, long
|
|
1257
1227
|
* On entry u is the upper bound of x.
|
1258
1228
|
* On exit u is unchanged.
|
1259
1229
|
*
|
1260
|
-
* nbd is an
|
1230
|
+
* nbd is an integer array of dimension n.
|
1261
1231
|
* On entry nbd represents the type of bounds imposed on the
|
1262
1232
|
* variables, and must be specified as follows:
|
1263
1233
|
* nbd(i)=0 if x(i) is unbounded,
|
@@ -1270,7 +1240,7 @@ int bmv_(long *m, double *sy, double *wt, long
|
|
1270
1240
|
* On entry g is the gradient of f(x). g must be a nonzero vector.
|
1271
1241
|
* On exit g is unchanged.
|
1272
1242
|
*
|
1273
|
-
* iorder is an
|
1243
|
+
* iorder is an integer working array of dimension n.
|
1274
1244
|
* iorder will be used to store the breakpoints in the piecewise
|
1275
1245
|
* linear path and free variables encountered. On exit,
|
1276
1246
|
* iorder(1),...,iorder(nleft) are indices of breakpoints
|
@@ -1278,9 +1248,9 @@ int bmv_(long *m, double *sy, double *wt, long
|
|
1278
1248
|
* iorder(nleft+1),...,iorder(nbreak) are indices of
|
1279
1249
|
* encountered breakpoints; and
|
1280
1250
|
* iorder(nfree),...,iorder(n) are indices of variables which
|
1281
|
-
* have no bound constraits
|
1251
|
+
* have no bound constraits aF77_int the search direction.
|
1282
1252
|
*
|
1283
|
-
* iwhere is an
|
1253
|
+
* iwhere is an integer array of dimension n.
|
1284
1254
|
* On entry iwhere indicates only the permanently fixed (iwhere=3)
|
1285
1255
|
* or free (iwhere= -1) components of x.
|
1286
1256
|
* On exit iwhere records the status of the current x variables.
|
@@ -1300,7 +1270,7 @@ int bmv_(long *m, double *sy, double *wt, long
|
|
1300
1270
|
* xcp is a double precision array of dimension n used to return the
|
1301
1271
|
* GCP on exit.
|
1302
1272
|
*
|
1303
|
-
* m is an
|
1273
|
+
* m is an integer variable.
|
1304
1274
|
* On entry m is the maximum number of variable metric corrections
|
1305
1275
|
* used to define the limited memory matrix.
|
1306
1276
|
* On exit m is unchanged.
|
@@ -1319,12 +1289,12 @@ int bmv_(long *m, double *sy, double *wt, long
|
|
1319
1289
|
* On entry theta is the scaling factor specifying B_0 = theta I.
|
1320
1290
|
* On exit theta is unchanged.
|
1321
1291
|
*
|
1322
|
-
* col is an
|
1292
|
+
* col is an integer variable.
|
1323
1293
|
* On entry col is the actual number of variable metric
|
1324
1294
|
* corrections stored so far.
|
1325
1295
|
* On exit col is unchanged.
|
1326
1296
|
*
|
1327
|
-
* head is an
|
1297
|
+
* head is an integer variable.
|
1328
1298
|
* On entry head is the location of the first s-vector (or y-vector)
|
1329
1299
|
* in S (or Y).
|
1330
1300
|
* On exit col is unchanged.
|
@@ -1341,7 +1311,7 @@ int bmv_(long *m, double *sy, double *wt, long
|
|
1341
1311
|
*
|
1342
1312
|
* v is a double precision working array of dimension 2m.
|
1343
1313
|
*
|
1344
|
-
* nseg is an
|
1314
|
+
* nseg is an integer variable.
|
1345
1315
|
* On exit nseg records the number of quadratic segments explored
|
1346
1316
|
* in searching for the GCP.
|
1347
1317
|
*
|
@@ -1349,7 +1319,7 @@ int bmv_(long *m, double *sy, double *wt, long
|
|
1349
1319
|
* On entry sg and yg store S'g and Y'g correspondingly.
|
1350
1320
|
* On exit they are unchanged.
|
1351
1321
|
*
|
1352
|
-
* iprint is an
|
1322
|
+
* iprint is an integer variable that must be set by the user.
|
1353
1323
|
* It controls the frequency and type of output generated:
|
1354
1324
|
* iprint<0 no output is generated;
|
1355
1325
|
* iprint=0 print only one line at the last iteration;
|
@@ -1364,7 +1334,7 @@ int bmv_(long *m, double *sy, double *wt, long
|
|
1364
1334
|
* On entry sbgnrm is the norm of the projected gradient at x.
|
1365
1335
|
* On exit sbgnrm is unchanged.
|
1366
1336
|
*
|
1367
|
-
* info is an
|
1337
|
+
* info is an integer variable.
|
1368
1338
|
* On entry info is 0.
|
1369
1339
|
* On exit info = 0 for normal return,
|
1370
1340
|
* = nonzero for abnormal return when the the system
|
@@ -1400,34 +1370,30 @@ int bmv_(long *m, double *sy, double *wt, long
|
|
1400
1370
|
* Ciyou Zhu
|
1401
1371
|
* in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
|
1402
1372
|
*/
|
1403
|
-
|
1404
|
-
|
1405
|
-
|
1406
|
-
|
1407
|
-
|
1408
|
-
double *c__, double *wbp, double *v, long *nseg,
|
1409
|
-
long *iprint, double *sbgnrm, long *info, double *epsmch)
|
1410
|
-
{
|
1411
|
-
long wy_dim1, wy_offset, ws_dim1, ws_offset, sy_dim1, sy_offset, wt_dim1, wt_offset, i__1, i__2;
|
1373
|
+
void cauchy_(F77_int* n, double* x, double* l, double* u, F77_int* nbd, double* g, F77_int* iorder, F77_int* iwhere, double* t, double* d__,
|
1374
|
+
double* xcp, F77_int* m, double* wy, double* ws, double* sy, double* wt, double* theta, F77_int* col, F77_int* head,
|
1375
|
+
double* p, double* c__, double* wbp, double* v, F77_int* nseg, F77_int* iprint, double* sbgnrm, F77_int* info,
|
1376
|
+
double* epsmch) {
|
1377
|
+
F77_int wy_dim1, wy_offset, ws_dim1, ws_offset, sy_dim1, sy_offset, wt_dim1, wt_offset, i__1, i__2;
|
1412
1378
|
double d__1;
|
1413
|
-
static
|
1379
|
+
static F77_int i__, j;
|
1414
1380
|
static double f1, f2, dt, tj, tl, tu, tj0;
|
1415
|
-
static
|
1381
|
+
static F77_int ibp;
|
1416
1382
|
static double dtm;
|
1417
1383
|
static double wmc, wmp, wmw;
|
1418
|
-
static
|
1384
|
+
static F77_int col2;
|
1419
1385
|
static double dibp;
|
1420
|
-
static
|
1386
|
+
static F77_int iter;
|
1421
1387
|
static double zibp, tsum, dibp2;
|
1422
|
-
static
|
1388
|
+
static F77_int bnded;
|
1423
1389
|
static double neggi;
|
1424
|
-
static
|
1390
|
+
static F77_int nfree;
|
1425
1391
|
static double bkmin;
|
1426
|
-
static
|
1392
|
+
static F77_int nleft;
|
1427
1393
|
static double f2_org__;
|
1428
|
-
static
|
1429
|
-
static
|
1430
|
-
static
|
1394
|
+
static F77_int nbreak, ibkmin;
|
1395
|
+
static F77_int pointr;
|
1396
|
+
static F77_int xlower, xupper;
|
1431
1397
|
|
1432
1398
|
--xcp;
|
1433
1399
|
--d__;
|
@@ -1463,8 +1429,8 @@ int cauchy_(long *n, double *x, double *l,
|
|
1463
1429
|
if (*iprint >= 0) {
|
1464
1430
|
fprintf(stdout, " Subgnorm = 0. GCP = X.\n");
|
1465
1431
|
}
|
1466
|
-
|
1467
|
-
return
|
1432
|
+
dcopy_(n, &x[1], &c__1, &xcp[1], &c__1);
|
1433
|
+
return;
|
1468
1434
|
}
|
1469
1435
|
bnded = TRUE_;
|
1470
1436
|
nfree = *n + 1;
|
@@ -1562,10 +1528,10 @@ int cauchy_(long *n, double *x, double *l,
|
|
1562
1528
|
/* The smallest of the nbreak breakpoints is in t(ibkmin)=bkmin. */
|
1563
1529
|
if (*theta != 1.) {
|
1564
1530
|
/* complete the initialization of p for theta not= one. */
|
1565
|
-
|
1531
|
+
dscal_(col, theta, &p[*col + 1], &c__1);
|
1566
1532
|
}
|
1567
1533
|
/* Initialize GCP xcp = x. */
|
1568
|
-
|
1534
|
+
dcopy_(n, &x[1], &c__1, &xcp[1], &c__1);
|
1569
1535
|
if (nbreak == 0 && nfree == *n + 1) {
|
1570
1536
|
/* is a zero vector, return with the initial xcp as GCP. */
|
1571
1537
|
if (*iprint > 100) {
|
@@ -1581,7 +1547,7 @@ int cauchy_(long *n, double *x, double *l,
|
|
1581
1547
|
}
|
1582
1548
|
fprintf(stdout, "\n");
|
1583
1549
|
}
|
1584
|
-
return
|
1550
|
+
return;
|
1585
1551
|
}
|
1586
1552
|
/* Initialize c = W'(xcp - x) = 0. */
|
1587
1553
|
i__1 = col2;
|
@@ -1594,15 +1560,15 @@ int cauchy_(long *n, double *x, double *l,
|
|
1594
1560
|
if (*col > 0) {
|
1595
1561
|
bmv_(m, &sy[sy_offset], &wt[wt_offset], col, &p[1], &v[1], info);
|
1596
1562
|
if (*info != 0) {
|
1597
|
-
return
|
1563
|
+
return;
|
1598
1564
|
}
|
1599
|
-
f2 -=
|
1565
|
+
f2 -= ddot_(&col2, &v[1], &c__1, &p[1], &c__1);
|
1600
1566
|
}
|
1601
1567
|
dtm = -f1 / f2;
|
1602
1568
|
tsum = 0.;
|
1603
1569
|
*nseg = 1;
|
1604
1570
|
if (*iprint >= 99) {
|
1605
|
-
fprintf(stdout, " There are %
|
1571
|
+
fprintf(stdout, " There are %3" PRIdF77INT " breakpoints \n", nbreak);
|
1606
1572
|
}
|
1607
1573
|
/* If there are no breakpoints, locate the GCP and return. */
|
1608
1574
|
if (nbreak == 0) {
|
@@ -1641,7 +1607,7 @@ L777:
|
|
1641
1607
|
dt = tj - tj0;
|
1642
1608
|
if (dt != 0. && *iprint >= 100) {
|
1643
1609
|
fprintf(stdout, "\n");
|
1644
|
-
fprintf(stdout, "Piece %
|
1610
|
+
fprintf(stdout, "Piece %3" PRIdF77INT " --f1, f2 at start point %11.4E %11.4E\n", *nseg, f1, f2);
|
1645
1611
|
fprintf(stdout, "Distance to the next break point = %11.4E\n", dt);
|
1646
1612
|
fprintf(stdout, "Distance to the stationary point = %11.4E\n", dtm);
|
1647
1613
|
}
|
@@ -1666,7 +1632,7 @@ L777:
|
|
1666
1632
|
iwhere[ibp] = 1;
|
1667
1633
|
}
|
1668
1634
|
if (*iprint >= 100) {
|
1669
|
-
fprintf(stdout, " Variable %
|
1635
|
+
fprintf(stdout, " Variable %" PRIdF77INT " is fixed.\n", ibp);
|
1670
1636
|
}
|
1671
1637
|
if (nleft == 0 && nbreak == *n) {
|
1672
1638
|
/* all n variables are fixed, */
|
@@ -1685,7 +1651,7 @@ L777:
|
|
1685
1651
|
f2 -= *theta * dibp2;
|
1686
1652
|
if (*col > 0) {
|
1687
1653
|
/* update c = c + dt*p. */
|
1688
|
-
|
1654
|
+
daxpy_(&col2, &dt, &p[1], &c__1, &c__[1], &c__1);
|
1689
1655
|
/* choose wbp, */
|
1690
1656
|
/* the row of W corresponding to the breakpoint encountered. */
|
1691
1657
|
pointr = *head;
|
@@ -1698,14 +1664,14 @@ L777:
|
|
1698
1664
|
/* compute (wbp)Mc, (wbp)Mp, and (wbp)M(wbp)'. */
|
1699
1665
|
bmv_(m, &sy[sy_offset], &wt[wt_offset], col, &wbp[1], &v[1], info);
|
1700
1666
|
if (*info != 0) {
|
1701
|
-
return
|
1667
|
+
return;
|
1702
1668
|
}
|
1703
|
-
wmc =
|
1704
|
-
wmp =
|
1705
|
-
wmw =
|
1669
|
+
wmc = ddot_(&col2, &c__[1], &c__1, &v[1], &c__1);
|
1670
|
+
wmp = ddot_(&col2, &p[1], &c__1, &v[1], &c__1);
|
1671
|
+
wmw = ddot_(&col2, &wbp[1], &c__1, &v[1], &c__1);
|
1706
1672
|
/* update p = p - dibp*wbp. */
|
1707
1673
|
d__1 = -dibp;
|
1708
|
-
|
1674
|
+
daxpy_(&col2, &d__1, &wbp[1], &c__1, &p[1], &c__1);
|
1709
1675
|
/* complete updating f1 and f2 while col > 0. */
|
1710
1676
|
f1 += dibp * wmc;
|
1711
1677
|
f2 = f2 + dibp * 2. * wmp - dibp2 * wmw;
|
@@ -1728,7 +1694,7 @@ L888:
|
|
1728
1694
|
if (*iprint >= 99) {
|
1729
1695
|
fprintf(stdout, "\n");
|
1730
1696
|
fprintf(stdout, " GCP found in this segment\n");
|
1731
|
-
fprintf(stdout, "Piece %
|
1697
|
+
fprintf(stdout, "Piece %3" PRIdF77INT " --f1, f2 at start point %11.4E %11.4E\n", *nseg, f1, f2);
|
1732
1698
|
fprintf(stdout, "Distance to the stationary point = %11.4E\n", dtm);
|
1733
1699
|
}
|
1734
1700
|
if (dtm <= 0.) {
|
@@ -1737,12 +1703,12 @@ L888:
|
|
1737
1703
|
tsum += dtm;
|
1738
1704
|
/* Move free variables (i.e., the ones w/o breakpoints) and */
|
1739
1705
|
/* the variables whose breakpoints haven't been reached. */
|
1740
|
-
|
1706
|
+
daxpy_(n, &tsum, &d__[1], &c__1, &xcp[1], &c__1);
|
1741
1707
|
L999:
|
1742
1708
|
/* Update c = c + dtm*p = W'(x^c - x) */
|
1743
1709
|
/* which will be used in computing r = Z'(B(x^c - x) + g). */
|
1744
1710
|
if (*col > 0) {
|
1745
|
-
|
1711
|
+
daxpy_(&col2, &dtm, &p[1], &c__1, &c__[1], &c__1);
|
1746
1712
|
}
|
1747
1713
|
if (*iprint > 100) {
|
1748
1714
|
fprintf(stdout, "Cauchy X = \n");
|
@@ -1760,7 +1726,6 @@ L999:
|
|
1760
1726
|
if (*iprint >= 99) {
|
1761
1727
|
fprintf(stdout, "\n---------------- exit CAUCHY----------------------\n\n");
|
1762
1728
|
}
|
1763
|
-
return 0;
|
1764
1729
|
}
|
1765
1730
|
|
1766
1731
|
/**
|
@@ -1782,16 +1747,12 @@ L999:
|
|
1782
1747
|
* Ciyou Zhu
|
1783
1748
|
* in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
|
1784
1749
|
*/
|
1785
|
-
|
1786
|
-
|
1787
|
-
|
1788
|
-
|
1789
|
-
long *nfree, long *cnstnd, long *info)
|
1790
|
-
{
|
1791
|
-
long ws_dim1, ws_offset, wy_dim1, wy_offset, sy_dim1, sy_offset, wt_dim1, wt_offset, i__1, i__2;
|
1792
|
-
static long i__, j, k;
|
1750
|
+
void cmprlb_(F77_int* n, F77_int* m, double* x, double* g, double* ws, double* wy, double* sy, double* wt, double* z__, double* r__,
|
1751
|
+
double* wa, F77_int* index, double* theta, F77_int* col, F77_int* head, F77_int* nfree, F77_int* cnstnd, F77_int* info) {
|
1752
|
+
F77_int ws_dim1, ws_offset, wy_dim1, wy_offset, sy_dim1, sy_offset, wt_dim1, wt_offset, i__1, i__2;
|
1753
|
+
static F77_int i__, j, k;
|
1793
1754
|
static double a1, a2;
|
1794
|
-
static
|
1755
|
+
static F77_int pointr;
|
1795
1756
|
|
1796
1757
|
--index;
|
1797
1758
|
--r__;
|
@@ -1812,7 +1773,7 @@ int cmprlb_(long *n, long *m, double *x,
|
|
1812
1773
|
ws_offset = 1 + ws_dim1;
|
1813
1774
|
ws -= ws_offset;
|
1814
1775
|
|
1815
|
-
if (!
|
1776
|
+
if (!(*cnstnd) && *col > 0) {
|
1816
1777
|
i__1 = *n;
|
1817
1778
|
for (i__ = 1; i__ <= i__1; ++i__) {
|
1818
1779
|
r__[i__] = -g[i__];
|
@@ -1826,7 +1787,7 @@ int cmprlb_(long *n, long *m, double *x,
|
|
1826
1787
|
bmv_(m, &sy[sy_offset], &wt[wt_offset], col, &wa[(*m << 1) + 1], &wa[1], info);
|
1827
1788
|
if (*info != 0) {
|
1828
1789
|
*info = -8;
|
1829
|
-
return
|
1790
|
+
return;
|
1830
1791
|
}
|
1831
1792
|
pointr = *head;
|
1832
1793
|
i__1 = *col;
|
@@ -1841,7 +1802,6 @@ int cmprlb_(long *n, long *m, double *x,
|
|
1841
1802
|
pointr = pointr % *m + 1;
|
1842
1803
|
}
|
1843
1804
|
}
|
1844
|
-
return 0;
|
1845
1805
|
}
|
1846
1806
|
|
1847
1807
|
/**
|
@@ -1858,11 +1818,9 @@ int cmprlb_(long *n, long *m, double *x,
|
|
1858
1818
|
* Ciyou Zhu
|
1859
1819
|
* in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
|
1860
1820
|
*/
|
1861
|
-
|
1862
|
-
|
1863
|
-
|
1864
|
-
long i__1;
|
1865
|
-
static long i__;
|
1821
|
+
void errclb_(F77_int* n, F77_int* m, double* factr, double* l, double* u, F77_int* nbd, char* task, F77_int* info, F77_int* k) {
|
1822
|
+
F77_int i__1;
|
1823
|
+
static F77_int i__;
|
1866
1824
|
--nbd;
|
1867
1825
|
--u;
|
1868
1826
|
--l;
|
@@ -1895,7 +1853,6 @@ int errclb_(long *n, long *m, double *factr,
|
|
1895
1853
|
}
|
1896
1854
|
}
|
1897
1855
|
}
|
1898
|
-
return 0;
|
1899
1856
|
}
|
1900
1857
|
|
1901
1858
|
/**
|
@@ -1911,35 +1868,35 @@ int errclb_(long *n, long *m, double *factr,
|
|
1911
1868
|
* occurring in section 5.1 of [1], as well as to the matrix
|
1912
1869
|
* Mbar^[-1] Nbar in section 5.3.
|
1913
1870
|
*
|
1914
|
-
* n is an
|
1871
|
+
* n is an integer variable.
|
1915
1872
|
* On entry n is the dimension of the problem.
|
1916
1873
|
* On exit n is unchanged.
|
1917
1874
|
*
|
1918
|
-
* nsub is an
|
1875
|
+
* nsub is an integer variable
|
1919
1876
|
* On entry nsub is the number of subspace variables in free set.
|
1920
1877
|
* On exit nsub is not changed.
|
1921
1878
|
*
|
1922
|
-
* ind is an
|
1879
|
+
* ind is an integer array of dimension nsub.
|
1923
1880
|
* On entry ind specifies the indices of subspace variables.
|
1924
1881
|
* On exit ind is unchanged.
|
1925
1882
|
*
|
1926
|
-
* nenter is an
|
1883
|
+
* nenter is an integer variable.
|
1927
1884
|
* On entry nenter is the number of variables entering the
|
1928
1885
|
* free set.
|
1929
1886
|
* On exit nenter is unchanged.
|
1930
1887
|
*
|
1931
|
-
* ileave is an
|
1888
|
+
* ileave is an integer variable.
|
1932
1889
|
* On entry indx2(ileave),...,indx2(n) are the variables leaving
|
1933
1890
|
* the free set.
|
1934
1891
|
* On exit ileave is unchanged.
|
1935
1892
|
*
|
1936
|
-
* indx2 is an
|
1893
|
+
* indx2 is an integer array of dimension n.
|
1937
1894
|
* On entry indx2(1),...,indx2(nenter) are the variables entering
|
1938
1895
|
* the free set, while indx2(ileave),...,indx2(n) are the
|
1939
1896
|
* variables leaving the free set.
|
1940
1897
|
* On exit indx2 is unchanged.
|
1941
1898
|
*
|
1942
|
-
* iupdat is an
|
1899
|
+
* iupdat is an integer variable.
|
1943
1900
|
* On entry iupdat is the total number of BFGS updates made so far.
|
1944
1901
|
* On exit iupdat is unchanged.
|
1945
1902
|
*
|
@@ -1963,15 +1920,15 @@ int errclb_(long *n, long *m, double *factr,
|
|
1963
1920
|
* The purpose of wn1 is just to store these inner products
|
1964
1921
|
* so they can be easily updated and inserted into wn.
|
1965
1922
|
*
|
1966
|
-
* m is an
|
1923
|
+
* m is an integer variable.
|
1967
1924
|
* On entry m is the maximum number of variable metric corrections
|
1968
1925
|
* used to define the limited memory matrix.
|
1969
1926
|
* On exit m is unchanged.
|
1970
1927
|
*
|
1971
1928
|
* ws, wy, sy, and wtyy are double precision arrays;
|
1972
1929
|
* theta is a double precision variable;
|
1973
|
-
* col is an
|
1974
|
-
* head is an
|
1930
|
+
* col is an integer variable;
|
1931
|
+
* head is an integer variable.
|
1975
1932
|
* On entry they store the information defining the
|
1976
1933
|
* limited memory BFGS matrix:
|
1977
1934
|
* ws(n,m) stores S, a set of s-vectors;
|
@@ -1984,7 +1941,7 @@ int errclb_(long *n, long *m, double *factr,
|
|
1984
1941
|
* head is the location of the 1st s- (or y-) vector in S (or Y).
|
1985
1942
|
* On exit they are unchanged.
|
1986
1943
|
*
|
1987
|
-
* info is an
|
1944
|
+
* info is an integer variable.
|
1988
1945
|
* On entry info is unspecified.
|
1989
1946
|
* On exit info = 0 for normal return;
|
1990
1947
|
* = -1 when the 1st Cholesky factorization failed;
|
@@ -2017,18 +1974,13 @@ int errclb_(long *n, long *m, double *factr,
|
|
2017
1974
|
* Ciyou Zhu
|
2018
1975
|
* in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
|
2019
1976
|
*/
|
2020
|
-
|
2021
|
-
|
2022
|
-
|
2023
|
-
|
2024
|
-
|
2025
|
-
{
|
2026
|
-
long wn_dim1, wn_offset, wn1_dim1, wn1_offset, ws_dim1, ws_offset,
|
2027
|
-
wy_dim1, wy_offset, sy_dim1, sy_offset, i__1, i__2, i__3;
|
2028
|
-
static long i__, k, k1, m2, is, js, iy, jy, is1, js1, col2, dend, pend;
|
2029
|
-
static long upcl;
|
1977
|
+
void formk_(F77_int* n, F77_int* nsub, F77_int* ind, F77_int* nenter, F77_int* ileave, F77_int* indx2, F77_int* iupdat, F77_int* updatd, double* wn,
|
1978
|
+
double* wn1, F77_int* m, double* ws, double* wy, double* sy, double* theta, F77_int* col, F77_int* head, F77_int* info) {
|
1979
|
+
F77_int wn_dim1, wn_offset, wn1_dim1, wn1_offset, ws_dim1, ws_offset, wy_dim1, wy_offset, sy_dim1, sy_offset, i__1, i__2, i__3;
|
1980
|
+
static F77_int i__, k, k1, m2, is, js, iy, jy, is1, js1, col2, dend, pend;
|
1981
|
+
static F77_int upcl;
|
2030
1982
|
static double temp1, temp2, temp3, temp4;
|
2031
|
-
static
|
1983
|
+
static F77_int ipntr, jpntr, dbegin, pbegin;
|
2032
1984
|
|
2033
1985
|
--indx2;
|
2034
1986
|
--ind;
|
@@ -2060,11 +2012,11 @@ int formk_(long *n, long *nsub, long *ind, long *nenter,
|
|
2060
2012
|
for (jy = 1; jy <= i__1; ++jy) {
|
2061
2013
|
js = *m + jy;
|
2062
2014
|
i__2 = *m - jy;
|
2063
|
-
|
2015
|
+
dcopy_(&i__2, &wn1[jy + 1 + (jy + 1) * wn1_dim1], &c__1, &wn1[jy + jy * wn1_dim1], &c__1);
|
2064
2016
|
i__2 = *m - jy;
|
2065
|
-
|
2017
|
+
dcopy_(&i__2, &wn1[js + 1 + (js + 1) * wn1_dim1], &c__1, &wn1[js + js * wn1_dim1], &c__1);
|
2066
2018
|
i__2 = *m - 1;
|
2067
|
-
|
2019
|
+
dcopy_(&i__2, &wn1[*m + 2 + (jy + 1) * wn1_dim1], &c__1, &wn1[*m + 1 + jy * wn1_dim1], &c__1);
|
2068
2020
|
}
|
2069
2021
|
}
|
2070
2022
|
/* put new rows in blocks (1,1), (2,1) and (2,2). */
|
@@ -2215,16 +2167,16 @@ int formk_(long *n, long *nsub, long *ind, long *nenter,
|
|
2215
2167
|
/* [(-L_a +R_z)L'^-1 S'AA'S*theta ] */
|
2216
2168
|
/* first Cholesky factor (1,1) block of wn to get LL' */
|
2217
2169
|
/* with L' stored in the upper triangle of wn. */
|
2218
|
-
|
2170
|
+
dpofa_(&wn[wn_offset], &m2, col, info);
|
2219
2171
|
if (*info != 0) {
|
2220
2172
|
*info = -1;
|
2221
|
-
return
|
2173
|
+
return;
|
2222
2174
|
}
|
2223
2175
|
/* then form L^-1(-L_a'+R_z') in the (1,2) block. */
|
2224
2176
|
col2 = *col << 1;
|
2225
2177
|
i__1 = col2;
|
2226
2178
|
for (js = *col + 1; js <= i__1; ++js) {
|
2227
|
-
|
2179
|
+
dtrsl_(&wn[wn_offset], &m2, col, &wn[js * wn_dim1 + 1], &c__11, info);
|
2228
2180
|
}
|
2229
2181
|
/* Form S'AA'S*theta + (L^-1(-L_a'+R_z'))'L^-1(-L_a'+R_z') in the */
|
2230
2182
|
/* upper triangle of (2,2) block of wn. */
|
@@ -2232,16 +2184,14 @@ int formk_(long *n, long *nsub, long *ind, long *nenter,
|
|
2232
2184
|
for (is = *col + 1; is <= i__1; ++is) {
|
2233
2185
|
i__2 = col2;
|
2234
2186
|
for (js = is; js <= i__2; ++js) {
|
2235
|
-
wn[is + js * wn_dim1] +=
|
2187
|
+
wn[is + js * wn_dim1] += ddot_(col, &wn[is * wn_dim1 + 1], &c__1, &wn[js * wn_dim1 + 1], &c__1);
|
2236
2188
|
}
|
2237
2189
|
}
|
2238
2190
|
/* Cholesky factorization of (2,2) block of wn. */
|
2239
|
-
|
2191
|
+
dpofa_(&wn[*col + 1 + (*col + 1) * wn_dim1], &m2, col, info);
|
2240
2192
|
if (*info != 0) {
|
2241
2193
|
*info = -2;
|
2242
|
-
return 0;
|
2243
2194
|
}
|
2244
|
-
return 0;
|
2245
2195
|
}
|
2246
2196
|
|
2247
2197
|
/**
|
@@ -2265,11 +2215,9 @@ int formk_(long *n, long *nsub, long *ind, long *nenter,
|
|
2265
2215
|
* Ciyou Zhu
|
2266
2216
|
* in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
|
2267
2217
|
*/
|
2268
|
-
|
2269
|
-
|
2270
|
-
|
2271
|
-
long wt_dim1, wt_offset, sy_dim1, sy_offset, ss_dim1, ss_offset, i__1, i__2, i__3;
|
2272
|
-
static long i__, j, k, k1;
|
2218
|
+
void formt_(F77_int* m, double* wt, double* sy, double* ss, F77_int* col, double* theta, F77_int* info) {
|
2219
|
+
F77_int wt_dim1, wt_offset, sy_dim1, sy_offset, ss_dim1, ss_offset, i__1, i__2, i__3;
|
2220
|
+
static F77_int i__, j, k, k1;
|
2273
2221
|
static double ddum;
|
2274
2222
|
|
2275
2223
|
ss_dim1 = *m;
|
@@ -2303,11 +2251,10 @@ int formt_(long *m, double *wt, double *sy,
|
|
2303
2251
|
}
|
2304
2252
|
/* Cholesky factorize T to J*J' with */
|
2305
2253
|
/* J' stored in the upper triangle of wt. */
|
2306
|
-
|
2254
|
+
dpofa_(&wt[wt_offset], m, col, info);
|
2307
2255
|
if (*info != 0) {
|
2308
2256
|
*info = -3;
|
2309
2257
|
}
|
2310
|
-
return 0;
|
2311
2258
|
}
|
2312
2259
|
|
2313
2260
|
/**
|
@@ -2319,7 +2266,7 @@ int formt_(long *m, double *wt, double *sy,
|
|
2319
2266
|
*
|
2320
2267
|
* cnstnd is a logical variable indicating whether bounds are present
|
2321
2268
|
*
|
2322
|
-
* index is an
|
2269
|
+
* index is an integer array of dimension n
|
2323
2270
|
* for i=1,...,nfree, index(i) are the indices of free variables
|
2324
2271
|
* for i=nfree+1,...,n, index(i) are the indices of bound variables
|
2325
2272
|
* On entry after the first iteration, index gives
|
@@ -2327,7 +2274,7 @@ int formt_(long *m, double *wt, double *sy,
|
|
2327
2274
|
* On exit it gives the free variables based on the determination
|
2328
2275
|
* in cauchy using the array iwhere.
|
2329
2276
|
*
|
2330
|
-
* indx2 is an
|
2277
|
+
* indx2 is an integer array of dimension n
|
2331
2278
|
* On entry indx2 is unspecified.
|
2332
2279
|
* On exit with iter>0, indx2 indicates which variables
|
2333
2280
|
* have changed status since the previous iteration.
|
@@ -2343,13 +2290,10 @@ int formt_(long *m, double *wt, double *sy,
|
|
2343
2290
|
* Ciyou Zhu
|
2344
2291
|
* in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
|
2345
2292
|
*/
|
2346
|
-
|
2347
|
-
|
2348
|
-
|
2349
|
-
|
2350
|
-
{
|
2351
|
-
long i__1;
|
2352
|
-
static long i__, k, iact;
|
2293
|
+
void freev_(F77_int* n, F77_int* nfree, F77_int* index, F77_int* nenter, F77_int* ileave, F77_int* indx2, F77_int* iwhere, F77_int* wrk, F77_int* updatd,
|
2294
|
+
F77_int* cnstnd, F77_int* iprint, F77_int* iter) {
|
2295
|
+
F77_int i__1;
|
2296
|
+
static F77_int i__, k, iact;
|
2353
2297
|
|
2354
2298
|
--iwhere;
|
2355
2299
|
--indx2;
|
@@ -2368,7 +2312,7 @@ int freev_(long *n, long *nfree, long *index,
|
|
2368
2312
|
--(*ileave);
|
2369
2313
|
indx2[*ileave] = k;
|
2370
2314
|
if (*iprint >= 100) {
|
2371
|
-
fprintf(stdout, " Variable %
|
2315
|
+
fprintf(stdout, " Variable %2" PRIdF77INT " leaves the set of free variables\n", k);
|
2372
2316
|
}
|
2373
2317
|
}
|
2374
2318
|
}
|
@@ -2379,13 +2323,13 @@ int freev_(long *n, long *nfree, long *index,
|
|
2379
2323
|
++(*nenter);
|
2380
2324
|
indx2[*nenter] = k;
|
2381
2325
|
if (*iprint >= 100) {
|
2382
|
-
fprintf(stdout, " Variable %
|
2326
|
+
fprintf(stdout, " Variable %2" PRIdF77INT " enters the set of free variables\n", k);
|
2383
2327
|
}
|
2384
2328
|
}
|
2385
2329
|
}
|
2386
2330
|
if (*iprint >= 99) {
|
2387
2331
|
i__1 = *n + 1 - *ileave;
|
2388
|
-
fprintf(stdout,
|
2332
|
+
fprintf(stdout, " %2" PRIdF77INT " variables leave; %2" PRIdF77INT " variables enter\n", i__1, *nenter);
|
2389
2333
|
}
|
2390
2334
|
}
|
2391
2335
|
*wrk = *ileave < *n + 1 || *nenter > 0 || *updatd;
|
@@ -2404,9 +2348,8 @@ int freev_(long *n, long *nfree, long *index,
|
|
2404
2348
|
}
|
2405
2349
|
if (*iprint >= 99) {
|
2406
2350
|
i__1 = *iter + 1;
|
2407
|
-
fprintf(stdout, " %
|
2351
|
+
fprintf(stdout, " %2" PRIdF77INT " variables are free at GCP %3" PRIdF77INT "\n", *nfree, i__1);
|
2408
2352
|
}
|
2409
|
-
return 0;
|
2410
2353
|
}
|
2411
2354
|
|
2412
2355
|
/**
|
@@ -2415,7 +2358,7 @@ int freev_(long *n, long *nfree, long *index,
|
|
2415
2358
|
* This subroutine sorts out the least element of t, and puts the
|
2416
2359
|
* remaining elements of t in a heap.
|
2417
2360
|
*
|
2418
|
-
* n is an
|
2361
|
+
* n is an integer variable.
|
2419
2362
|
* On entry n is the dimension of the arrays t and iorder.
|
2420
2363
|
* On exit n is unchanged.
|
2421
2364
|
*
|
@@ -2424,12 +2367,12 @@ int freev_(long *n, long *nfree, long *index,
|
|
2424
2367
|
* On exit t(n) stores the least elements of t, and t(1) to t(n-1)
|
2425
2368
|
* stores the remaining elements in the form of a heap.
|
2426
2369
|
*
|
2427
|
-
* iorder is an
|
2370
|
+
* iorder is an integer array of dimension n.
|
2428
2371
|
* On entry iorder(i) is the index of t(i).
|
2429
2372
|
* On exit iorder(i) is still the index of t(i), but iorder may be
|
2430
2373
|
* permuted in accordance with t.
|
2431
2374
|
*
|
2432
|
-
* iheap is an
|
2375
|
+
* iheap is an integer variable specifying the task.
|
2433
2376
|
* On entry iheap should be set as follows:
|
2434
2377
|
* iheap .eq. 0 if t(1) to t(n) is not in the form of a heap,
|
2435
2378
|
* iheap .ne. 0 if otherwise.
|
@@ -2448,12 +2391,11 @@ int freev_(long *n, long *nfree, long *index,
|
|
2448
2391
|
* Ciyou Zhu
|
2449
2392
|
* in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
|
2450
2393
|
*/
|
2451
|
-
|
2452
|
-
|
2453
|
-
|
2454
|
-
static long i__, j, k;
|
2394
|
+
void hpsolb_(F77_int* n, double* t, F77_int* iorder, F77_int* iheap) {
|
2395
|
+
F77_int i__1;
|
2396
|
+
static F77_int i__, j, k;
|
2455
2397
|
static double out, ddum;
|
2456
|
-
static
|
2398
|
+
static F77_int indxin, indxou;
|
2457
2399
|
|
2458
2400
|
--iorder;
|
2459
2401
|
--t;
|
@@ -2466,7 +2408,7 @@ int hpsolb_(long *n, double *t, long *iorder, long *iheap)
|
|
2466
2408
|
indxin = iorder[k];
|
2467
2409
|
/* Add ddum to the heap. */
|
2468
2410
|
i__ = k;
|
2469
|
-
L10:
|
2411
|
+
L10:
|
2470
2412
|
if (i__ > 1) {
|
2471
2413
|
j = i__ / 2;
|
2472
2414
|
if (ddum < t[j]) {
|
@@ -2490,7 +2432,7 @@ L10:
|
|
2490
2432
|
ddum = t[*n];
|
2491
2433
|
indxin = iorder[*n];
|
2492
2434
|
/* Restore the heap */
|
2493
|
-
L30:
|
2435
|
+
L30:
|
2494
2436
|
j = i__ + i__;
|
2495
2437
|
if (j <= *n - 1) {
|
2496
2438
|
if (t[j + 1] < t[j]) {
|
@@ -2509,7 +2451,6 @@ L30:
|
|
2509
2451
|
t[*n] = out;
|
2510
2452
|
iorder[*n] = indxou;
|
2511
2453
|
}
|
2512
|
-
return 0;
|
2513
2454
|
}
|
2514
2455
|
|
2515
2456
|
/**
|
@@ -2534,18 +2475,13 @@ L30:
|
|
2534
2475
|
* Ciyou Zhu
|
2535
2476
|
* in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
|
2536
2477
|
*/
|
2537
|
-
|
2538
|
-
|
2539
|
-
|
2540
|
-
|
2541
|
-
|
2542
|
-
long *iter, long *ifun, long *iback, long *nfgv,
|
2543
|
-
long *info, char *task, long *boxed, long *cnstnd,
|
2544
|
-
char *csave, long *isave, double *dsave)
|
2545
|
-
{
|
2546
|
-
long i__1;
|
2478
|
+
void lnsrlb_(F77_int* n, double* l, double* u, F77_int* nbd, double* x, double* f, double* fold, double* gd, double* gdold, double* g,
|
2479
|
+
double* d__, double* r__, double* t, double* z__, double* stp, double* dnorm, double* dtd, double* xstep,
|
2480
|
+
double* stpmx, F77_int* iter, F77_int* ifun, F77_int* iback, F77_int* nfgv, F77_int* info, char* task, F77_int* boxed, F77_int* cnstnd,
|
2481
|
+
char* csave, F77_int* isave, double* dsave) {
|
2482
|
+
F77_int i__1;
|
2547
2483
|
double d__1;
|
2548
|
-
static
|
2484
|
+
static F77_int i__;
|
2549
2485
|
static double a1, a2;
|
2550
2486
|
|
2551
2487
|
--z__;
|
@@ -2563,7 +2499,7 @@ int lnsrlb_(long *n, double *l, double *u,
|
|
2563
2499
|
if (strncmp(task, "FG_LN", 5) == 0) {
|
2564
2500
|
goto L556;
|
2565
2501
|
}
|
2566
|
-
*dtd =
|
2502
|
+
*dtd = ddot_(n, &d__[1], &c__1, &d__[1], &c__1);
|
2567
2503
|
*dnorm = sqrt(*dtd);
|
2568
2504
|
/* Determine the maximum step length. */
|
2569
2505
|
*stpmx = 1e10;
|
@@ -2594,20 +2530,20 @@ int lnsrlb_(long *n, double *l, double *u,
|
|
2594
2530
|
}
|
2595
2531
|
}
|
2596
2532
|
}
|
2597
|
-
if (*iter == 0 && !
|
2533
|
+
if (*iter == 0 && !(*boxed)) {
|
2598
2534
|
d__1 = 1. / *dnorm;
|
2599
2535
|
*stp = d__1 <= *stpmx ? d__1 : *stpmx;
|
2600
2536
|
} else {
|
2601
2537
|
*stp = 1.;
|
2602
2538
|
}
|
2603
|
-
|
2604
|
-
|
2539
|
+
dcopy_(n, &x[1], &c__1, &t[1], &c__1);
|
2540
|
+
dcopy_(n, &g[1], &c__1, &r__[1], &c__1);
|
2605
2541
|
*fold = *f;
|
2606
2542
|
*ifun = 0;
|
2607
2543
|
*iback = 0;
|
2608
2544
|
strcpy(csave, "START");
|
2609
2545
|
L556:
|
2610
|
-
*gd =
|
2546
|
+
*gd = ddot_(n, &g[1], &c__1, &d__[1], &c__1);
|
2611
2547
|
if (*ifun == 0) {
|
2612
2548
|
*gdold = *gd;
|
2613
2549
|
if (*gd >= 0.) {
|
@@ -2615,7 +2551,7 @@ L556:
|
|
2615
2551
|
/* Line search is impossible. */
|
2616
2552
|
fprintf(stdout, " ascent direction in projection gd = %.8E\n", *gd);
|
2617
2553
|
*info = -4;
|
2618
|
-
return
|
2554
|
+
return;
|
2619
2555
|
}
|
2620
2556
|
}
|
2621
2557
|
dcsrch_(f, gd, stp, &c_b280, &c_b281, &c_b282, &c_b9, stpmx, csave, &isave[1], &dsave[1]);
|
@@ -2626,7 +2562,7 @@ L556:
|
|
2626
2562
|
++(*nfgv);
|
2627
2563
|
*iback = *ifun - 1;
|
2628
2564
|
if (*stp == 1.) {
|
2629
|
-
|
2565
|
+
dcopy_(n, &z__[1], &c__1, &x[1], &c__1);
|
2630
2566
|
} else {
|
2631
2567
|
i__1 = *n;
|
2632
2568
|
for (i__ = 1; i__ <= i__1; ++i__) {
|
@@ -2636,7 +2572,6 @@ L556:
|
|
2636
2572
|
} else {
|
2637
2573
|
strcpy(task, "NEW_X");
|
2638
2574
|
}
|
2639
|
-
return 0;
|
2640
2575
|
}
|
2641
2576
|
|
2642
2577
|
/**
|
@@ -2658,15 +2593,11 @@ L556:
|
|
2658
2593
|
* Ciyou Zhu
|
2659
2594
|
* in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
|
2660
2595
|
*/
|
2661
|
-
|
2662
|
-
|
2663
|
-
|
2664
|
-
|
2665
|
-
|
2666
|
-
{
|
2667
|
-
long ws_dim1, ws_offset, wy_dim1, wy_offset, sy_dim1, sy_offset, ss_dim1, ss_offset, i__1, i__2;
|
2668
|
-
static long j;
|
2669
|
-
static long pointr;
|
2596
|
+
void matupd_(F77_int* n, F77_int* m, double* ws, double* wy, double* sy, double* ss, double* d__, double* r__, F77_int* itail,
|
2597
|
+
F77_int* iupdat, F77_int* col, F77_int* head, double* theta, double* rr, double* dr, double* stp, double* dtd) {
|
2598
|
+
F77_int ws_dim1, ws_offset, wy_dim1, wy_offset, sy_dim1, sy_offset, ss_dim1, ss_offset, i__1, i__2;
|
2599
|
+
static F77_int j;
|
2600
|
+
static F77_int pointr;
|
2670
2601
|
|
2671
2602
|
--r__;
|
2672
2603
|
--d__;
|
@@ -2693,8 +2624,8 @@ int matupd_(long *n, long *m, double *ws,
|
|
2693
2624
|
*head = *head % *m + 1;
|
2694
2625
|
}
|
2695
2626
|
/* Update matrices WS and WY. */
|
2696
|
-
|
2697
|
-
|
2627
|
+
dcopy_(n, &d__[1], &c__1, &ws[*itail * ws_dim1 + 1], &c__1);
|
2628
|
+
dcopy_(n, &r__[1], &c__1, &wy[*itail * wy_dim1 + 1], &c__1);
|
2698
2629
|
/* Set theta=yy/ys. */
|
2699
2630
|
*theta = *rr / *dr;
|
2700
2631
|
/* Form the middle matrix in B. */
|
@@ -2704,9 +2635,9 @@ int matupd_(long *n, long *m, double *ws,
|
|
2704
2635
|
/* move old information */
|
2705
2636
|
i__1 = *col - 1;
|
2706
2637
|
for (j = 1; j <= i__1; ++j) {
|
2707
|
-
|
2638
|
+
dcopy_(&j, &ss[(j + 1) * ss_dim1 + 2], &c__1, &ss[j * ss_dim1 + 1], &c__1);
|
2708
2639
|
i__2 = *col - j;
|
2709
|
-
|
2640
|
+
dcopy_(&i__2, &sy[j + 1 + (j + 1) * sy_dim1], &c__1, &sy[j + j * sy_dim1], &c__1);
|
2710
2641
|
}
|
2711
2642
|
}
|
2712
2643
|
/* add new information: the last row of SY */
|
@@ -2714,8 +2645,8 @@ int matupd_(long *n, long *m, double *ws,
|
|
2714
2645
|
pointr = *head;
|
2715
2646
|
i__1 = *col - 1;
|
2716
2647
|
for (j = 1; j <= i__1; ++j) {
|
2717
|
-
sy[*col + j * sy_dim1] =
|
2718
|
-
ss[j + *col * ss_dim1] =
|
2648
|
+
sy[*col + j * sy_dim1] = ddot_(n, &d__[1], &c__1, &wy[pointr * wy_dim1 + 1], &c__1);
|
2649
|
+
ss[j + *col * ss_dim1] = ddot_(n, &ws[pointr * ws_dim1 + 1], &c__1, &d__[1], &c__1);
|
2719
2650
|
pointr = pointr % *m + 1;
|
2720
2651
|
}
|
2721
2652
|
if (*stp == 1.) {
|
@@ -2724,7 +2655,6 @@ int matupd_(long *n, long *m, double *ws,
|
|
2724
2655
|
ss[*col + *col * ss_dim1] = *stp * *stp * *dtd;
|
2725
2656
|
}
|
2726
2657
|
sy[*col + *col * sy_dim1] = *dr;
|
2727
|
-
return 0;
|
2728
2658
|
}
|
2729
2659
|
|
2730
2660
|
/**
|
@@ -2743,13 +2673,10 @@ int matupd_(long *n, long *m, double *ws,
|
|
2743
2673
|
* Ciyou Zhu
|
2744
2674
|
* in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
|
2745
2675
|
*/
|
2746
|
-
|
2747
|
-
|
2748
|
-
|
2749
|
-
|
2750
|
-
long i__1;
|
2751
|
-
FILE *itfptr;
|
2752
|
-
static long i__;
|
2676
|
+
void prn1lb_(F77_int* n, F77_int* m, double* l, double* u, double* x, F77_int* iprint, F77_int* itfile, double* epsmch) {
|
2677
|
+
F77_int i__1;
|
2678
|
+
FILE* itfptr;
|
2679
|
+
static F77_int i__;
|
2753
2680
|
|
2754
2681
|
--x;
|
2755
2682
|
--u;
|
@@ -2759,7 +2686,7 @@ int prn1lb_(long *n, long *m, double *l,
|
|
2759
2686
|
fprintf(stdout, "RUNNING THE L-BFGS-B CODE\n\n");
|
2760
2687
|
fprintf(stdout, " * * *\n\n");
|
2761
2688
|
fprintf(stdout, "Machine precision = %.3E\n", *epsmch);
|
2762
|
-
fprintf(stdout, " N = %
|
2689
|
+
fprintf(stdout, " N = %3" PRIdF77INT " M = %2" PRIdF77INT "\n", *n, *m);
|
2763
2690
|
if (*iprint >= 1) {
|
2764
2691
|
itfptr = fopen("iterate.dat", "w");
|
2765
2692
|
fprintf(itfptr, "RUNNING THE L-BFGS-B CODE\n");
|
@@ -2778,7 +2705,7 @@ int prn1lb_(long *n, long *m, double *l,
|
|
2778
2705
|
fprintf(itfptr, "\n");
|
2779
2706
|
fprintf(itfptr, " * * *\n\n");
|
2780
2707
|
fprintf(itfptr, "Machine precision = %.3E\n", *epsmch);
|
2781
|
-
fprintf(itfptr, " N = %
|
2708
|
+
fprintf(itfptr, " N = %3" PRIdF77INT " M = %2" PRIdF77INT "\n", *n, *m);
|
2782
2709
|
fprintf(itfptr, "\n");
|
2783
2710
|
fprintf(itfptr, " it nf nseg nact sub itls stepl tstep projg f\n");
|
2784
2711
|
fclose(itfptr);
|
@@ -2822,7 +2749,6 @@ int prn1lb_(long *n, long *m, double *l,
|
|
2822
2749
|
}
|
2823
2750
|
}
|
2824
2751
|
}
|
2825
|
-
return 0;
|
2826
2752
|
}
|
2827
2753
|
|
2828
2754
|
/**
|
@@ -2840,14 +2766,11 @@ int prn1lb_(long *n, long *m, double *l,
|
|
2840
2766
|
* Ciyou Zhu
|
2841
2767
|
* in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
|
2842
2768
|
*/
|
2843
|
-
|
2844
|
-
|
2845
|
-
|
2846
|
-
|
2847
|
-
|
2848
|
-
long i__1;
|
2849
|
-
static long i__, imod;
|
2850
|
-
FILE *itfptr;
|
2769
|
+
void prn2lb_(F77_int* n, double* x, double* f, double* g, F77_int* iprint, F77_int* itfile, F77_int* iter, F77_int* nfgv, F77_int* nact,
|
2770
|
+
double* sbgnrm, F77_int* nseg, char* word, F77_int* iword, F77_int* iback, double* stp, double* xstep) {
|
2771
|
+
F77_int i__1;
|
2772
|
+
static F77_int i__, imod;
|
2773
|
+
FILE* itfptr;
|
2851
2774
|
--g;
|
2852
2775
|
--x;
|
2853
2776
|
|
@@ -2865,8 +2788,8 @@ int prn2lb_(long *n, double *x, double *f,
|
|
2865
2788
|
strcpy(word, "---");
|
2866
2789
|
}
|
2867
2790
|
if (*iprint >= 99) {
|
2868
|
-
fprintf(stdout, "LINE SEARCH %
|
2869
|
-
fprintf(stdout, "\nAt iterate%
|
2791
|
+
fprintf(stdout, "LINE SEARCH %" PRIdF77INT " times; norm of step = %E\n", *iback, *xstep);
|
2792
|
+
fprintf(stdout, "\nAt iterate%5" PRIdF77INT" f= %12.5E |proj g|= %12.5E\n", *iter, *f, *sbgnrm);
|
2870
2793
|
|
2871
2794
|
if (*iprint > 100) {
|
2872
2795
|
fprintf(stdout, "X =");
|
@@ -2885,16 +2808,15 @@ int prn2lb_(long *n, double *x, double *f,
|
|
2885
2808
|
} else if (*iprint > 0) {
|
2886
2809
|
imod = *iter % *iprint;
|
2887
2810
|
if (imod == 0) {
|
2888
|
-
fprintf(stdout, "\nAt iterate%
|
2811
|
+
fprintf(stdout, "\nAt iterate%5" PRIdF77INT " f= %12.5E |proj g|= %12.5E\n", *iter, *f, *sbgnrm);
|
2889
2812
|
}
|
2890
2813
|
}
|
2891
2814
|
if (*iprint >= 1) {
|
2892
2815
|
itfptr = fopen("iterate.dat", "a");
|
2893
|
-
fprintf(itfptr, " %
|
2816
|
+
fprintf(itfptr, " %4" PRIdF77INT " %4" PRIdF77INT " %5" PRIdF77INT " %5" PRIdF77INT " %3s %4" PRIdF77INT " %7.1E %7.1E %10.3E %10.3E\n",
|
2894
2817
|
*iter, *nfgv, *nseg, *nact, word, *iback, *stp, *xstep, *sbgnrm, *f);
|
2895
2818
|
fclose(itfptr);
|
2896
2819
|
}
|
2897
|
-
return 0;
|
2898
2820
|
}
|
2899
2821
|
|
2900
2822
|
/**
|
@@ -2913,16 +2835,12 @@ int prn2lb_(long *n, double *x, double *f,
|
|
2913
2835
|
* Ciyou Zhu
|
2914
2836
|
* in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
|
2915
2837
|
*/
|
2916
|
-
|
2917
|
-
|
2918
|
-
|
2919
|
-
|
2920
|
-
|
2921
|
-
|
2922
|
-
{
|
2923
|
-
long i__1;
|
2924
|
-
FILE *itfptr;
|
2925
|
-
static long i__;
|
2838
|
+
void prn3lb_(F77_int* n, double* x, double* f, char* task, F77_int* iprint, F77_int* info, F77_int* itfile, F77_int* iter, F77_int* nfgv,
|
2839
|
+
F77_int* nintol, F77_int* nskip, F77_int* nact, double* sbgnrm, double* time, F77_int* nseg, char* word, F77_int* iback,
|
2840
|
+
double* stp, double* xstep, F77_int* k, double* cachyt, double* sbtime, double* lnscht) {
|
2841
|
+
F77_int i__1;
|
2842
|
+
FILE* itfptr;
|
2843
|
+
static F77_int i__;
|
2926
2844
|
|
2927
2845
|
--x;
|
2928
2846
|
|
@@ -2944,7 +2862,8 @@ int prn3lb_(long *n, double *x, double *f, char *task,
|
|
2944
2862
|
fprintf(stdout, " * * *\n");
|
2945
2863
|
fprintf(stdout, "\n");
|
2946
2864
|
fprintf(stdout, " N Tit Tnf Tnint Skip Nact Projg F\n");
|
2947
|
-
fprintf(stdout, "%
|
2865
|
+
fprintf(stdout, "%5" PRIdF77INT " %6" PRIdF77INT " %6" PRIdF77INT " %6" PRIdF77INT " %5" PRIdF77INT " %5" PRIdF77INT " %10.3E %10.3E\n",
|
2866
|
+
*n, *iter, *nfgv, *nintol, *nskip, *nact, *sbgnrm, *f);
|
2948
2867
|
if (*iprint >= 100) {
|
2949
2868
|
fprintf(stdout, "\n");
|
2950
2869
|
fprintf(stdout, " X =");
|
@@ -2993,10 +2912,10 @@ L999:
|
|
2993
2912
|
fprintf(stdout, " may possibly be caused by a bad search direction.\n");
|
2994
2913
|
}
|
2995
2914
|
if (*info == -6) {
|
2996
|
-
fprintf(stdout, " Input nbd(%
|
2915
|
+
fprintf(stdout, " Input nbd(%2" PRIdF77INT ") is invalid.\n", *k);
|
2997
2916
|
}
|
2998
2917
|
if (*info == -7) {
|
2999
|
-
fprintf(stdout, " l(%
|
2918
|
+
fprintf(stdout, " l(%2" PRIdF77INT ") > u(%2" PRIdF77INT "). No feasible solution.\n", *k, *k);
|
3000
2919
|
}
|
3001
2920
|
if (*info == -8) {
|
3002
2921
|
fprintf(stdout, "\n");
|
@@ -3023,7 +2942,7 @@ L999:
|
|
3023
2942
|
if (*iprint >= 1) {
|
3024
2943
|
itfptr = fopen("iterate.dat", "a");
|
3025
2944
|
if (*info == -4 || *info == -9) {
|
3026
|
-
fprintf(itfptr, " %
|
2945
|
+
fprintf(itfptr, " %4" PRIdF77INT " %4" PRIdF77INT " %5" PRIdF77INT " %5" PRIdF77INT " %3s %4" PRIdF77INT " %7.1E %7.1E - -\n",
|
3027
2946
|
*iter, *nfgv, *nseg, *nact, word, *iback, *stp, *xstep);
|
3028
2947
|
}
|
3029
2948
|
fprintf(itfptr, "\n");
|
@@ -3072,7 +2991,6 @@ L999:
|
|
3072
2991
|
fclose(itfptr);
|
3073
2992
|
}
|
3074
2993
|
}
|
3075
|
-
return 0;
|
3076
2994
|
}
|
3077
2995
|
|
3078
2996
|
/**
|
@@ -3090,12 +3008,10 @@ L999:
|
|
3090
3008
|
* Ciyou Zhu
|
3091
3009
|
* in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal.
|
3092
3010
|
*/
|
3093
|
-
|
3094
|
-
|
3095
|
-
{
|
3096
|
-
long i__1;
|
3011
|
+
void projgr_(F77_int* n, double* l, double* u, F77_int* nbd, double* x, double* g, double* sbgnrm) {
|
3012
|
+
F77_int i__1;
|
3097
3013
|
double d__1, d__2;
|
3098
|
-
static
|
3014
|
+
static F77_int i__;
|
3099
3015
|
static double gi;
|
3100
3016
|
|
3101
3017
|
--g;
|
@@ -3124,7 +3040,6 @@ int projgr_(long *n, double *l, double *u,
|
|
3124
3040
|
d__1 = *sbgnrm, d__2 = fabs(gi);
|
3125
3041
|
*sbgnrm = d__1 >= d__2 ? d__1 : d__2;
|
3126
3042
|
}
|
3127
|
-
return 0;
|
3128
3043
|
}
|
3129
3044
|
|
3130
3045
|
/* **********************************************************************
|
@@ -3161,7 +3076,7 @@ int projgr_(long *n, double *l, double *u,
|
|
3161
3076
|
* subject to l<=x<=u
|
3162
3077
|
* x_i=xcp_i for all i in A(xcp)
|
3163
3078
|
*
|
3164
|
-
*
|
3079
|
+
* aF77_int the subspace unconstrained Newton direction
|
3165
3080
|
*
|
3166
3081
|
* d = -(Z'BZ)^(-1) r.
|
3167
3082
|
*
|
@@ -3178,20 +3093,20 @@ int projgr_(long *n, double *l, double *u,
|
|
3178
3093
|
* from that described in [1]. One can show that the matrix K is
|
3179
3094
|
* equal to the matrix M^[-1]N in that paper.
|
3180
3095
|
*
|
3181
|
-
* n is an
|
3096
|
+
* n is an integer variable.
|
3182
3097
|
* On entry n is the dimension of the problem.
|
3183
3098
|
* On exit n is unchanged.
|
3184
3099
|
*
|
3185
|
-
* m is an
|
3100
|
+
* m is an integer variable.
|
3186
3101
|
* On entry m is the maximum number of variable metric corrections
|
3187
3102
|
* used to define the limited memory matrix.
|
3188
3103
|
* On exit m is unchanged.
|
3189
3104
|
*
|
3190
|
-
* nsub is an
|
3105
|
+
* nsub is an integer variable.
|
3191
3106
|
* On entry nsub is the number of free variables.
|
3192
3107
|
* On exit nsub is unchanged.
|
3193
3108
|
*
|
3194
|
-
* ind is an
|
3109
|
+
* ind is an integer array of dimension nsub.
|
3195
3110
|
* On entry ind specifies the coordinate indices of free variables.
|
3196
3111
|
* On exit ind is unchanged.
|
3197
3112
|
*
|
@@ -3203,7 +3118,7 @@ int projgr_(long *n, double *l, double *u,
|
|
3203
3118
|
* On entry u is the upper bound of x.
|
3204
3119
|
* On exit u is unchanged.
|
3205
3120
|
*
|
3206
|
-
* nbd is a
|
3121
|
+
* nbd is a integer array of dimension n.
|
3207
3122
|
* On entry nbd represents the type of bounds imposed on the
|
3208
3123
|
* variables, and must be specified as follows:
|
3209
3124
|
* nbd(i)=0 if x(i) is unbounded,
|
@@ -3233,8 +3148,8 @@ int projgr_(long *n, double *l, double *u,
|
|
3233
3148
|
*
|
3234
3149
|
* ws and wy are double precision arrays;
|
3235
3150
|
* theta is a double precision variable;
|
3236
|
-
* col is an
|
3237
|
-
* head is an
|
3151
|
+
* col is an integer variable;
|
3152
|
+
* head is an integer variable.
|
3238
3153
|
* On entry they store the information defining the
|
3239
3154
|
* limited memory BFGS matrix:
|
3240
3155
|
* ws(n,m) stores S, a set of s-vectors;
|
@@ -3244,7 +3159,7 @@ int projgr_(long *n, double *l, double *u,
|
|
3244
3159
|
* head is the location of the 1st s- (or y-) vector in S (or Y).
|
3245
3160
|
* On exit they are unchanged.
|
3246
3161
|
*
|
3247
|
-
* iword is an
|
3162
|
+
* iword is an integer variable.
|
3248
3163
|
* On entry iword is unspecified.
|
3249
3164
|
* On exit iword specifies the status of the subspace solution.
|
3250
3165
|
* iword = 0 if the solution is in the box,
|
@@ -3262,7 +3177,7 @@ int projgr_(long *n, double *l, double *u,
|
|
3262
3177
|
* [ 0 I]
|
3263
3178
|
* On exit wn is unchanged.
|
3264
3179
|
*
|
3265
|
-
* iprint is an
|
3180
|
+
* iprint is an integer variable that must be set by the user.
|
3266
3181
|
* It controls the frequency and type of output generated:
|
3267
3182
|
* iprint<0 no output is generated;
|
3268
3183
|
* iprint=0 print only one line at the last iteration;
|
@@ -3273,7 +3188,7 @@ int projgr_(long *n, double *l, double *u,
|
|
3273
3188
|
* When iprint > 0, the file iterate.dat will be created to
|
3274
3189
|
* summarize the iteration.
|
3275
3190
|
*
|
3276
|
-
* info is an
|
3191
|
+
* info is an integer variable.
|
3277
3192
|
* On entry info is unspecified.
|
3278
3193
|
* On exit info = 0 for normal return,
|
3279
3194
|
* = nonzero for abnormal return
|
@@ -3299,22 +3214,18 @@ int projgr_(long *n, double *l, double *u,
|
|
3299
3214
|
* Ciyou Zhu
|
3300
3215
|
* in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal
|
3301
3216
|
*/
|
3302
|
-
|
3303
|
-
|
3304
|
-
|
3305
|
-
|
3306
|
-
long *head, long *iword, double *wv, double *wn,
|
3307
|
-
long *iprint, long *info)
|
3308
|
-
{
|
3309
|
-
long ws_dim1, ws_offset, wy_dim1, wy_offset, wn_dim1, wn_offset, i__1, i__2;
|
3217
|
+
void subsm_(F77_int* n, F77_int* m, F77_int* nsub, F77_int* ind, double* l, double* u, F77_int* nbd, double* x, double* d__, double* xp,
|
3218
|
+
double* ws, double* wy, double* theta, double* xx, double* gg, F77_int* col, F77_int* head, F77_int* iword, double* wv,
|
3219
|
+
double* wn, F77_int* iprint, F77_int* info) {
|
3220
|
+
F77_int ws_dim1, ws_offset, wy_dim1, wy_offset, wn_dim1, wn_offset, i__1, i__2;
|
3310
3221
|
double d__1, d__2;
|
3311
|
-
static
|
3222
|
+
static F77_int i__, j, k, m2;
|
3312
3223
|
static double dk;
|
3313
|
-
static
|
3224
|
+
static F77_int js, jy;
|
3314
3225
|
static double xk;
|
3315
|
-
static
|
3226
|
+
static F77_int ibd, col2;
|
3316
3227
|
static double dd_p__, temp1, temp2, alpha;
|
3317
|
-
static
|
3228
|
+
static F77_int pointr;
|
3318
3229
|
|
3319
3230
|
--gg;
|
3320
3231
|
--xx;
|
@@ -3337,7 +3248,7 @@ int subsm_(long *n, long *m, long *nsub, long *ind,
|
|
3337
3248
|
--ind;
|
3338
3249
|
|
3339
3250
|
if (*nsub <= 0) {
|
3340
|
-
return
|
3251
|
+
return;
|
3341
3252
|
}
|
3342
3253
|
if (*iprint >= 99) {
|
3343
3254
|
fprintf(stdout, "\n----------------SUBSM entered-----------------\n\n");
|
@@ -3361,17 +3272,17 @@ int subsm_(long *n, long *m, long *nsub, long *ind,
|
|
3361
3272
|
/* Compute wv:=K^(-1)wv. */
|
3362
3273
|
m2 = *m << 1;
|
3363
3274
|
col2 = *col << 1;
|
3364
|
-
|
3275
|
+
dtrsl_(&wn[wn_offset], &m2, &col2, &wv[1], &c__11, info);
|
3365
3276
|
if (*info != 0) {
|
3366
|
-
return
|
3277
|
+
return;
|
3367
3278
|
}
|
3368
3279
|
i__1 = *col;
|
3369
3280
|
for (i__ = 1; i__ <= i__1; ++i__) {
|
3370
3281
|
wv[i__] = -wv[i__];
|
3371
3282
|
}
|
3372
|
-
|
3283
|
+
dtrsl_(&wn[wn_offset], &m2, &col2, &wv[1], &c__1, info);
|
3373
3284
|
if (*info != 0) {
|
3374
|
-
return
|
3285
|
+
return;
|
3375
3286
|
}
|
3376
3287
|
/* Compute d = (1/theta)d + (1/theta**2)Z'W wv. */
|
3377
3288
|
pointr = *head;
|
@@ -3381,18 +3292,17 @@ int subsm_(long *n, long *m, long *nsub, long *ind,
|
|
3381
3292
|
i__2 = *nsub;
|
3382
3293
|
for (i__ = 1; i__ <= i__2; ++i__) {
|
3383
3294
|
k = ind[i__];
|
3384
|
-
d__[i__] = d__[i__] + wy[k + pointr * wy_dim1] * wv[jy] / *theta
|
3385
|
-
+ ws[k + pointr * ws_dim1] * wv[js];
|
3295
|
+
d__[i__] = d__[i__] + wy[k + pointr * wy_dim1] * wv[jy] / *theta + ws[k + pointr * ws_dim1] * wv[js];
|
3386
3296
|
}
|
3387
3297
|
pointr = pointr % *m + 1;
|
3388
3298
|
}
|
3389
3299
|
d__1 = 1. / *theta;
|
3390
|
-
|
3300
|
+
dscal_(nsub, &d__1, &d__[1], &c__1);
|
3391
3301
|
|
3392
3302
|
/* ----------------------------------------------------------------- */
|
3393
3303
|
/* Let us try the projection, d is the Newton direction */
|
3394
3304
|
*iword = 0;
|
3395
|
-
|
3305
|
+
dcopy_(n, &x[1], &c__1, &xp[1], &c__1);
|
3396
3306
|
|
3397
3307
|
i__1 = *nsub;
|
3398
3308
|
for (i__ = 1; i__ <= i__1; ++i__) {
|
@@ -3445,7 +3355,7 @@ int subsm_(long *n, long *m, long *nsub, long *ind,
|
|
3445
3355
|
dd_p__ += (x[i__] - xx[i__]) * gg[i__];
|
3446
3356
|
}
|
3447
3357
|
if (dd_p__ > 0.) {
|
3448
|
-
|
3358
|
+
dcopy_(n, &xp[1], &c__1, &x[1], &c__1);
|
3449
3359
|
fprintf(stderr, " Positive dir derivative in projection\n");
|
3450
3360
|
fprintf(stderr, " Using the backtracking step\n");
|
3451
3361
|
} else {
|
@@ -3504,7 +3414,6 @@ L911:
|
|
3504
3414
|
if (*iprint >= 99) {
|
3505
3415
|
fprintf(stdout, "\n----------------exit SUBSM --------------------\n\n");
|
3506
3416
|
}
|
3507
|
-
return 0;
|
3508
3417
|
}
|
3509
3418
|
|
3510
3419
|
/**
|
@@ -3621,7 +3530,7 @@ L911:
|
|
3621
3530
|
* On exit with convergence, a warning or an error, the
|
3622
3531
|
* variable task contains additional information.
|
3623
3532
|
*
|
3624
|
-
* isave is an
|
3533
|
+
* isave is an integer work array of dimension 2.
|
3625
3534
|
*
|
3626
3535
|
* dsave is a double precision work array of dimension 13.
|
3627
3536
|
*
|
@@ -3637,17 +3546,14 @@ L911:
|
|
3637
3546
|
* Argonne National Laboratory and University of Minnesota.
|
3638
3547
|
* Brett M. Averick, Richard G. Carter, and Jorge J. More'.
|
3639
3548
|
*/
|
3640
|
-
|
3641
|
-
|
3642
|
-
double *stpmin, double *stpmax,
|
3643
|
-
char *task, long *isave, double *dsave)
|
3644
|
-
{
|
3549
|
+
void dcsrch_(double* f, double* g, double* stp, double* ftol, double* gtol, double* xtol, double* stpmin, double* stpmax,
|
3550
|
+
char* task, F77_int* isave, double* dsave) {
|
3645
3551
|
|
3646
3552
|
double d__1;
|
3647
3553
|
static double fm, gm, fx, fy, gx, gy, fxm, fym, gxm, gym, stx, sty;
|
3648
|
-
static
|
3554
|
+
static F77_int stage;
|
3649
3555
|
static double finit, ginit, width, ftest, gtest, stmin, stmax, width1;
|
3650
|
-
static
|
3556
|
+
static F77_int brackt;
|
3651
3557
|
|
3652
3558
|
--dsave;
|
3653
3559
|
--isave;
|
@@ -3680,7 +3586,7 @@ int dcsrch_(double *f, double *g, double *stp,
|
|
3680
3586
|
}
|
3681
3587
|
/* Exit if there are errors on input. */
|
3682
3588
|
if (strncmp(task, "ERROR", 5) == 0) {
|
3683
|
-
return
|
3589
|
+
return;
|
3684
3590
|
}
|
3685
3591
|
/* Initialize local variables. */
|
3686
3592
|
brackt = FALSE_;
|
@@ -3824,7 +3730,6 @@ L1000:
|
|
3824
3730
|
dsave[11] = stmax;
|
3825
3731
|
dsave[12] = width;
|
3826
3732
|
dsave[13] = width1;
|
3827
|
-
return 0;
|
3828
3733
|
}
|
3829
3734
|
|
3830
3735
|
/**
|
@@ -3917,11 +3822,8 @@ L1000:
|
|
3917
3822
|
* Argonne National Laboratory and University of Minnesota.
|
3918
3823
|
* Brett M. Averick and Jorge J. More'.
|
3919
3824
|
*/
|
3920
|
-
|
3921
|
-
|
3922
|
-
double *fp, double *dp, long *brackt, double *stpmin,
|
3923
|
-
double *stpmax)
|
3924
|
-
{
|
3825
|
+
void dcstep_(double* stx, double* fx, double* dx, double* sty, double* fy, double* dy, double* stp, double* fp, double* dp,
|
3826
|
+
F77_int* brackt, double* stpmin, double* stpmax) {
|
3925
3827
|
double d__1, d__2, d__3;
|
3926
3828
|
static double p, q, r__, s, sgnd, stpc, stpf, stpq, gamma, theta;
|
3927
3829
|
|
@@ -3953,10 +3855,10 @@ int dcstep_(double *stx, double *fx, double *dx,
|
|
3953
3855
|
stpf = stpc + (stpq - stpc) / 2.;
|
3954
3856
|
}
|
3955
3857
|
*brackt = TRUE_;
|
3956
|
-
|
3957
|
-
|
3958
|
-
|
3959
|
-
|
3858
|
+
/* Second case: A lower function value and derivatives of opposite */
|
3859
|
+
/* sign. The minimum is bracketed. If the cubic step is farther from */
|
3860
|
+
/* stp than the secant step, the cubic step is taken, otherwise the */
|
3861
|
+
/* secant step is taken. */
|
3960
3862
|
} else if (sgnd < 0.) {
|
3961
3863
|
theta = (*fx - *fp) * 3. / (*stp - *stx) + *dx + *dp;
|
3962
3864
|
d__1 = fabs(theta);
|
@@ -3980,8 +3882,8 @@ int dcstep_(double *stx, double *fx, double *dx,
|
|
3980
3882
|
stpf = stpq;
|
3981
3883
|
}
|
3982
3884
|
*brackt = TRUE_;
|
3983
|
-
|
3984
|
-
|
3885
|
+
/* Third case: A lower function value, derivatives of the same sign, */
|
3886
|
+
/* and the magnitude of the derivative decreases. */
|
3985
3887
|
} else if (fabs(*dp) < fabs(*dx)) {
|
3986
3888
|
/* The cubic step is computed only if the cubic tends to infinity */
|
3987
3889
|
/* in the direction of the step or if the minimum of the cubic */
|
@@ -4041,10 +3943,10 @@ int dcstep_(double *stx, double *fx, double *dx,
|
|
4041
3943
|
stpf = *stpmax <= stpf ? *stpmax : stpf;
|
4042
3944
|
stpf = *stpmin >= stpf ? *stpmin : stpf;
|
4043
3945
|
}
|
4044
|
-
|
4045
|
-
|
4046
|
-
|
4047
|
-
|
3946
|
+
/* Fourth case: A lower function value, derivatives of the same sign, */
|
3947
|
+
/* and the magnitude of the derivative does not decrease. If the */
|
3948
|
+
/* minimum is not bracketed, the step is either stpmin or stpmax, */
|
3949
|
+
/* otherwise the cubic step is taken. */
|
4048
3950
|
} else {
|
4049
3951
|
if (*brackt) {
|
4050
3952
|
theta = (*fp - *fy) * 3. / (*sty - *stp) + *dy + *dp;
|
@@ -4052,7 +3954,7 @@ int dcstep_(double *stx, double *fx, double *dx,
|
|
4052
3954
|
d__2 = fabs(*dy);
|
4053
3955
|
d__1 = d__1 >= d__2 ? d__1 : d__2;
|
4054
3956
|
d__2 = fabs(*dp);
|
4055
|
-
s = d__1 >= d__2 ? d__1: d__2;
|
3957
|
+
s = d__1 >= d__2 ? d__1 : d__2;
|
4056
3958
|
d__1 = theta / s;
|
4057
3959
|
gamma = s * sqrt(d__1 * d__1 - *dy / s * (*dp / s));
|
4058
3960
|
if (*stp > *sty) {
|
@@ -4086,11 +3988,8 @@ int dcstep_(double *stx, double *fx, double *dx,
|
|
4086
3988
|
}
|
4087
3989
|
/* Compute the new step. */
|
4088
3990
|
*stp = stpf;
|
4089
|
-
return 0;
|
4090
3991
|
}
|
4091
3992
|
|
4092
|
-
|
4093
|
-
{
|
3993
|
+
void timer_(double* ttime) {
|
4094
3994
|
*ttime = (double)clock() / CLOCKS_PER_SEC;
|
4095
|
-
return 0;
|
4096
3995
|
}
|