src/algs/luksan/plis.for

   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
 393 11120 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
 405 11130 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)
 435 12620 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
 485 11170 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
 498 11174 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)
 510 11175 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
 516 11190 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