[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / divon / bndopt.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/04/01 15:03:26  mclareni
* Mathlib gen
*
*
#include "gen/pilot.h"
      SUBROUTINE BNDOPT (N,XMIN,XMAX,XLOW,XHI,FMIN,FMAX,FLOBD,FUPBD,X,XT
     1EMP,GFREE,PFREE,GACTV,GNEW,AHESS,DELTA,FTOL,GTOL,ETA,ALFMAX,MAXFUN
     2,NFCNT,IFREE,IACTV,IPRINT,IRESLT)
      INTEGER N, MAXFUN, NFCNT, IPRINT, IRESLT
      INTEGER IFREE(N), IACTV(N)
      DOUBLE PRECISION FMIN, FMAX, FLOBD, FUPBD, DELTA, FTOL, GTOL,
     1                 ETA, ALFMAX
      DOUBLE PRECISION XMIN(N), XMAX(N), XLOW(N), XHI(N), X(N),
     1                 XTEMP(N), GFREE(N), PFREE(N), GACTV(N), GNEW(N),
     2                 AHESS(N,N)
      INTEGER I, IBDEL, IBTRUE, IDNEW, II, IIMIN, ILOC, INEW, IPCNT,
     1        ITER, ITEST, J, NACTV, NADIM, NFREE
      LOGICAL LOCAL, NEGMUL, XALTER
      DOUBLE PRECISION  A, ALPHA, ALRAT, B, BTOL, B1, D, DEL, DFUN,
     1 DVDOT, DXNORM, E, EPSMCH, FA, FBD, FBEST, FDIFF,
     2                  FOLD, FRAT, FTEST, FTRUE, FU, FV, FW, FY, FZ,
     3                  GNORM, GTEST1, GTEST2, GTP, GU, OLDF, PE,
     4                  PNORM, QEPS, R, RR, RTEPS, SCXBD, SFTBND, SS,
     5                  STEPMX, T, TOL, U, XBEST, XLAMDA, XNORM, XRAT,
     6                  XV, XW, ZTOL1, ZTOL2
      DATA EPSMCH/2.22D-16/
      RTEPS=SQRT(EPSMCH)
      QEPS=SQRT(RTEPS)
      ZTOL1=ABS(FTOL)
      NADIM=N
      NFCNT=0
      DO 10 I=1,N
      IFREE(I)=0
      IACTV(I)=0
 10   CONTINUE
      IF(IPRINT.LT.0) GOTO 20
      WRITE(6,310)
      WRITE(6,320) (XLOW(I),I=1,N)
      WRITE(6,330) (XHI(I),I=1,N)
 20   DO 300 IIMIN=1,2
      IF(IIMIN.EQ.2) GOTO 30
      CALL DVCOPY(N,XMIN,X)
      FTRUE=FMIN
      FBEST=FTRUE
      FBD=FLOBD
      GOTO 40
 30   CALL DVCOPY(N,XMAX,X)
      FTRUE=FMAX
      FBEST=-FTRUE
      FBD=FUPBD
 40   ITER=0
      GNORM=0.0D+0
      IPCNT=0
      FOLD=FBEST
      LOCAL=.FALSE.
      DO 60 J=1,N
      DO 50 I=1,N
      AHESS(I,J)=0.0D+0
 50   CONTINUE
      AHESS(J,J)=1.0D+0
 60   CONTINUE
      BTOL=QEPS
 70   CALL BNDTST(N,X,XLOW,XHI,BTOL,NFREE,IFREE,NACTV,IACTV,XALTER)
      IF(.NOT.XALTER) GOTO 80
      FTRUE=DFUN(N,X)
      FBEST=FTRUE
      IF(IIMIN.EQ.2) FBEST=-FTRUE
      FOLD=FBEST
 80   IF(IPRINT.LT.0) GOTO 90
      IF(IIMIN.EQ.1) WRITE(6,340) FTRUE
      IF(IIMIN.EQ.2) WRITE(6,350) FTRUE
      IF(LOCAL) WRITE(6,450) NFCNT
      WRITE(6,360) (X(I),I=1,N)
      WRITE(6,370) NFREE,NACTV
      IF(NFREE.GT.0.AND.NFREE.LT.N) WRITE(6,380) (IFREE(I),I=1,NFREE)
      IF(NACTV.GT.0.AND.NACTV.LT.N) WRITE(6,390) (IACTV(I),I=1,NACTV)
 90   FTEST=RTEPS*(1.0D+0+ABS(FBD))
      IF(ABS(FBD-FBEST).LT.FTEST) GOTO 250
      IF(NFREE.EQ.0) GOTO 250
      CALL GRDCMP(N,NFREE,IFREE,X,FTRUE,DELTA,XHI,XTEMP,GFREE)
      NFCNT=NFCNT+NFREE
      IF(IIMIN.EQ.1) GOTO 110
      DO 100 I=1,NFREE
      GFREE(I)=-GFREE(I)
 100  CONTINUE
 110  CALL RLEN(NFREE,GFREE,GNORM)
      IF(GNORM.GT.GTOL.OR.LOCAL) GOTO 120
      IF(IPRINT.GT.0) WRITE(6,440)
      DEL=DELTA
      IF(DELTA.LT.1.0D+0) DEL=SQRT(DELTA)
      ZTOL2=10.0D+0*SQRT(RTEPS*DEL)
      IF(ZTOL2.LT.RTEPS) ZTOL2=RTEPS
      LOCAL=.TRUE.
      CALL LOCSCH(IIMIN,N,NFREE,IFREE,X,FBEST,XLOW,XHI,DEL,ZTOL2,NFCNT,
     1GNEW,FY,XTEMP,FZ,PFREE)
      FTEST=RTEPS*(1.0D+0+ABS(FBEST))
      IF(FZ.GE.FBEST.OR.ABS(FZ-FBEST).LT.FTEST) GOTO 250
      CALL DVCOPY(N,XTEMP,X)
      FBEST=FZ
      FTRUE=FZ
      IF(IIMIN.EQ.2) FTRUE=-FZ
      GOTO 70
 120  ITER=ITER+1
      IF(NFCNT.GT.MAXFUN) GOTO 270
      IF(IPCNT.GE.IPRINT) IPCNT=0
      IPCNT=IPCNT+1
      IF(NFREE.EQ.0) GOTO 250
      CALL LDLSOL(NFREE,NADIM,AHESS,GFREE,PFREE)
      DO 130 I=1,NFREE
      PFREE(I)=-PFREE(I)
 130  CONTINUE
      CALL RLEN(NFREE,PFREE,PNORM)
      PE=PNORM+RTEPS
      CALL FEASMV(N,NFREE,IFREE,X,PFREE,XLOW,XHI,EPSMCH,STEPMX,INEW,IDN
     1EW)
      IF((STEPMX*PE).GT.DELTA) GOTO 140
      CALL ADDBND(N,NFREE,IFREE,NACTV,IACTV,INEW,IDNEW,NADIM,AHESS,XTEM
     1P,GFREE,GNORM)
      ITER=ITER-1
      GOTO 120
 140  GTP=DVDOT(NFREE,GFREE,PFREE)
      XLAMDA=MIN(STEPMX,ALFMAX)
      U=MIN(1.0D+0,XLAMDA)
      FU=FBEST
      GU=GTP
      ILOC=1
      SFTBND=DELTA/PE
      T=RTEPS/PE
      DO 150 I=1,N
      XTEMP(I)=X(I)
 150  CONTINUE
 160  CALL NEWPTQ(RTEPS,T,ETA,SFTBND,XLAMDA,U,FU,GU,XBEST,FBEST,XW,FW,X
     1V,FV,A,FA,B,OLDF,B1,SCXBD,E,D,RR,SS,GTEST1,GTEST2,TOL,ILOC,ITEST)
      IF(ITEST.NE.1) GOTO 180
      R=XBEST+U
      DO 170 I=1,NFREE
      II=IFREE(I)
      XTEMP(II)=X(II)+R*PFREE(I)
 170  CONTINUE
      FU=DFUN(N,XTEMP)
      NFCNT=NFCNT+1
      IF(IIMIN.EQ.2) FU=-FU
      GOTO 160
 180  IF(ITEST.NE.0) GOTO 250
      ALPHA=XBEST
      DO 190 I=1,NFREE
      II=IFREE(I)
      X(II)=X(II)+XBEST*PFREE(I)
 190  CONTINUE
      FTRUE=FBEST
      IF(IIMIN.EQ.2) FTRUE=-FBEST
      IF(IPRINT.LE.0.OR.IPCNT.LT.IPRINT) GOTO 200
      WRITE(6,400) ITER,NFCNT,FBEST
      WRITE(6,360) (X(I),I=1,N)
      WRITE(6,370) NFREE,NACTV
      IF(NFREE.GT.0.AND.NFREE.LT.N) WRITE(6,380) (IFREE(I),I=1,NFREE)
      IF(NACTV.GT.0.AND.NACTV.LT.N) WRITE(6,390) (IACTV(I),I=1,NACTV)
 200  CALL GRDCMP(N,NFREE,IFREE,X,FTRUE,DELTA,XHI,XTEMP,GNEW)
      CALL RLEN(NFREE,GNEW,GNORM)
      IF(IPRINT.GT.0.AND.IPCNT.EQ.IPRINT) WRITE(6,460) GNORM
      IF(IIMIN.EQ.1) GOTO 220
      DO 210 I=1,NFREE
      GNEW(I)=-GNEW(I)
 210  CONTINUE
 220  NFCNT=NFCNT+NFREE
      CALL BFGS(NFREE,NADIM,AHESS,EPSMCH,GFREE,GNEW,PFREE,ALPHA,XTEMP)
      DO 230 I=1,NFREE
      GFREE(I)=GNEW(I)
 230  CONTINUE
      ALRAT=ABS(ALPHA-STEPMX)/STEPMX
      IF(ALRAT.GE.QEPS) GOTO 240
      CALL ADDBND(N,NFREE,IFREE,NACTV,IACTV,INEW,IDNEW,NADIM,AHESS,XTEM
     1P,GFREE,GNORM)
      GOTO 120
 240  FDIFF=FOLD-FBEST
      FRAT=FDIFF/(1.0D+0+ABS(FBEST))
      IF(FTOL.LT.0.0D+0) FRAT=FDIFF/MAX(ABS(FBEST),EPSMCH)
      CALL RLEN(N,X,XNORM)
      DXNORM=ALPHA*PNORM
      XRAT=DXNORM/(1.0D+0+XNORM)
      IF(FTOL.LT.0.0D+0) XRAT=DXNORM/MAX(XNORM,EPSMCH)
      FOLD=FBEST
      IF(FRAT.GT.ZTOL1.OR.XRAT.GT.ZTOL1) GOTO 120
 250  IF(NACTV.EQ.0) GOTO 270
      CALL MULCHK(N,NACTV,IACTV,IIMIN,RTEPS,X,XHI,FTRUE,DELTA,XTEMP,GAC
     1TV,NEGMUL,IBDEL,IBTRUE)
      NFCNT=NFCNT+NACTV
      IF(IPRINT.LE.0.OR.IPCNT.LT.IPRINT) GOTO 260
      WRITE(6,420) ITER,NACTV
      WRITE(6,390) (IACTV(I),I=1,NACTV)
      WRITE(6,430) (GACTV(I),I=1,NACTV)
 260  IF(.NOT.NEGMUL) GOTO 270
      CALL DELBND(N,NACTV,IACTV,NFREE,IFREE,IBDEL,IBTRUE,GACTV,NADIM,AH
     1ESS,GFREE,GNORM)
      GOTO 120
 270  IF(IPRINT.LT.0) GOTO 280
      WRITE(6,410) ITER,NFCNT,FTRUE
      WRITE(6,360) (X(I),I=1,N)
      WRITE(6,370) NFREE,NACTV
      IF(NFREE.GT.0.AND.NFREE.LT.N) WRITE(6,380) (IFREE(I),I=1,NFREE)
      IF(NACTV.GT.0.AND.NACTV.LT.N) WRITE(6,390) (IACTV(I),I=1,NACTV)
 280  IF(IIMIN.EQ.2) GOTO 290
      FMIN=FBEST
      CALL DVCOPY(N,X,XMIN)
      GOTO 300
 290  FMAX=-FBEST
      CALL DVCOPY(N,X,XMAX)
 300  CONTINUE
      RETURN
 310  FORMAT('-START OF OPTIMIZATION')
 320  FORMAT(' LOWER BOUNDS', 6(1PD16.6))
 330  FORMAT(' UPPER BOUNDS', 6(1PD16.6))
 340  FORMAT(' MINIMIZATION STEP -- INITIAL FMIN =', 1PD16.6)
 350  FORMAT('0MAXIMIZATION STEP -- INITIAL FMAX =', 1PD16.6)
 360  FORMAT(' X ARRAY'/6(1PD16.6))
 370  FORMAT(1X,I5,' FREE VARIABLES',I5,' FIXED VARIABLES')
 380  FORMAT(' INDICES OF FREE  VARIABLES'/10I8)
 390  FORMAT(' INDICES OF FIXED VARIABLES'/10I8)
 400  FORMAT('0 AFTER ITERATION',I5,' AND',I5,
     1  ' FUNCTION EVALUATIONS, THE FUNCTION VALUE IS',1PD16.6)
 410  FORMAT('0*** FINAL RESULT ***'/' AFTER',I5,
     1    ' ITERATIONS AND', I6,' FUNCTION EVALUATIONS',
     2      ' THE BEST FUNCTION VALUE IS', 1PD17.7)
 420  FORMAT('0 AT ITERATION',I6,' CHECK MULTIPLIERS',
     1    ' FOR THE',I5,' FIXED VARIABLES')
 430  FORMAT(' GRADIENT WITH RESPECT TO FIXED VARIABLES'/
     1             1X,6(1PD16.6))
 440  FORMAT(' EXECUTE LOCAL SEARCH')
 450  FORMAT(1X,I5,' FUNCTION EVALUATIONS AFTER LOCAL SEARCH')
 460  FORMAT(' NORM OF PROJECTED GRADIENT =', 1PD16.6)
      END
Commit	Line	Data
fe4da5cc	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+0SQRT(RTEPSDEL)
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