MINICERN/mathlib/gen/divon/bndopt.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:03:26  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE BNDOPT (N,XMIN,XMAX,XLOW,XHI,FMIN,FMAX,FLOBD,FUPBD,X,XT
  11      1EMP,GFREE,PFREE,GACTV,GNEW,AHESS,DELTA,FTOL,GTOL,ETA,ALFMAX,MAXFUN
  12      2,NFCNT,IFREE,IACTV,IPRINT,IRESLT)
  13       INTEGER N, MAXFUN, NFCNT, IPRINT, IRESLT
  14       INTEGER IFREE(N), IACTV(N)
  15       DOUBLE PRECISION FMIN, FMAX, FLOBD, FUPBD, DELTA, FTOL, GTOL,
  16      1                 ETA, ALFMAX
  17       DOUBLE PRECISION XMIN(N), XMAX(N), XLOW(N), XHI(N), X(N),
  18      1                 XTEMP(N), GFREE(N), PFREE(N), GACTV(N), GNEW(N),
  19      2                 AHESS(N,N)
  20       INTEGER I, IBDEL, IBTRUE, IDNEW, II, IIMIN, ILOC, INEW, IPCNT,
  21      1        ITER, ITEST, J, NACTV, NADIM, NFREE
  22       LOGICAL LOCAL, NEGMUL, XALTER
  23       DOUBLE PRECISION  A, ALPHA, ALRAT, B, BTOL, B1, D, DEL, DFUN,
  24      1 DVDOT, DXNORM, E, EPSMCH, FA, FBD, FBEST, FDIFF,
  25      2                  FOLD, FRAT, FTEST, FTRUE, FU, FV, FW, FY, FZ,
  26      3                  GNORM, GTEST1, GTEST2, GTP, GU, OLDF, PE,
  27      4                  PNORM, QEPS, R, RR, RTEPS, SCXBD, SFTBND, SS,
  28      5                  STEPMX, T, TOL, U, XBEST, XLAMDA, XNORM, XRAT,
  29      6                  XV, XW, ZTOL1, ZTOL2
  30       DATA EPSMCH/2.22D-16/
  31       RTEPS=SQRT(EPSMCH)
  32       QEPS=SQRT(RTEPS)
  33       ZTOL1=ABS(FTOL)
  34       NADIM=N
  35       NFCNT=0
  36       DO 10 I=1,N
  37       IFREE(I)=0
  38       IACTV(I)=0
  39  10   CONTINUE
  40       IF(IPRINT.LT.0) GOTO 20
  41       WRITE(6,310)
  42       WRITE(6,320) (XLOW(I),I=1,N)
  43       WRITE(6,330) (XHI(I),I=1,N)
  44  20   DO 300 IIMIN=1,2
  45       IF(IIMIN.EQ.2) GOTO 30
  46       CALL DVCOPY(N,XMIN,X)
  47       FTRUE=FMIN
  48       FBEST=FTRUE
  49       FBD=FLOBD
  50       GOTO 40
  51  30   CALL DVCOPY(N,XMAX,X)
  52       FTRUE=FMAX
  53       FBEST=-FTRUE
  54       FBD=FUPBD
  55  40   ITER=0
  56       GNORM=0.0D+0
  57       IPCNT=0
  58       FOLD=FBEST
  59       LOCAL=.FALSE.
  60       DO 60 J=1,N
  61       DO 50 I=1,N
  62       AHESS(I,J)=0.0D+0
  63  50   CONTINUE
  64       AHESS(J,J)=1.0D+0
  65  60   CONTINUE
  66       BTOL=QEPS
  67  70   CALL BNDTST(N,X,XLOW,XHI,BTOL,NFREE,IFREE,NACTV,IACTV,XALTER)
  68       IF(.NOT.XALTER) GOTO 80
  69       FTRUE=DFUN(N,X)
  70       FBEST=FTRUE
  71       IF(IIMIN.EQ.2) FBEST=-FTRUE
  72       FOLD=FBEST
  73  80   IF(IPRINT.LT.0) GOTO 90
  74       IF(IIMIN.EQ.1) WRITE(6,340) FTRUE
  75       IF(IIMIN.EQ.2) WRITE(6,350) FTRUE
  76       IF(LOCAL) WRITE(6,450) NFCNT
  77       WRITE(6,360) (X(I),I=1,N)
  78       WRITE(6,370) NFREE,NACTV
  79       IF(NFREE.GT.0.AND.NFREE.LT.N) WRITE(6,380) (IFREE(I),I=1,NFREE)
  80       IF(NACTV.GT.0.AND.NACTV.LT.N) WRITE(6,390) (IACTV(I),I=1,NACTV)
  81  90   FTEST=RTEPS*(1.0D+0+ABS(FBD))
  82       IF(ABS(FBD-FBEST).LT.FTEST) GOTO 250
  83       IF(NFREE.EQ.0) GOTO 250
  84       CALL GRDCMP(N,NFREE,IFREE,X,FTRUE,DELTA,XHI,XTEMP,GFREE)
  85       NFCNT=NFCNT+NFREE
  86       IF(IIMIN.EQ.1) GOTO 110
  87       DO 100 I=1,NFREE
  88       GFREE(I)=-GFREE(I)
  89  100  CONTINUE
  90  110  CALL RLEN(NFREE,GFREE,GNORM)
  91       IF(GNORM.GT.GTOL.OR.LOCAL) GOTO 120
  92       IF(IPRINT.GT.0) WRITE(6,440)
  93       DEL=DELTA
  94       IF(DELTA.LT.1.0D+0) DEL=SQRT(DELTA)
  95       ZTOL2=10.0D+0*SQRT(RTEPS*DEL)
  96       IF(ZTOL2.LT.RTEPS) ZTOL2=RTEPS
  97       LOCAL=.TRUE.
  98       CALL LOCSCH(IIMIN,N,NFREE,IFREE,X,FBEST,XLOW,XHI,DEL,ZTOL2,NFCNT,
  99      1GNEW,FY,XTEMP,FZ,PFREE)
 100       FTEST=RTEPS*(1.0D+0+ABS(FBEST))
 101       IF(FZ.GE.FBEST.OR.ABS(FZ-FBEST).LT.FTEST) GOTO 250
 102       CALL DVCOPY(N,XTEMP,X)
 103       FBEST=FZ
 104       FTRUE=FZ
 105       IF(IIMIN.EQ.2) FTRUE=-FZ
 106       GOTO 70
 107  120  ITER=ITER+1
 108       IF(NFCNT.GT.MAXFUN) GOTO 270
 109       IF(IPCNT.GE.IPRINT) IPCNT=0
 110       IPCNT=IPCNT+1
 111       IF(NFREE.EQ.0) GOTO 250
 112       CALL LDLSOL(NFREE,NADIM,AHESS,GFREE,PFREE)
 113       DO 130 I=1,NFREE
 114       PFREE(I)=-PFREE(I)
 115  130  CONTINUE
 116       CALL RLEN(NFREE,PFREE,PNORM)
 117       PE=PNORM+RTEPS
 118       CALL FEASMV(N,NFREE,IFREE,X,PFREE,XLOW,XHI,EPSMCH,STEPMX,INEW,IDN
 119      1EW)
 120       IF((STEPMX*PE).GT.DELTA) GOTO 140
 121       CALL ADDBND(N,NFREE,IFREE,NACTV,IACTV,INEW,IDNEW,NADIM,AHESS,XTEM
 122      1P,GFREE,GNORM)
 123       ITER=ITER-1
 124       GOTO 120
 125  140  GTP=DVDOT(NFREE,GFREE,PFREE)
 126       XLAMDA=MIN(STEPMX,ALFMAX)
 127       U=MIN(1.0D+0,XLAMDA)
 128       FU=FBEST
 129       GU=GTP
 130       ILOC=1
 131       SFTBND=DELTA/PE
 132       T=RTEPS/PE
 133       DO 150 I=1,N
 134       XTEMP(I)=X(I)
 135  150  CONTINUE
 136  160  CALL NEWPTQ(RTEPS,T,ETA,SFTBND,XLAMDA,U,FU,GU,XBEST,FBEST,XW,FW,X
 137      1V,FV,A,FA,B,OLDF,B1,SCXBD,E,D,RR,SS,GTEST1,GTEST2,TOL,ILOC,ITEST)
 138       IF(ITEST.NE.1) GOTO 180
 139       R=XBEST+U
 140       DO 170 I=1,NFREE
 141       II=IFREE(I)
 142       XTEMP(II)=X(II)+R*PFREE(I)
 143  170  CONTINUE
 144       FU=DFUN(N,XTEMP)
 145       NFCNT=NFCNT+1
 146       IF(IIMIN.EQ.2) FU=-FU
 147       GOTO 160
 148  180  IF(ITEST.NE.0) GOTO 250
 149       ALPHA=XBEST
 150       DO 190 I=1,NFREE
 151       II=IFREE(I)
 152       X(II)=X(II)+XBEST*PFREE(I)
 153  190  CONTINUE
 154       FTRUE=FBEST
 155       IF(IIMIN.EQ.2) FTRUE=-FBEST
 156       IF(IPRINT.LE.0.OR.IPCNT.LT.IPRINT) GOTO 200
 157       WRITE(6,400) ITER,NFCNT,FBEST
 158       WRITE(6,360) (X(I),I=1,N)
 159       WRITE(6,370) NFREE,NACTV
 160       IF(NFREE.GT.0.AND.NFREE.LT.N) WRITE(6,380) (IFREE(I),I=1,NFREE)
 161       IF(NACTV.GT.0.AND.NACTV.LT.N) WRITE(6,390) (IACTV(I),I=1,NACTV)
 162  200  CALL GRDCMP(N,NFREE,IFREE,X,FTRUE,DELTA,XHI,XTEMP,GNEW)
 163       CALL RLEN(NFREE,GNEW,GNORM)
 164       IF(IPRINT.GT.0.AND.IPCNT.EQ.IPRINT) WRITE(6,460) GNORM
 165       IF(IIMIN.EQ.1) GOTO 220
 166       DO 210 I=1,NFREE
 167       GNEW(I)=-GNEW(I)
 168  210  CONTINUE
 169  220  NFCNT=NFCNT+NFREE
 170       CALL BFGS(NFREE,NADIM,AHESS,EPSMCH,GFREE,GNEW,PFREE,ALPHA,XTEMP)
 171       DO 230 I=1,NFREE
 172       GFREE(I)=GNEW(I)
 173  230  CONTINUE
 174       ALRAT=ABS(ALPHA-STEPMX)/STEPMX
 175       IF(ALRAT.GE.QEPS) GOTO 240
 176       CALL ADDBND(N,NFREE,IFREE,NACTV,IACTV,INEW,IDNEW,NADIM,AHESS,XTEM
 177      1P,GFREE,GNORM)
 178       GOTO 120
 179  240  FDIFF=FOLD-FBEST
 180       FRAT=FDIFF/(1.0D+0+ABS(FBEST))
 181       IF(FTOL.LT.0.0D+0) FRAT=FDIFF/MAX(ABS(FBEST),EPSMCH)
 182       CALL RLEN(N,X,XNORM)
 183       DXNORM=ALPHA*PNORM
 184       XRAT=DXNORM/(1.0D+0+XNORM)
 185       IF(FTOL.LT.0.0D+0) XRAT=DXNORM/MAX(XNORM,EPSMCH)
 186       FOLD=FBEST
 187       IF(FRAT.GT.ZTOL1.OR.XRAT.GT.ZTOL1) GOTO 120
 188  250  IF(NACTV.EQ.0) GOTO 270
 189       CALL MULCHK(N,NACTV,IACTV,IIMIN,RTEPS,X,XHI,FTRUE,DELTA,XTEMP,GAC
 190      1TV,NEGMUL,IBDEL,IBTRUE)
 191       NFCNT=NFCNT+NACTV
 192       IF(IPRINT.LE.0.OR.IPCNT.LT.IPRINT) GOTO 260
 193       WRITE(6,420) ITER,NACTV
 194       WRITE(6,390) (IACTV(I),I=1,NACTV)
 195       WRITE(6,430) (GACTV(I),I=1,NACTV)
 196  260  IF(.NOT.NEGMUL) GOTO 270
 197       CALL DELBND(N,NACTV,IACTV,NFREE,IFREE,IBDEL,IBTRUE,GACTV,NADIM,AH
 198      1ESS,GFREE,GNORM)
 199       GOTO 120
 200  270  IF(IPRINT.LT.0) GOTO 280
 201       WRITE(6,410) ITER,NFCNT,FTRUE
 202       WRITE(6,360) (X(I),I=1,N)
 203       WRITE(6,370) NFREE,NACTV
 204       IF(NFREE.GT.0.AND.NFREE.LT.N) WRITE(6,380) (IFREE(I),I=1,NFREE)
 205       IF(NACTV.GT.0.AND.NACTV.LT.N) WRITE(6,390) (IACTV(I),I=1,NACTV)
 206  280  IF(IIMIN.EQ.2) GOTO 290
 207       FMIN=FBEST
 208       CALL DVCOPY(N,X,XMIN)
 209       GOTO 300
 210  290  FMAX=-FBEST
 211       CALL DVCOPY(N,X,XMAX)
 212  300  CONTINUE
 213       RETURN
 214  310  FORMAT('-START OF OPTIMIZATION')
 215  320  FORMAT(' LOWER BOUNDS', 6(1PD16.6))
 216  330  FORMAT(' UPPER BOUNDS', 6(1PD16.6))
 217  340  FORMAT(' MINIMIZATION STEP -- INITIAL FMIN =', 1PD16.6)
 218  350  FORMAT('0MAXIMIZATION STEP -- INITIAL FMAX =', 1PD16.6)
 219  360  FORMAT(' X ARRAY'/6(1PD16.6))
 220  370  FORMAT(1X,I5,' FREE VARIABLES',I5,' FIXED VARIABLES')
 221  380  FORMAT(' INDICES OF FREE  VARIABLES'/10I8)
 222  390  FORMAT(' INDICES OF FIXED VARIABLES'/10I8)
 223  400  FORMAT('0 AFTER ITERATION',I5,' AND',I5,
 224      1  ' FUNCTION EVALUATIONS, THE FUNCTION VALUE IS',1PD16.6)
 225  410  FORMAT('0*** FINAL RESULT ***'/' AFTER',I5,
 226      1    ' ITERATIONS AND', I6,' FUNCTION EVALUATIONS',
 227      2      ' THE BEST FUNCTION VALUE IS', 1PD17.7)
 228  420  FORMAT('0 AT ITERATION',I6,' CHECK MULTIPLIERS',
 229      1    ' FOR THE',I5,' FIXED VARIABLES')
 230  430  FORMAT(' GRADIENT WITH RESPECT TO FIXED VARIABLES'/
 231      1             1X,6(1PD16.6))
 232  440  FORMAT(' EXECUTE LOCAL SEARCH')
 233  450  FORMAT(1X,I5,' FUNCTION EVALUATIONS AFTER LOCAL SEARCH')
 234  460  FORMAT(' NORM OF PROJECTED GRADIENT =', 1PD16.6)
 235       END