share/lbfgs/sdrive.f

   1 C     Modification of sdrive.f as retrieved 1997/03/29 from
   2 C     ftp://ftp.netlib.org/opt/lbfgs_um.shar
   3 C
   4 C     This version copyright 2006 by Robert Dodier and released
   5 C     under the terms of the GNU General Public License.
   6 C
   7 C     ---------------- Message from the author ----------------
   8 C     From: Jorge Nocedal [mailto:nocedal@dario.ece.nwu.edu]
   9 C     Sent: Friday, August 17, 2001 9:09 AM
  10 C     To: Robert Dodier
  11 C     Subject: Re: Commercial licensing terms for LBFGS?
  12 C
  13 C     Robert:
  14 C     The code L-BFGS (for unconstrained problems) is in the public domain.
  15 C     It can be used in any commercial application.
  16 C
  17 C     The code L-BFGS-B (for bound constrained problems) belongs to
  18 C     ACM. You need to contact them for a commercial license. It is
  19 C     algorithm 778.
  20 C
  21 C     Jorge
  22 C     --------------------- End of message --------------------
  23
  24       SUBROUTINE FGCOMPUTE(F,G,X,N)
  25       INTEGER N,J
  26       DOUBLE PRECISION F,G(N),X(N),T1,T2
  27       F= 0.D0
  28       DO 30 J=1,N,2
  29         T1= 1.D0-X(J)
  30         T2= 1.D1*(X(J+1)-X(J)**2)
  31         G(J+1)= 2.D1*T2
  32         G(J)= -2.D0*(X(J)*G(J+1)+T1)
  33         F= F+T1**2+T2**2
  34  30   CONTINUE
  35       RETURN
  36       END
  37
  38 C
  39 C     ***********************
  40 C     SIMPLE DRIVER FOR LBFGS
  41 C     ***********************
  42 C
  43 C     Example of driver for LBFGS routine, using a
  44 C     simple test problem. The solution point is at
  45 C     X=(1,...,1) and the optimal function value of 0.
  46 C
  47 C                          JORGE NOCEDAL
  48 C                        *** July 1990 ***
  49 C
  50       PROGRAM SDRIVE
  51 C     Change NFEVALMAX to some workable number like 100.
  52 C     It is currently assigned a small value to ensure that we'll
  53 C     terminate in the middle of a line search; that tests the
  54 C     solution cache code.
  55       PARAMETER(NDIM=2000,MSAVE=7,NWORK=NDIM*(2*MSAVE +1)+2*MSAVE,
  56      &NFEVALMAX=42)
  57       DOUBLE PRECISION X(NDIM),G(NDIM),DIAG(NDIM),W(NWORK),SCACHE(NDIM)
  58       DOUBLE PRECISION F,EPS,XTOL,GTOL,T1,T2,STPMIN,STPMAX
  59       INTEGER IPRINT(2),IFLAG,ICALL,N,M,MP,LP,J
  60       LOGICAL DIAGCO
  61 C
  62 C     The driver for LBFGS must always declare LB2 as EXTERNAL
  63 C
  64       EXTERNAL LB2
  65       COMMON /LB3/MP,LP,GTOL,STPMIN,STPMAX
  66 C
  67       N=100
  68       M=5
  69       IPRINT(1)= 1
  70       IPRINT(2)= 0
  71 C
  72 C     We do not wish to provide the diagonal matrices Hk0, and
  73 C     therefore set DIAGCO to FALSE.
  74 C
  75       DIAGCO= .FALSE.
  76       EPS= 1.0D-5
  77       XTOL= 1.0D-16
  78       ICALL=0
  79       IFLAG=0
  80       DO 10 J=1,N,2
  81          X(J)=-1.2D0
  82          X(J+1)=1.D0
  83  10   CONTINUE
  84 C
  85  20   CONTINUE
  86       CALL FGCOMPUTE(F,G,X,N)
  87       CALL LBFGS(N,M,X,F,G,DIAGCO,DIAG,IPRINT,EPS,XTOL,W,IFLAG,SCACHE)
  88       IF(IFLAG.LE.0) GO TO 50
  89       ICALL=ICALL + 1
  90 C     We allow at most NFEVALMAX evaluations of F and G
  91       IF(ICALL.GE.NFEVALMAX) GO TO 50
  92       GO TO 20
  93   50  CONTINUE
  94
  95       WRITE(6,60)ICALL,NFEVALMAX
  96       WRITE(6,70)(X(I),I=1,N)
  97       WRITE(6,80)
  98       WRITE(6,70)(SCACHE(I),I=1,N)
  99
 100       CALL FGCOMPUTE(F,G,X,N)
 101       WRITE(6,90)F
 102
 103       CALL FGCOMPUTE(F,G,SCACHE,N)
 104       WRITE(6,100)F
 105
 106   60  FORMAT('SEARCH TERMINATED AFTER ',I4,' FUNCTION EVALUATIONS',
 107      &' (LIMIT: ',I4,')',/,'CURRENT SOLUTION VECTOR: ')
 108   70  FORMAT(4(2X,1PD22.15))
 109   80  FORMAT('SOLUTION CACHE: ')
 110   90  FORMAT('F(CURRENT SOLUTION VECTOR) = ',1PD22.15)
 111  100  FORMAT('F(SOLUTION CACHE) = ',1PD22.15)
 112       END
 113 C
 114 C     ** LAST LINE OF SIMPLE DRIVER (SDRIVE) **