1************************************************************************
2* SUBROUTINE PLISU              ALL SYSTEMS                   97/01/22
3* PURPOSE :
4* EASY TO USE SUBROUTINE FOR LARGE-SCALE UNCONSTRAINED MINIMIZATION.
5*
6* PARAMETERS :
7*  II  NF  NUMBER OF VARIABLES.
8*  RI  X(NF)  VECTOR OF VARIABLES.
9*  II  IPAR(7)  INTEGER PAREMETERS:
10*      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
11*      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
12*      IPAR(3)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
13*      IPAR(4)  ESTIMATION INDICATOR. IPAR(4)=0-MINIMUM IS NOT
14*         ESTIMATED. IPAR(4)=1-MINIMUM IS ESTIMATED BY THE VALUE
15*         RPAR(6).
16*      IPAR(5)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
17*      IPAR(6)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
18*      IPAR(7)  MAXIMUM NUMBER OF VARIABLE METRIC UPDATES.
19*  RI  RPAR(9)  REAL PARAMETERS:
20*      RPAR(1)  MAXIMUM STEPSIZE.
21*      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
22*      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
23*      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
24*      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
25*      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
26*      RPAR(7)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
27*      RPAR(8)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
28*      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
29*  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
30*  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
31*  II  IPRNT  PRINT SPECIFICATION. IPRNT=0-NO PRINT.
32*         ABS(IPRNT)=1-PRINT OF FINAL RESULTS.
33*         ABS(IPRNT)=2-PRINT OF FINAL RESULTS AND ITERATIONS.
34*         IPRNT>0-BASIC FINAL RESULTS. IPRNT<0-EXTENDED FINAL
35*         RESULTS.
36*  IO  ITERM  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
37*         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
38*                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
39*         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
40*                   MTESF (USUALLY TWO) SUBSEQUENT ITERATIONS.
41*         ITERM=3-IF F IS LESS THAN OR EQUAL TO TOLB.
42*         ITERM=4-IF GMAX IS LESS THAN OR EQUAL TO TOLG.
43*         ITERM=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
44*                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
45*         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
46*         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
47*
48* VARIABLES IN COMMON /STAT/ (STATISTICS) :
49*  IO  NRES  NUMBER OF RESTARTS.
50*  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
51*  IO  NIN  NUMBER OF INNER ITERATIONS.
52*  IO  NIT  NUMBER OF ITERATIONS.
53*  IO  NFV  NUMBER OF FUNCTION EVALUATIONS.
54*  IO  NFG  NUMBER OF GRADIENT EVALUATIONS.
55*  IO  NFH  NUMBER OF HESSIAN EVALUATIONS.
56*
57* SUBPROGRAMS USED :
58*  S   PLIS  LIMITED MEMORY VARIABLE METRIC METHOD BASED ON THE STRANG
59*         RECURRENCES.
60*
61* EXTERNAL SUBROUTINES :
62*  SE  OBJ  COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION.
63*         CALLING SEQUENCE: CALL OBJ(NF,X,FF) WHERE NF IS THE NUMBER
64*         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND FF IS
65*         THE VALUE OF THE OBJECTIVE FUNCTION.
66*  SE  DOBJ  COMPUTATION OF THE GRADIENT OF THE OBJECTIVE FUNCTION.
67*         CALLING SEQUENCE: CALL DOBJ(NF,X,GF) WHERE NF IS THE NUMBER
68*         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND GF(NF)
69*         IS THE GRADIENT OF THE OBJECTIVE FUNCTION.
70*
71      SUBROUTINE PLISU(NF,X,IPAR,RPAR,F,GMAX,IPRNT,ITERM)
72      INTEGER NF,IPAR(7),IPRNT,ITERM
73      DOUBLE PRECISION X(*),RPAR(9),F,GMAX
74      INTEGER MF,NB,LGF,LS,LXO,LGO,LUO,LVO
75      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
76      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
77      DOUBLE PRECISION RA(:)
78      ALLOCATABLE RA
79      MF=IPAR(7)
80      IF (MF.LE.0) MF=10
81      ALLOCATE (RA(2*NF+2*NF*MF+2*MF))
82      NB=0
83*
84*     POINTERS FOR AUXILIARY ARRAYS
85*
86      LGF=1
87      LS=LGF+NF
88      LXO=LS+NF
89      LGO=LXO+NF*MF
90      LUO=LGO+NF*MF
91      LVO=LUO+MF
92      CALL PLIS(NF,NB,X,IPAR,RA,RA,RA(LGF),RA(LS),RA(LXO),RA(LGO),
93     & RA(LUO),RA(LVO),RPAR(1),RPAR(2),RPAR(3),RPAR(4),RPAR(5),RPAR(6),
94     & GMAX,F,IPAR(1),IPAR(2),IPAR(4),MF,IPRNT,ITERM)
95      DEALLOCATE (RA)
96      RETURN
97      END
98************************************************************************
99* SUBROUTINE PLISS              ALL SYSTEMS                   97/01/22
100* PURPOSE :
101* EASY TO USE SUBROUTINE FOR LARGE-SCALE BOX CONSTRAINED MINIMIZATION.
102*
103* PARAMETERS :
104*  II  NF  NUMBER OF VARIABLES.
105*  RI  X(NF)  VECTOR OF VARIABLES.
106*  II  IX(NF)  VECTOR CONTAINING TYPES OF BOUNDS. IX(I)=0-VARIABLE
107*         X(I) IS UNBOUNDED. IX(I)=1-LOWER BOUND XL(I).LE.X(I).
108*         IX(I)=2-UPPER BOUND X(I).LE.XU(I). IX(I)=3-TWO SIDE BOUND
109*         XL(I).LE.X(I).LE.XU(I). IX(I)=5-VARIABLE X(I) IS FIXED.
110*  RI  XL(NF)  VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES.
111*  RI  XU(NF)  VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES.
112*  II  IPAR(7)  INTEGER PAREMETERS:
113*      IPAR(1)  MAXIMUM NUMBER OF ITERATIONS.
114*      IPAR(2)  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
115*      IPAR(3)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
116*      IPAR(4)  ESTIMATION INDICATOR. IPAR(4)=0-MINIMUM IS NOT
117*         ESTIMATED. IPAR(4)=1-MINIMUM IS ESTIMATED BY THE VALUE
118*         RPAR(6).
119*      IPAR(5)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
120*      IPAR(6)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
121*      IPAR(7)  MAXIMUM NUMBER OF VARIABLE METRIC UPDATES.
122*  RI  RPAR(9)  REAL PARAMETERS:
123*      RPAR(1)  MAXIMUM STEPSIZE.
124*      RPAR(2)  TOLERANCE FOR THE CHANGE OF VARIABLES.
125*      RPAR(3)  TOLERANCE FOR THE CHANGE OF FUNCTION VALUES.
126*      RPAR(4)  TOLERANCE FOR THE FUNCTION FALUE.
127*      RPAR(5)  TOLERANCE FOR THE GRADIENT NORM.
128*      RPAR(6)  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
129*      RPAR(7)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
130*      RPAR(8)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
131*      RPAR(9)  THIS PARAMETER IS NOT USED IN THE SUBROUTINE PLIS.
132*  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
133*  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
134*  II  IPRNT  PRINT SPECIFICATION. IPRNT=0-NO PRINT.
135*         ABS(IPRNT)=1-PRINT OF FINAL RESULTS.
136*         ABS(IPRNT)=2-PRINT OF FINAL RESULTS AND ITERATIONS.
137*         IPRNT>0-BASIC FINAL RESULTS. IPRNT<0-EXTENDED FINAL
138*         RESULTS.
139*  IO  ITERM  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
140*         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
141*                   MTESX (USUALLY TWO) SUBSEQUENT ITERATIONS.
142*         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
143*                   MTESF (USUALLY TWO) SUBSEQUENT ITERATIONS.
144*         ITERM=3-IF F IS LESS THAN OR EQUAL TO TOLB.
145*         ITERM=4-IF GMAX IS LESS THAN OR EQUAL TO TOLG.
146*         ITERM=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
147*                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
148*         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
149*         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
150*
151* VARIABLES IN COMMON /STAT/ (STATISTICS) :
152*  IO  NRES  NUMBER OF RESTARTS.
153*  IO  NDEC  NUMBER OF MATRIX DECOMPOSITIONS.
154*  IO  NIN  NUMBER OF INNER ITERATIONS.
155*  IO  NIT  NUMBER OF ITERATIONS.
156*  IO  NFV  NUMBER OF FUNCTION EVALUATIONS.
157*  IO  NFG  NUMBER OF GRADIENT EVALUATIONS.
158*  IO  NFH  NUMBER OF HESSIAN EVALUATIONS.
159*
160* SUBPROGRAMS USED :
161*  S   PLIS  LIMITED MEMORY VARIABLE METRIC METHOD BASED ON THE STRANG
162*         RECURRENCES.
163*
164* EXTERNAL SUBROUTINES :
165*  SE  OBJ  COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION.
166*         CALLING SEQUENCE: CALL OBJ(NF,X,FF) WHERE NF IS THE NUMBER
167*         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND FF IS
168*         THE VALUE OF THE OBJECTIVE FUNCTION.
169*  SE  DOBJ  COMPUTATION OF THE GRADIENT OF THE OBJECTIVE FUNCTION.
170*         CALLING SEQUENCE: CALL DOBJ(NF,X,GF) WHERE NF IS THE NUMBER
171*         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND GF(NF)
172*         IS THE GRADIENT OF THE OBJECTIVE FUNCTION.
173*
174      SUBROUTINE PLISS(NF,X,IX,XL,XU,IPAR,RPAR,F,GMAX,IPRNT,ITERM)
175      INTEGER NF,IX(*),IPAR(7),IPRNT,ITERM
176      DOUBLE PRECISION X(*),XL(*),XU(*),RPAR(9),F,GMAX
177      INTEGER MF,NB,LGF,LS,LXO,LGO,LUO,LVO
178      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
179      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
180      DOUBLE PRECISION RA(:)
181      ALLOCATABLE RA
182      MF=IPAR(7)
183      IF (MF.LE.0) MF=10
184      ALLOCATE (RA(2*NF+2*NF*MF+2*MF))
185      NB=1
186*
187*     POINTERS FOR AUXILIARY ARRAYS
188*
189      LGF=1
190      LS=LGF+NF
191      LXO=LS+NF
192      LGO=LXO+NF*MF
193      LUO=LGO+NF*MF
194      LVO=LUO+MF
195      CALL PLIS(NF,NB,X,IX,XL,XU,RA(LGF),RA(LS),RA(LXO),RA(LGO),
196     & RA(LUO),RA(LVO),RPAR(1),RPAR(2),RPAR(3),RPAR(4),RPAR(5),RPAR(6),
197     & GMAX,F,IPAR(1),IPAR(2),IPAR(4),MF,IPRNT,ITERM)
198      DEALLOCATE (RA)
199      RETURN
200      END
201************************************************************************
202* SUBROUTINE PLIS               ALL SYSTEMS                   01/09/22
203* PURPOSE :
204* GENERAL SUBROUTINE FOR LARGE-SCALE BOX CONSTRAINED MINIMIZATION THAT
205* USE THE LIMITED MEMORY VARIABLE METRIC METHOD BASED ON THE STRANG
206* RECURRENCES.
207*
208* PARAMETERS :
209*  II  NF  NUMBER OF VARIABLES.
210*  II  NB  CHOICE OF SIMPLE BOUNDS. NB=0-SIMPLE BOUNDS SUPPRESSED.
211*         NB>0-SIMPLE BOUNDS ACCEPTED.
212*  RI  X(NF)  VECTOR OF VARIABLES.
213*  II  IX(NF)  VECTOR CONTAINING TYPES OF BOUNDS. IX(I)=0-VARIABLE
214*         X(I) IS UNBOUNDED. IX(I)=1-LOVER BOUND XL(I).LE.X(I).
215*         IX(I)=2-UPPER BOUND X(I).LE.XU(I). IX(I)=3-TWO SIDE BOUND
216*         XL(I).LE.X(I).LE.XU(I). IX(I)=5-VARIABLE X(I) IS FIXED.
217*  RI  XL(NF)  VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES.
218*  RI  XU(NF)  VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES.
219*  RO  GF(NF)  GRADIENT OF THE OBJECTIVE FUNCTION.
220*  RO  S(NF)  DIRECTION VECTOR.
221*  RU  XO(NF)  VECTORS OF VARIABLES DIFFERENCE.
222*  RI  GO(NF)  GRADIENTS DIFFERENCE.
223*  RA  UO(NF)  AUXILIARY VECTOR.
224*  RA  VO(NF)  AUXILIARY VECTOR.
225*  RI  XMAX  MAXIMUM STEPSIZE.
226*  RI  TOLX  TOLERANCE FOR CHANGE OF VARIABLES.
227*  RI  TOLF  TOLERANCE FOR CHANGE OF FUNCTION VALUES.
228*  RI  TOLB  TOLERANCE FOR THE FUNCTION VALUE.
229*  RI  TOLG  TOLERANCE FOR THE GRADIENT NORM.
230*  RI  FMIN  ESTIMATION OF THE MINIMUM FUNCTION VALUE.
231*  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE.
232*  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
233*  II  MIT  MAXIMUM NUMBER OF ITERATIONS.
234*  II  MFV  MAXIMUM NUMBER OF FUNCTION EVALUATIONS.
235*  II  IEST  ESTIMATION INDICATOR. IEST=0-MINIMUM IS NOT ESTIMATED.
236*         IEST=1-MINIMUM IS ESTIMATED BY THE VALUE FMIN.
237*  II  MF  NUMBER OF LIMITED MEMORY STEPS.
238*  II  IPRNT  PRINT SPECIFICATION. IPRNT=0-NO PRINT.
239*         ABS(IPRNT)=1-PRINT OF FINAL RESULTS.
240*         ABS(IPRNT)=2-PRINT OF FINAL RESULTS AND ITERATIONS.
241*         IPRNT>0-BASIC FINAL RESULTS. IPRNT<0-EXTENDED FINAL
242*         RESULTS.
243*  IO  ITERM  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
244*         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
245*                   MTESX (USUALLY TWO) SUBSEQUEBT ITERATIONS.
246*         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
247*                   MTESF (USUALLY TWO) SUBSEQUEBT ITERATIONS.
248*         ITERM=3-IF F IS LESS THAN OR EQUAL TO TOLB.
249*         ITERM=4-IF GMAX IS LESS THAN OR EQUAL TO TOLG.
250*         ITERM=6-IF THE TERMINATION CRITERION WAS NOT SATISFIED,
251*                   BUT THE SOLUTION OBTAINED IS PROBABLY ACCEPTABLE.
252*         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
253*         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
254*
255* VARIABLES IN COMMON /STAT/ (STATISTICS) :
256*  IO  NRES  NUMBER OF RESTARTS.
257*  IO  NDEC  NUMBER OF MATRIX DECOMPOSITION.
258*  IO  NIN  NUMBER OF INNER ITERATIONS.
259*  IO  NIT  NUMBER OF ITERATIONS.
260*  IO  NFV  NUMBER OF FUNCTION EVALUATIONS.
261*  IO  NFG  NUMBER OF GRADIENT EVALUATIONS.
262*  IO  NFH  NUMBER OF HESSIAN EVALUATIONS.
263*
264* SUBPROGRAMS USED :
265*  S   PCBS04  ELIMINATION OF BOX CONSTRAINT VIOLATIONS.
266*  S   PS1L01  STEPSIZE SELECTION USING LINE SEARCH.
267*  S   PYADC0  ADDITION OF A BOX CONSTRAINT.
268*  S   PYFUT1  TEST ON TERMINATION.
269*  S   PYRMC0  DELETION OF A BOX CONSTRAINT.
270*  S   PYTRCD  COMPUTATION OF PROJECTED DIFFERENCES FOR THE VARIABLE METRIC
271*         UPDATE.
272*  S   PYTRCG  COMPUTATION OF THE PROJECTED GRADIENT.
273*  S   PYTRCS  COMPUTATION OF THE PROJECTED DIRECTION VECTOR.
274*  S   MXDRCB BACKWARD PART OF THE STRANG FORMULA FOR PREMULTIPLICATION
275*         OF THE VECTOR X BY AN IMPLICIT BFGS UPDATE.
276*  S   MXDRCF FORWARD PART OF THE STRANG FORMULA FOR PREMULTIPLICATION
277*         OF THE VECTOR X BY AN IMPLICIT BFGS UPDATE.
278*  S   MXDRSU SHIFT OF COLUMNS OF THE RECTANGULAR MATRICES A AND B.
279*         SHIFT OF ELEMENTS OF THE VECTOR U. THESE SHIFTS ARE USED IN
280*         THE LIMITED MEMORY BFGS METHOD.
281*  S   MXUDIR  VECTOR AUGMENTED BY THE SCALED VECTOR.
282*  RF  MXUDOT  DOT PRODUCT OF TWO VECTORS.
283*  S   MXUNEG  COPYING OF A VECTOR WITH CHANGE OF THE SIGN.
284*  S   MXVCOP  COPYING OF A VECTOR.
285*  S   MXVSCL  SCALING OF A VECTOR.
286*
287* EXTERNAL SUBROUTINES :
288*  SE  OBJ  COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION.
289*         CALLING SEQUENCE: CALL OBJ(NF,X,FF) WHERE NF IS THE NUMBER
290*         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND FF IS
291*         THE VALUE OF THE OBJECTIVE FUNCTION.
292*  SE  DOBJ  COMPUTATION OF THE GRADIENT OF THE OBJECTIVE FUNCTION.
293*         CALLING SEQUENCE: CALL DOBJ(NF,X,GF) WHERE NF IS THE NUMBER
294*         OF VARIABLES, X(NF) IS THE VECTOR OF VARIABLES AND GF(NF)
295*         IS THE GRADIENT OF THE OBJECTIVE FUNCTION.
296*
297* METHOD :
298* LIMITED MEMORY VARIABLE METRIC METHOD BASED ON THE STRANG
299* RECURRENCES.
300*
301      SUBROUTINE PLIS(NF,NB,X,IX,XL,XU,GF,S,XO,GO,UO,VO,XMAX,TOLX,
302     & TOLF,TOLB,TOLG,FMIN,GMAX,F,MIT,MFV,IEST,MF,IPRNT,ITERM)
303      INTEGER NF,NB,IX(*),MIT,MFV,IEST,MF,IPRNT,ITERM
304      DOUBLE PRECISION X(*),XL(*),XU(*),GF(*),S(*),XO(*),GO(*),UO(*),
305     & VO(*),TOLX,TOLF,TOLG,TOLB,FMIN,XMAX,GMAX,F
306      INTEGER ITERD,ITERS,KD,LD,NTESX,NTESF,MTESX,MTESF,MRED,KIT,
307     & IREST,KBF,MES,MES1,MES2,MES3,MAXST,ISYS,ITES,INITS,KTERS,
308     & IRES1,IRES2,INEW,IOLD,I,N,MFG,K,NRED
309      DOUBLE PRECISION R,RO,RP,FO,FP,P,PO,PP,GNORM,SNORM,RMIN,RMAX,
310     & UMAX,FMAX,DMAX,ETA0,ETA9,EPS8,EPS9,ALF1,ALF2,PAR1,PAR2,A,B,
311     & TOLD,TOLS,TOLP
312      DOUBLE PRECISION MXUDOT
313      INTEGER NRES,NDEC,NIN,NIT,NFV,NFG,NFH
314      COMMON /STAT/ NRES,NDEC,NIN,NIT,NFV,NFG,NFH
315      IF (ABS(IPRNT).GT.1) WRITE(6,'(1X,''ENTRY TO PLIS :'')')
316*
317*     INITIATION
318*
319      KBF=0
320      IF (NB.GT.0) KBF=2
321      NRES=0
322      NDEC=0
323      NIN=0
324      NIT=0
325      NFV=0
326      NFG=0
327      NFH=0
328      ISYS=0
329      ITES=1
330      MTESX=2
331      MTESF=2
332      INITS=2
333      ITERM=0
334      ITERD=0
335      ITERS=2
336      KTERS=3
337      IREST=0
338      IRES1=999
339      IRES2=0
340      MRED=10
341      MES=4
342      MES1=2
343      MES2=2
344      MES3=2
345      ETA0=1.0D-15
346      ETA9=1.0D 120
347      EPS8=1.00D 0
348      EPS9=1.00D-8
349      ALF1=1.0D-10
350      ALF2=1.0D 10
351      RMAX=ETA9
352      DMAX=ETA9
353      FMAX=1.0D 20
354      IF (IEST.LE.0) FMIN=-1.0D 60
355      IF (IEST.GT.0) IEST=1
356      IF (XMAX.LE.0.0D 0) XMAX=1.0D 16
357      IF (TOLX.LE.0.0D 0) TOLX=1.0D-16
358      IF (TOLF.LE.0.0D 0) TOLF=1.0D-14
359      IF (TOLG.LE.0.0D 0) TOLG=1.0D-6
360      IF (TOLB.LE.0.0D 0) TOLB=FMIN+1.0D-16
361      TOLD=1.0D-4
362      TOLS=1.0D-4
363      TOLP=0.8D 0
364      IF (MIT.LE.0) MIT=9000
365      IF (MFV.LE.0) MFV=9000
366      MFG=MFV
367      KD= 1
368      LD=-1
369      KIT=-(IRES1*NF+IRES2)
370      FO=FMIN
371*
372*     INITIAL OPERATIONS WITH SIMPLE BOUNDS
373*
374      IF (KBF.GT.0) THEN
375      DO 2 I = 1,NF
376      IF ((IX(I).EQ.3.OR.IX(I).EQ.4) .AND. XU(I).LE.XL(I)) THEN
377      XU(I) = XL(I)
378      IX(I) = 5
379      ELSE IF (IX(I).EQ.5 .OR. IX(I).EQ.6) THEN
380      XL(I) = X(I)
381      XU(I) = X(I)
382      IX(I) = 5
383      END IF
384    2 CONTINUE
385      CALL PCBS04(NF,X,IX,XL,XU,EPS9,KBF)
386      CALL PYADC0(NF,N,X,IX,XL,XU,INEW)
387      END IF
388      IF (ITERM.NE.0) GO TO 11190
389      CALL OBJ(NF,X,F)
390      NFV=NFV+1
391      CALL DOBJ(NF,X,GF)
392      NFG=NFG+1
39311120 CONTINUE
394      CALL PYTRCG(NF,NF,IX,GF,UMAX,GMAX,KBF,IOLD)
395      IF (ABS(IPRNT).GT.1)
396     & WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG='',I5,2X,
397     & ''F='', G16.9,2X,''G='',E10.3)') NIT,NFV,NFG,F,GMAX
398      CALL PYFUT1(NF,F,FO,UMAX,GMAX,DMAX,TOLX,TOLF,TOLB,TOLG,KD,
399     & NIT,KIT,MIT,NFV,MFV,NFG,MFG,NTESX,MTESX,NTESF,MTESF,ITES,
400     & IRES1,IRES2,IREST,ITERS,ITERM)
401      IF (ITERM.NE.0) GO TO 11190
402      IF (KBF.GT.0.AND.RMAX.GT.0.0D 0) THEN
403      CALL PYRMC0(NF,N,IX,GF,EPS8,UMAX,GMAX,RMAX,IOLD,IREST)
404      END IF
40511130 CONTINUE
406*
407*     DIRECTION DETERMINATION
408*
409      GNORM=SQRT(MXUDOT(NF,GF,GF,IX,KBF))
410      IF (IREST.NE.0) GO TO 12620
411      K=MIN(NIT-KIT,MF)
412      IF (K.LE.0) THEN
413      IREST=MAX(IREST,1)
414      GO TO 12620
415      END IF
416*
417*     DETERMINATION OF THE PARAMETER B
418*
419      B=MXUDOT(NF,XO,GO,IX,KBF)
420      IF (B.LE.0.0D 0) THEN
421      IREST=MAX(IREST,1)
422      GO TO 12620
423      END IF
424      UO(1)=1.0D 0/B
425      CALL MXUNEG(NF,GF,S,IX,KBF)
426      CALL MXDRCB(NF,K,XO,GO,UO,VO,S,IX,KBF)
427      A=MXUDOT(NF,GO,GO,IX,KBF)
428      IF (A.GT.0.0D 0) THEN
429      CALL MXVSCL(NF,B/A,S,S)
430      END IF
431      CALL MXDRCF(NF,K,XO,GO,UO,VO,S,IX,KBF)
432      SNORM=SQRT(MXUDOT(NF,S,S,IX,KBF))
433      K=MIN(K+1,MF)
434      CALL MXDRSU(NF,K,XO,GO,UO)
43512620 CONTINUE
436      ITERD=0
437      IF (IREST.NE.0) THEN
438*
439*     STEEPEST DESCENT DIRECTION
440*
441      CALL MXUNEG(NF,GF,S,IX,KBF)
442      SNORM=GNORM
443      IF (KIT.LT.NIT) THEN
444        NRES=NRES+1
445        KIT = NIT
446      ELSE
447        ITERM=-10
448        IF (ITERS.LT.0) ITERM=ITERS-5
449      END IF
450      END IF
451*
452*     TEST ON DESCENT DIRECTION AND PREPARATION OF LINE SEARCH
453*
454      IF (KD.GT.0) P=MXUDOT(NF,GF,S,IX,KBF)
455      IF (ITERD.LT.0) THEN
456        ITERM=ITERD
457      ELSE
458*
459*     TEST ON DESCENT DIRECTION
460*
461      IF (SNORM.LE.0.0D 0) THEN
462        IREST=MAX(IREST,1)
463      ELSE IF (P+TOLD*GNORM*SNORM.LE.0.0D 0) THEN
464        IREST=0
465      ELSE
466*
467*     UNIFORM DESCENT CRITERION
468*
469      IREST=MAX(IREST,1)
470      END IF
471      IF (IREST.EQ.0) THEN
472*
473*     PREPARATION OF LINE SEARCH
474*
475        NRED = 0
476        RMIN=ALF1*GNORM/SNORM
477        RMAX=MIN(ALF2*GNORM/SNORM,XMAX/SNORM)
478      END IF
479      END IF
480      IF (ITERM.NE.0) GO TO 11190
481      IF (IREST.NE.0) GO TO 11130
482      CALL PYTRCS(NF,X,IX,XO,XL,XU,GF,GO,S,RO,FP,FO,F,PO,P,RMAX,ETA9,
483     & KBF)
484      IF (RMAX.EQ.0.0D 0) GO TO 11175
48511170 CONTINUE
486      CALL PS1L01(R,RP,F,FO,FP,P,PO,PP,FMIN,FMAX,RMIN,RMAX,
487     & TOLS,TOLP,PAR1,PAR2,KD,LD,NIT,KIT,NRED,MRED,MAXST,IEST,
488     & INITS,ITERS,KTERS,MES,ISYS)
489      IF (ISYS.EQ.0) GO TO 11174
490      CALL MXUDIR(NF,R,S,XO,X,IX,KBF)
491      CALL PCBS04(NF,X,IX,XL,XU,EPS9,KBF)
492      CALL OBJ(NF,X,F)
493      NFV=NFV+1
494      CALL DOBJ(NF,X,GF)
495      NFG=NFG+1
496      P=MXUDOT(NF,GF,S,IX,KBF)
497      GO TO 11170
49811174 CONTINUE
499      IF (ITERS.LE.0) THEN
500      R=0.0D 0
501      F=FO
502      P=PO
503      CALL MXVCOP(NF,XO,X)
504      CALL MXVCOP(NF,GO,GF)
505      IREST=MAX(IREST,1)
506      LD=KD
507      GO TO 11130
508      END IF
509      CALL PYTRCD(NF,X,IX,XO,GF,GO,R,F,FO,P,PO,DMAX,KBF,KD,LD,ITERS)
51011175 CONTINUE
511      IF (KBF.GT.0) THEN
512      CALL MXVINE(NF,IX)
513      CALL PYADC0(NF,N,X,IX,XL,XU,INEW)
514      END IF
515      GO TO 11120
51611190 CONTINUE
517      IF (IPRNT.GT.1.OR.IPRNT.LT.0)
518     & WRITE(6,'(1X,''EXIT FROM PLIS :'')')
519      IF (IPRNT.NE.0)
520     & WRITE (6,'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG='',I5,2X,
521     & ''F='', G16.9,2X,''G='',E10.3,2X,''ITERM='',I3)') NIT,NFV,NFG,
522     & F,GMAX,ITERM
523      IF (IPRNT.LT.0)
524     & WRITE (6,'(1X,''X='',5(G14.7,1X):/(3X,5(G14.7,1X)))')
525     & (X(I),I=1,NF)
526      RETURN
527      END
528