C ALGORITHM 811, COLLECTED ALGORITHMS FROM ACM. C THIS WORK PUBLISHED IN TRANSACTIONS ON MATHEMATICAL SOFTWARE, C VOL. 27,NO. 2, June, 2001, P. 193--213. #! /bin/sh # This is a shell archive, meaning: # 1. Remove everything above the #! /bin/sh line. # 2. Save the resulting text in a file. # 3. Execute the file with /bin/sh (not csh) to create the files: # Doc/ # Doc/makefile # Doc/pbun.txt # Doc/pmin.txt # Doc/pnew.txt # Doc/pvar.txt # Doc/readme.txt # Doc/routinedoc.tex # Fortran/ # Fortran/Dp/ # Fortran/Dp/Drivers/ # Fortran/Dp/Drivers/data1 # Fortran/Dp/Drivers/driver1.f # Fortran/Dp/Drivers/driver2.f # Fortran/Dp/Drivers/driver3.f # Fortran/Dp/Drivers/driver4.f # Fortran/Dp/Drivers/driver5.f # Fortran/Dp/Drivers/driver6.f # Fortran/Dp/Drivers/driver7.f # Fortran/Dp/Drivers/driver8.f # Fortran/Dp/Drivers/res1 # Fortran/Dp/Drivers/res2 # Fortran/Dp/Drivers/res3 # Fortran/Dp/Drivers/res4 # Fortran/Dp/Drivers/res5 # Fortran/Dp/Drivers/res6 # Fortran/Dp/Drivers/res7 # Fortran/Dp/Drivers/res8 # Fortran/Dp/Drivers/subs.f # Fortran/Dp/Src/ # Fortran/Dp/Src/src.f # This archive created: Tue Nov 13 09:58:10 2001 export PATH; PATH=/bin:$PATH if test ! -d 'Doc' then mkdir 'Doc' fi cd 'Doc' if test -f 'makefile' then echo shar: will not over-write existing file "'makefile'" else cat << "SHAR_EOF" > 'makefile' OBJS = src.o subs.o all: res1 res2 res3 res4 res5 res6 res7 res8 res2: driver2.o ${OBJS} ${FC} ${FFLAGS} tbunu.o ${OBJS} a.out < data1 > $@ res1: driver1.o ${OBJS} ${FC} ${FFLAGS} tbunl.o ${OBJS} a.out > $@ res4: driver4.o ${OBJS} ${FC} ${FFLAGS} tminu.o ${OBJS} a.out < data1 > $@ res3: driver3.o ${OBJS} ${FC} ${FFLAGS} tminl.o ${OBJS} a.out > $@ res6: driver6.o ${OBJS} ${FC} ${FFLAGS} tnewu.o ${OBJS} a.out < data1 > $@ res5: driver5.o ${OBJS} ${FC} ${FFLAGS} tnewl.o ${OBJS} a.out > $@ res8: driver8.o ${OBJS} ${FC} ${FFLAGS} tnewu.o ${OBJS} a.out < data1 > $@ res7: driver7.o ${OBJS} ${FC} ${FFLAGS} tnewl.o ${OBJS} a.out > $@ SHAR_EOF fi # end of overwriting check if test -f 'pbun.txt' then echo shar: will not over-write existing file "'pbun.txt'" else cat << "SHAR_EOF" > 'pbun.txt' *********************************************************************** * * * PBUN - A PROXIMAL BUNDLE ALGORITHM FOR NONSMOOTH * * OPTIMIZATION. * * * *********************************************************************** 1. Introduction: ---------------- The double-precision FORTRAN 77 basic subroutine PBUN is designed to find a close approximation to a local minimum of a nonlinear nonsmooth function F(X) with simple bounds on variables and general linear constraints. Here X is a vector of N variables and F(X), is assumed to be a locally Lipschitz continuous function. Simple bounds are assumed in the form X(I) unbounded if IX(I) = 0, XL(I) <= X(I) if IX(I) = 1, X(I) <= XU(I) if IX(I) = 2, XL(I) <= X(I) <= XU(I) if IX(I) = 3, XL(I) = X(I) = XU(I) if IX(I) = 5, where 1 <= I <= N. General linear constraints are assumed in the form C(I) unbounded if IC(I) = 0, CL(I) <= C(I) if IC(I) = 1, C(I) <= CU(I) if IC(I) = 2, CL(I) <= C(I) <= CU(I) if IC(I) = 3, CL(I) = C(I) = CU(I) if IC(I) = 5, where C(I) = A_I * X, 1 <= I <= NC, are linear functions. To simplify user's work, three additional easy to use subroutines are added. They call the basic general subroutine PBUN: PBUNU - unconstrained nonsmooth optimization, PBUNS - nonsmooth optimization with simple bounds, PBUNL - nonsmooth optimization with simple bounds and general linear constraints. All subroutines contain a description of formal parameters and extensive comments. Furthermore, two test programs TBUNU and TBUNL are included, which contain several test problems (see [4]). These test programs serve as examples for using the subroutines, verify their correctness and demonstrate their efficiency. In this short guide, we describe all subroutines which can be called from the user's program. A detailed description of methods is given in [2] and [3]. In the description of formal parameters, we introduce a type of the argument that specifies whether the argument must have a value defined on entry to the subroutine (I), whether it is a value which will be returned (O), or both (U), or whether it is an auxiliary value (A). Note that the arguments of the type I can be changed on output under some circumstances, especially if improper input values were given. Besides formal parameters, we can use a COMMON /STAT/ block containing statistical information. This block, used in each subroutine, has the following form: COMMON /STAT/ NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH The arguments have the following meaning: Argument Type Significance ---------------------------------------------------------------------- NDECF O Positive INTEGER variable that indicates the number of matrix decompositions. NRES O Positive INTEGER variable that indicates the number of restarts. NRED O Positive INTEGER variable that indicates the number of reductions. NREM O Positive INTEGER variable that indicates the number of constraint deletions during the QP solutions. NADD O Positive INTEGER variable that indicates the number of constraint additions during the QP solutions. NIT O Positive INTEGER variable that indicates the number of iterations. NFV O Positive INTEGER variable that indicates the number of function evaluations. NFG O Positive INTEGER variable that specifies the number of gradient evaluations. NFH O Positive INTEGER variable that specifies the number of Hessian evaluations. 2. Subroutines PBUNU, PBUNS, PBUNL: ----------------------------------- The calling sequences are CALL PBUNU(NF,NA,X,IA,RA,IPAR,RPAR,FP,GMAX,ITERM) CALL PBUNS(NF,NA,NB,X,IX,XL,XU,IA,RA,IPAR,RPAR,FP,GMAX,ITERM) CALL PBUNL(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,IA,RA,IPAR, & RPAR,FP,GMAX,ITERM) The arguments have the following meaning. Argument Type Significance ---------------------------------------------------------------------- NF I Positive INTEGER variable that specifies the number of variables of the objective function. NA I Nonnegative INTEGER variable that specifies the maximum bundle dimension. The choice NA=0 causes that the default value NA=NF+3 will be taken. NB I Nonnegative INTEGER variable that specifies whether the simple bounds are suppressed (NB=0) or accepted (NB>0). NC I Nonnegative INTEGER variable that specifies the number of linear constraints; if NC=0 the linear constraints are suppressed. X(NF) U On input, DOUBLE PRECISION vector with the initial estimate to the solution. On output, the approximation to the minimum. IX(NF) I On input (significant only if NB>0) INTEGER vector containing the simple bounds types: IX(I)=0 - the variable X(I) is unbounded, IX(I)=1 - the lower bound X(I) >= XL(I), IX(I)=2 - the upper bound X(I) <= XU(I), IX(I)=3 - the two side bound XL(I) <= X(I) <= XU(I), IX(I)=5 - the variable X(I) is fixed (given by its initial estimate). XL(NF) I DOUBLE PRECISION vector with lower bounds for variables (significant only if NB>0). XU(NF) I DOUBLE PRECISION vector with upper bounds for variables (significant only if NB>0). CF(NC) A DOUBLE PRECISION vector which contains values of constraint functions (only if NC>0). IC(NC) I On input (significant only if NC>0) INTEGER vector which contains constraint types: IC(K)=0 - the constraint CF(K) is not used, IC(K)=1 - the lower constraint CF(K) >= CL(K), IC(K)=2 - the upper constraint CF(K) <= CU(K), IC(K)=3 - the two side constraint CL(K) <= CF(K) <= CU(K), IC(K)=5 - the equality constraint CF(K) = CL(K). CL(NC) I DOUBLE PRECISION vector with lower bounds for constraint functions (significant only if NC>0). CU(NC) I DOUBLE PRECISION vector with upper bounds for constraint functions (significant only if NC>0). CG(NF*NC) I DOUBLE PRECISION matrix whose columns are normals of the linear constraints (significant only if NC>0). IA(NIA) A INTEGER working array of the dimension of at least NIA=NF+NA+1. RA(NRA) A DOUBLE PRECISION working array of the dimension of at least NRA=NF*(NF+1)/2+NF*(NA+5)+5*NA+4. IPAR(7) A INTEGER parameters: IPAR(1)=MET, IPAR(2)=MES, IPAR(3)=MTESX, IPAR(4)=MTESF, IPAR(5)=MIT, IPAR(6)=MFV, IPAR(7)=IPRNT. Parameters MET, MES, MTESX, MTESF, MIT, MFV, IPRNT are described in Section 3 together with other parameters of the subroutine PBUN. RPAR(9) A DOUBLE PRECISION parameters: RPAR(1)=TOLX, RPAR(2)=TOLF, RPAR(3)=TOLB, RPAR(4)=TOLG, RPAR(5)=TOLD, RPAR(6)=TOLS, RPAR(7)=TOLP. RPAR(8)=ETA, RPAR(9)=XMAX. Parameters TOLX, TOLF, TOLB, TOLG, TOLD, TOLS, TOLP, ETA, XMAX are described in Section 3 together with other parameters of the subroutine PBUN. FP O DOUBLE PRECISION value of the objective function at the solution X. GMAX O DOUBLE PRECISION maximum absolute value of a partial derivative of the Lagrangian function. ITERM O INTEGER variable that indicates the cause of termination: ITERM= 1 - if |X - XO| was less than or equal to TOLX in MTESX subsequent iterations, ITERM= 2 - if |F - FO| was less than or equal to TOLF in MTESF subsequent iterations, ITERM= 3 - if F is less than or equal to TOLB, ITERM= 4 - if GMAX is less than or equal to TOLG, ITERM=11 - if NFV exceeded MFV, ITERM=12 - if NIT exceeded MIT, ITERM< 0 - if the method failed. The subroutines PBUNU, PBUNS, PBUNL require the user supplied subroutine FUNDER that defines the objective function and its subgradient and has the form SUBROUTINE FUNDER(NF,X,F,G) The arguments of the user supplied subroutine have the following meaning. Argument Type Significance ---------------------------------------------------------------------- NF I Positive INTEGER variable that specifies the number of variables of the objective function. X(NF) I DOUBLE PRECISION an estimate to the solution. F O DOUBLE PRECISION value of the objective function at the point X. G(NF) O DOUBLE PRECISION subgradient of the objective function at the point X. 3. Subroutine PBUN: ------------------- This general subroutine is called from all the subroutines described in Section 2. The calling sequence is CALL PBUN(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,AF,IA,AFD,AG, & IAA,AR,AZ,G,H,S,XO,GO,XS,GS,TOLX,TOLF,TOLB,TOLG,TOLD,TOLS,TOLP, & ETA,XMAX,GMAX,FP,MET,MES,MTESX,MTESF,MIT,MFV,IPRNT,ITERM). The arguments NF, NA, NB, NC, X, IX, XL, XU, CF, IC, CL, CU, CG, GMAX, FP, ITERM, have the same meaning as in Section 2. Other arguments have the following meaning: Argument Type Significance --------------------------------------------------------------------- AF(4*NA) A DOUBLE PRECISION vector of bundle function values. IA(NA) A INTEGER vector containing types of bundle functions. AFD(NA) A DOUBLE PRECISION vector of bundle function increments. AG(NF*NA) A DOUBLE PRECISION matrix whose columns are bundle gradients. IAA(NA) A INTEGER vector containing indices of active functions. AR(NAR) A DOUBLE PRECISION matrix containing triangular decomposition of the orthogonal projection kernel (NAR is equal to NF*(NF+1)/2). AZ(NF+1) A DOUBLE PRECISION vector of Lagrange multipliers. G(NF) A DOUBLE PRECISION subgradient of the objective function. H(NF) A DOUBLE PRECISION diagonal matrix of weight parameters. S(NF+1) A DOUBLE PRECISION direction vector. XO(NF) A DOUBLE PRECISION vector which contains increments of variables. GO(NF+1) A DOUBLE PRECISION gradient of the Lagrangian function. XS(NF) A DOUBLE PRECISION auxiliary vector. GS(NF) A DOUBLE PRECISION auxiliary vector. TOLX I DOUBLE PRECISION tolerance for the change of the coordinate vector X; the choice TOLX=0 causes that the default value TOLX=1.0D-16 will be taken. TOLF I DOUBLE PRECISION tolerance for the change of function values; the choice TOLF=0 causes that the default value TOLF=1.0D-8 will be taken. TOLB I DOUBLE PRECISION minimum acceptable function value; the choice TOLB=0 causes that the default value TOLB=-1.0D60 will be taken. TOLG I DOUBLE PRECISION tolerance for the Lagrangian function gradient; the choice TOLG=0 causes that the default value TOLG=1.0D-6 will be taken. TOLD I DOUBLE PRECISION tolerance for a descent direction; the choice TOLD= 0 causes that the default value TOLD=1.0D-4 will be taken. TOLS I DOUBLE PRECISION tolerance parameter for a function decrease in a line search; the choice TOLS=0 causes that the default value TOLS=1.0D-2 will be taken. TOLP I DOUBLE PRECISION tolerance parameter for a significant modification of the next line search direction; the choice TOLP=0 causes that the default value TOLP=0.5D0 will be taken. ETA I DOUBLE PRECISION distance measure parameter. XMAX I DOUBLE PRECISION maximum stepsize; the choice XMAX=0 causes that the default value 1.0D3 will be taken. MET I INTEGER variable that specifies the weight updating method: MET=1 - quadratic interpolation, MET=2 - local minimization, MET=3 - quasi-Newton condition. The choice MET=0 causes that the default value MET=1 will be taken. MES I INTEGER variable that specifies the interpolation method selection in a line search: MES=1 - bisection, MES=2 - two point quadratic interpolation, MES=3 - three point quadratic interpolation, MES=4 - three point cubic interpolation. The choice MES=0 causes that the default value MES=1 will be taken. MTESX I INTEGER variable that specifies the maximum number of iterations with changes of the coordinate vector X smaller than TOLX; the choice MTESX=0 causes that the default value MTESX=20 will be taken. MTESF I INTEGER variable that specifies the maximum number of iterations with changes of function values smaller than TOLF; the choice MTESF=0 causes that the default value MTESF=2 will be taken. MIT I INTEGER variable that specifies the maximum number of iterations; the choice MIT=0 causes that the default value 200 will be taken. MFV I INTEGER variable that specifies the maximum number of function evaluations; the choice |MFV|=0 causes that the default value 500 will be taken. IPRNT I INTEGER variable that specifies PRINT: IPRNT= 0 - print is suppressed, IPRNT= 1 - basic print of final results, IPRNT=-1 - extended print of final results, IPRNT= 2 - basic print of intermediate and final results, IPRNT=-2 - extended print of intermediate and final results. The subroutine PBUN has a modular structure. The following list contains its most important subroutines: PDDBQ1 - Determination of the descent direction using quadratic programming subroutine and bundle updating. PLQDF1 - Dual range space method for solving a quadratic programming subproblem with linear constraints (see [1]). PS1L05 - Line search using function values and derivatives. The subroutine PBUN requires the user supplied subroutine FUNDER which is described in Section 2. 4. Subroutine PLQDF1: --------------------- Since the dual range space method for special quadratic programming subproblems arising in bundle type nonsmooth optimization can be used separately in many applications (e.g. in minimax optimization), we describe the subroutine PLQDF1 in more details. The calling sequence is CALL PLQDF1(NF,NA,NC,X,IX,XL,XU,AF,AFD,IA,IAA,AG,AR,AZ, & CF,IC,CL,CU,CG,G,H,S,MFP,KBF,KBC,IDECF,ETA0,ETA2,ETA9, & EPS7,EPS9,XNORM,UMAX,GMAX,N,ITERQ) The arguments NF, NA, NC, X, IX, XL, XU, AF, CF, IC, CL, CU, CG have the same meaning as in Section 2 (only with the difference that the arguments X and AF are of the type (I), i.e. they must have a value defined on entry to PLQDF1 and they are not changed). The arguments AFD, IA, IAA, AG, AR, AZ have the same meaning as in Section 3 (only with the difference that the arguments AFD, IAA, AR, AZ are of the type (O), i.e. their values can be used subsequently). Other arguments have the following meaning: Argument Type Significance --------------------------------------------------------------------- G(NF+1) O DOUBLE PRECISION gradient of the Lagrangian function. H(NH) U DOUBLE PRECISION Choleski decomposition of the approximate Hessian (NH is equal to NF*(NF+1)/2). S(NF+1) O DOUBLE PRECISION direction vector. MFP I INTEGER variable that specifies the type of the computed point. MFP=1 - computation is terminated whenever an arbitrary feasible point is found, MFP=2 - computation is terminated whenever an optimum feasible point is found, MFP=3 - computation starts from the previously reached point and is terminated whenever an optimum feasible point is found. KBF I INTEGER variable that specifies simple bounds on variables. KBF=0 - simple bounds are suppressed, KBF=1 - one sided simple bounds, KBF=2 - two sided simple bounds. KBC I INTEGER variable that specifies general linear constraints. KBC=0 - linear constraints are suppressed, KBC=1 - one sided linear constraints, KBC=2 - two sided linear constraints. IDECF U INTEGER variable that specifies the type of matrix decomposition. IDECF= 0 - no decomposition, IDECF= 1 - Choleski decomposition, IDECF= 9 - inversion, IDECF=10 - diagonal matrix. ETA0 I DOUBLE PRECISION machine precision (the recommended value is 1.0D-15. ETA2 I DOUBLE PRECISION tolerance for positive definiteness in the Choleski decomposition. ETA9 I DOUBLE PRECISION maximum floating point number. EPS7 I DOUBLE PRECISION tolerance for linear independence of constraints (the recommended value is 1.0D-10). EPS9 I DOUBLE PRECISION tolerance for the definition of active constraints (the recommended value is 1.0D-8). XNORM O DOUBLE PRECISION value of the linearized minimax function. UMAX O DOUBLE PRECISION maximum absolute value of the negative Lagrange multiplier. GMAX O DOUBLE PRECISION infinity norm of the gradient of the Lagrangian function. N O INTEGER dimension of a manifold defined by active constraints. ITERQ O INTEGER variable that indicates the type of the computed feasible point. ITERQ= 1 - an arbitrary feasible point was found, ITERQ= 2 - the optimum feasible point was found, ITERQ=-1 - an arbitrary feasible point does not exist, ITERQ=-2 - the optimum feasible point does not exist. 5. Form of printed results: --------------------------- The form of printed results is specified by the parameter IPRNT as is described in Section 3. Here we demonstrate individual forms of printed results by the simple use of the program TBUNU described in the next section (with NEXT=9). If we set IPRNT=1, then the printed results will have the form NIT= 13 NFV= 15 NFG= 15 F= -.10000000D+01 G= .9859D-07 ITERM= 4 If we set IPRNT=-1, then the printed results will have the form EXIT FROM PBUN : NIT= 13 NFV= 15 NFG= 15 F= -.10000000D+01 G= .9859D-07 ITERM= 4 X= .1000000D+01 .0000000D+00 If we set IPRNT=2, then the printed results will have the form ENTRY TO PBUN : NIT= 0 NFV= 1 NFG= 1 F= .00000000D+00 G= .1000D+61 NIT= 1 NFV= 3 NFG= 3 F= -.37888889D+00 G= .8500D+01 NIT= 2 NFV= 4 NFG= 4 F= -.60615144D+00 G= .9333D+00 NIT= 3 NFV= 5 NFG= 5 F= -.60615144D+00 G= .8024D+00 NIT= 4 NFV= 6 NFG= 6 F= -.72848266D+00 G= .8024D+00 NIT= 5 NFV= 7 NFG= 7 F= -.72848266D+00 G= .3478D+00 NIT= 6 NFV= 8 NFG= 8 F= -.82757096D+00 G= .7222D+00 NIT= 7 NFV= 9 NFG= 9 F= -.84360358D+00 G= .1618D+00 NIT= 8 NFV= 10 NFG= 10 F= -.99860813D+00 G= .9839D-01 NIT= 9 NFV= 11 NFG= 11 F= -.99860813D+00 G= .1141D+00 NIT= 10 NFV= 12 NFG= 12 F= -.99928519D+00 G= .5014D+00 NIT= 11 NFV= 13 NFG= 13 F= -.99999999D+00 G= .5301D-01 NIT= 12 NFV= 14 NFG= 14 F= -.99999999D+00 G= .2704D-06 NIT= 13 NFV= 15 NFG= 15 F= -.10000000D+01 G= .9859D-07 EXIT FROM PBUN : NIT= 13 NFV= 15 NFG= 15 F= -.10000000D+01 G= .9859D-07 ITERM= 4 If we set IPRNT=-2, then the printed results will have the form ENTRY TO PBUN : NIT= 0 NFV= 1 NFG= 1 F= .00000000D+00 G= .1000D+61 NIT= 1 NFV= 3 NFG= 3 F= -.37888889D+00 G= .8500D+01 NIT= 2 NFV= 4 NFG= 4 F= -.60615144D+00 G= .9333D+00 NIT= 3 NFV= 5 NFG= 5 F= -.60615144D+00 G= .8024D+00 NIT= 4 NFV= 6 NFG= 6 F= -.72848266D+00 G= .8024D+00 NIT= 5 NFV= 7 NFG= 7 F= -.72848266D+00 G= .3478D+00 NIT= 6 NFV= 8 NFG= 8 F= -.82757096D+00 G= .7222D+00 NIT= 7 NFV= 9 NFG= 9 F= -.84360358D+00 G= .1618D+00 NIT= 8 NFV= 10 NFG= 10 F= -.99860813D+00 G= .9839D-01 NIT= 9 NFV= 11 NFG= 11 F= -.99860813D+00 G= .1141D+00 NIT= 10 NFV= 12 NFG= 12 F= -.99928519D+00 G= .5014D+00 NIT= 11 NFV= 13 NFG= 13 F= -.99999999D+00 G= .5301D-01 NIT= 12 NFV= 14 NFG= 14 F= -.99999999D+00 G= .2704D-06 NIT= 13 NFV= 15 NFG= 15 F= -.10000000D+01 G= .9859D-07 EXIT FROM PBUN : NIT= 13 NFV= 15 NFG= 15 F= -.10000000D+01 G= .9859D-07 ITERM= 4 X= .1000000D+01 .0000000D+00 6. Verification of the subroutines: ----------------------------------- Subroutine PBUNU can be verified and tested using the program TBUNU. This program calls the subroutines TIUD19 (initiation), TFFU19 (function evaluation) and TFGU19 (subgradient evaluation) containing 20 academic test problems with at most 50 variables [4]. The results obtained by the program TBUNU on a PC computer with Microsoft Power Station Fortran compiler have the following form. NIT= 42 NFV= 45 NFG= 45 F= .38117065D-06 G= .1135D-02 ITERM= 2 NIT= 18 NFV= 20 NFG= 20 F= -.22203912D-16 G= .8975D-08 ITERM= 2 NIT= 31 NFV= 33 NFG= 33 F= .19522245D+01 G= .3085D-03 ITERM= 2 NIT= 14 NFV= 16 NFG= 16 F= .20000000D+01 G= .1921D-06 ITERM= 2 NIT= 17 NFV= 19 NFG= 19 F= -.30000000D+01 G= .5564D-08 ITERM= 4 NIT= 13 NFV= 15 NFG= 15 F= .72000015D+01 G= .2212D-02 ITERM= 4 NIT= 11 NFV= 12 NFG= 12 F= -.14142136D+01 G= .1437D-04 ITERM= 4 NIT= 66 NFV= 68 NFG= 68 F= -.99999941D+00 G= .1089D-02 ITERM= 4 NIT= 13 NFV= 15 NFG= 15 F= -.10000000D+01 G= .9859D-07 ITERM= 4 NIT= 43 NFV= 46 NFG= 46 F= -.80000000D+01 G= .1282D-02 ITERM= 4 NIT= 43 NFV= 45 NFG= 45 F= -.43999999D+02 G= .3734D-02 ITERM= 2 NIT= 27 NFV= 29 NFG= 29 F= .22600162D+02 G= .1451D-03 ITERM= 4 NIT= 60 NFV= 62 NFG= 62 F= -.32348679D+02 G= .2190D-02 ITERM= 2 NIT= 117 NFV= 118 NFG= 118 F= -.29196928D+01 G= .1683D-02 ITERM= 2 NIT= 92 NFV= 93 NFG= 93 F= .55981567D+00 G= .8266D-03 ITERM= 4 NIT= 74 NFV= 75 NFG= 75 F= -.84140829D+00 G= .7236D-03 ITERM= 2 NIT= 157 NFV= 159 NFG= 159 F= .97857727D+01 G= .6510D-03 ITERM= 2 NIT= 89 NFV= 94 NFG= 94 F= .16703858D+02 G= .3694D-02 ITERM= 2 NIT= 150 NFV= 151 NFG= 151 F= .16712381D-06 G= .7782D-04 ITERM= 2 NIT= 39 NFV= 40 NFG= 40 F= .12440973D-12 G= .2969D-01 ITERM= 2 The rows corresponding to individual test problems contain the number of iterations NIT, the number of function evaluations NFV, the number of gradient evaluations NFG, the final value of the objective function F, the value of the criterion for the termination G and the cause of termination ITERM. Subroutine PBUNL can be verified and tested using the program TBUNL. This program calls the subroutines TIUD22 (initiation), TAFU22 (function evaluation), TAGU22 (subgradient evaluation) containing 10 academic test problems with at most 20 variables [4]. The results obtained by the program TBUNL on a PC computer with Microsoft Power Station Fortran compiler have the following form. NIT= 10 NFV= 11 NFG= 11 F= -.38965952D+00 G= .4532D-04 ITERM= 4 NIT= 4 NFV= 5 NFG= 5 F= -.33035714D+00 G= .3220D-14 ITERM= 4 NIT= 8 NFV= 10 NFG= 10 F= -.44891079D+00 G= .6982D-03 ITERM= 4 NIT= 79 NFV= 80 NFG= 80 F= -.42928061D+00 G= .7703D-05 ITERM= 2 NIT= 16 NFV= 17 NFG= 17 F= -.18596138D+01 G= .2017D-09 ITERM= 2 NIT= 16 NFV= 17 NFG= 17 F= .10183089D+00 G= .1272D-06 ITERM= 2 NIT= 43 NFV= 44 NFG= 44 F= .28724436D-08 G= .1966D-07 ITERM= 2 NIT= 74 NFV= 76 NFG= 76 F= .24306219D+02 G= .5835D-02 ITERM= 4 NIT= 140 NFV= 143 NFG= 143 F= .13372840D+03 G= .2872D-01 ITERM= 2 NIT= 65 NFV= 68 NFG= 68 F= .50694798D+00 G= .3576D-04 ITERM= 2 References: ----------- [1] Luksan L.: Dual Method for Solving a Special Problem of Quadratic Programming as a Subproblem at Linearly Constrained Nonlinear Minimax Approximation. Kybernetika 20 (1984) 445-457. [2] Vlcek J.: Bundle Algorithms for Nonsmooth Unconstrained Minimization. Research Report V-608, Institute of Computer Science, Academy of Sciences of the Czech Republic, Prague, Czech Republic, 1995. [3] Luksan L., Vlcek J.: NDA: Algorithms for Nondifferentiable Optimization. Research Report V-797, Institute of Computer Science, Academy of Sciences of the Czech Republic, Prague, Czech Republic, 2000. [4] Luksan L., Vlcek J.: Subroutines for Testing Nonsmooth Unconstrained and Linearly Constrained Optimization Problems. Research Report V-798, Institute of Computer Science, Academy of Sciences of the Czech Republic, Prague, Czech Republic, 2000.  SHAR_EOF fi # end of overwriting check if test -f 'pmin.txt' then echo shar: will not over-write existing file "'pmin.txt'" else cat << "SHAR_EOF" > 'pmin.txt' *********************************************************************** * * * PMIN - A RECURSUVE QUADRATIC PROGRAMMING VARIABLE * * METRIC ALGORITHM FOR MINIMAX OPTIMIZATION. * * * *********************************************************************** 1. Introduction: ---------------- The double-precision FORTRAN 77 basic subroutine PMIN is designed to find a close approximation to a local minimum of a special objective function F(X) = MAX ( F_I(X) ) , 1 <= i <= NA with simple bounds on variables and general linear constraints. Here X is a vector of N variables and F_I(X), 1 <= I <= NA, are twice continuously differentiable functions. Simple bounds are assumed in the form X(I) unbounded if IX(I) = 0, XL(I) <= X(I) if IX(I) = 1, X(I) <= XU(I) if IX(I) = 2, XL(I) <= X(I) <= XU(I) if IX(I) = 3, XL(I) = X(I) = XU(I) if IX(I) = 5, where 1 <= I <= N. General linear constraints are assumed in the form C(I) unbounded if IC(I) = 0, CL(I) <= C(I) if IC(I) = 1, C(I) <= CU(I) if IC(I) = 2, CL(I) <= C(I) <= CU(I) if IC(I) = 3, CL(I) = C(I) = CU(I) if IC(I) = 5, where C(I) = A_I*X, 1 <= I <= NC, are linear functions. To simplify user's work, three additional easy to use subroutines are added. They call the basic general subroutine PMIN: PMINU - unconstrained minimax optimization, PMINS - minimax optimization with simple bounds, PMINL - minimax optimization with simple bounds and general linear constraints. All subroutines contain a description of formal parameters and extensive comments. Furthermore, two test programs TMINU and TMINL are included, which contain several test problems (see e.g. [4]). These test programs serve as examples for using the subroutines, verify their correctness and demonstrate their efficiency. In this short guide, we describe all subroutines which can be called from the user's program. A detailed description of methods is given in [2] and [3]. In the description of formal parameters, we introduce a type of the argument that specifies whether the argument must have a value defined on entry to the subroutine (I), whether it is a value which will be returned (O), or both (U), or whether it is an auxiliary value (A). Note that the arguments of the type I can be changed on output under some circumstances, especially if improper input values were given. Besides formal parameters, we can use a COMMON /STAT/ block containing statistical information. This block, used in each subroutine has the following form: COMMON /STAT/ NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH The arguments have the following meaning: Argument Type Significance ---------------------------------------------------------------------- NDECF O Positive INTEGER variable that indicates the number of matrix decompositions. NRES O Positive INTEGER variable that indicates the number of restarts. NRED O Positive INTEGER variable that indicates the number of reductions. NREM O Positive INTEGER variable that indicates the number of constraint deletions during the QP solutions. NADD O Positive INTEGER variable that indicates the number of constraint additions during the QP solutions. NIT O Positive INTEGER variable that indicates the number of iterations. NFV O Positive INTEGER variable that indicates the number of function evaluations. NFG O Positive INTEGER variable that specifies the number of gradient evaluations. NFH O Positive INTEGER variable that specifies the number of Hessian evaluations. 2. Subroutines PMINU, PMINS, PMINL: ----------------------------------- The calling sequences are CALL PMINU(NF,NA,X,AF,IA,RA,IPAR,RPAR,F,GMAX,IEXT,ITERM) CALL PMINS(NF,NA,NB,X,IX,XL,XU,AF,IA,RA,IPAR,RPAR,F, & GMAX,IEXT,ITERM) CALL PMINL(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,AF, & IA,RA,IPAR,RPAR,F,GMAX,IEXT,ITERM) The arguments have the following meaning. Argument Type Significance ---------------------------------------------------------------------- NF I Positive INTEGER variable that specifies the number of variables of the objective function. NA I Nonnegative INTEGER variable that specifies the number of functions in the minimax criterion. NB I Nonnegative INTEGER variable that specifies whether the simple bounds are suppressed (NB=0) or accepted (NB>0). NC I Nonnegative INTEGER variable that specifies the number of linear constraints; if NC=0 the linear constraints are suppressed. X(NF) U On input, DOUBLE PRECISION vector with the initial estimate to the solution. On output, the approximation to the minimum. IX(NF) I On input (significant only if NB>0) INTEGER vector containing the simple bounds types: IX(I)=0 - the variable X(I) is unbounded, IX(I)=1 - the lower bound X(I) >= XL(I), IX(I)=2 - the upper bound X(I) <= XU(I), IX(I)=3 - the two side bound XL(I) <= X(I) <= XU(I), IX(I)=5 - the variable X(I) is fixed (given by its initial estimate). XL(NF) I DOUBLE PRECISION vector with lower bounds for variables (significant only if NB>0). XU(NF) I DOUBLE PRECISION vector with upper bounds for variables (significant only if NB>0). CF(NC) A DOUBLE PRECISION vector which contains values of constraint functions (only if NC>0). IC(NC) I On input (significant only if NC>0) INTEGER vector which contains constraint types: IC(K)=0 - the constraint CF(K) is not used, IC(K)=1 - the lower constraint CF(K) >= CL(K), IC(K)=2 - the upper constraint CF(K) <= CU(K), IC(K)=3 - the two side constraint CL(K) <= CF(K) <= CU(K), IC(K)=5 - the equality constraint CF(K) = CL(K). CL(NC) I DOUBLE PRECISION vector with lower bounds for constraint functions (significant only if NC>0). CU(NC) I DOUBLE PRECISION vector with upper bounds for constraint functions (significant only if NC>0). CG(NF*NC) I DOUBLE PRECISION matrix whose columns are normals of the linear constraints (significant only if NC>0). AF(NA) O DOUBLE PRECISION vector which contains values of functions in the minimax criterion. IA(NIA) A INTEGER working array of the dimension of at least NIA=NF+NA+1. RA(NRA) A DOUBLE PRECISION working array of the dimension of at least NRA=(NF+NA+8)*NF+2*NA+4. IPAR(7) A INTEGER parameters: IPAR(1)=MET, IPAR(2)=MES, IPAR(3)=MEC, IPAR(4)=MER, IPAR(5)=MIT, IPAR(6)=MFV, IPAR(7)=IPRNT. Parameters MET, MEC, MER, MES, MIT, MFV, IPRNT are described in Section 3 together with other parameters of the subroutine PMIN. RPAR(7) A DOUBLE PRECISION parameters: RPAR(1)=TOLX, RPAR(2)=TOLF, RPAR(3)=TOLB, RPAR(4)=TOLG, RPAR(5)=TOLD, RPAR(6)=TOLS, RPAR(7)=XMAX. Parameters TOLX, TOLF, TOLB, TOLG, TOLD, TOLS, XMAX are described in Section 3 together with other parameters of the subroutine PMIN. F O DOUBLE PRECISION value of the objective function at the solution X. GMAX O DOUBLE PRECISION maximum absolute value of a partial derivative of the Lagrangian function. IEXT I INTEGER variable that specifies the minimax criterion: IEXT < 0 - maximum of positive values, IEXT = 0 - maximum of absolute values, IEXT > 0 - maximum of negative values. ITERM O INTEGER variable that indicates the cause of termination: ITERM= 1 - if |X - XO| was less than or equal to TOLX in MTESX subsequent iterations, ITERM= 2 - if |F - FO| was less than or equal to TOLF in MTESF subsequent iterations, ITERM= 3 - if F is less than or equal to TOLB, ITERM= 4 - if GMAX is less than or equal to TOLG, ITERM=11 - if NFV exceeded MFV, ITERM=12 - if NIT exceeded MIT, ITERM< 0 - if the method failed. The subroutines PMINU, PMINS, PMINL require the user supplied subroutines FUN and DER that define the values and the gradients of the functions in the minimax criterion and have the form SUBROUTINE FUN(NF,KA,X,FA) SUBROUTINE DER(NF,KA,X,GA) The arguments of user supplied subroutines have the following meaning. Argument Type Significance ---------------------------------------------------------------------- NF I Positive INTEGER variable that specifies the number of variables of the objective function. KA I Positive INTEGER variable that specifies the index of a function in the minimax criterion. X(NF) I DOUBLE PRECISION an estimate to the solution. FA O DOUBLE PRECISION value of a function with the index KA at the point X. GA(NF) O DOUBLE PRECISION gradient of a function with the index KA at the point X. 3. Subroutine PMIN: ------------------- This general subroutine is called from all the subroutines described in Section 2. The calling sequence is CALL PMIN(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,AF,IA,AFO,AFD, & GA,AG,IAA,AR,AZ,G,H,S,XO,GO,TOLX,TOLF,TOLB,TOLG,TOLD,TOLS, & XMAX,GMAX,F,IEXT,MET,MEC,MER,MES,MIT,MFV,IPRNT,ITERM). The arguments NF, NA, NB, NC, X, IX, XL, XU, CF, IC, CL, CU, CG, AF, GMAX, F, IEXT, ITERM, have the same meaning as in Section 2. Other arguments have the following meaning: Argument Type Significance --------------------------------------------------------------------- IA(NA) A INTEGER vector containing types of functions in the minimax criterion. AFO(NA) A DOUBLE PRECISION vector of saved values of functions in the minimax criterion. AFD(NA) A DOUBLE PRECISION vector of increments of functions in the minimax criterion. GA(NF) A DOUBLE PRECISION gradient of the selected function in the minimax criterion. AG(NF*NA) A DOUBLE PRECISION matrix whose columns are gradients of functions in the minimax criterion. IAA(NA) A INTEGER vector containing indices of active functions. AR(NAR) A DOUBLE PRECISION matrix containing triangular decomposition of the orthogonal projection kernel (NAR is equal to (NF+1)*(NF+2)/2). AZ(NF+1) A DOUBLE PRECISION vector of Lagrange multipliers. GF(NF) A DOUBLE PRECISION gradient of the Lagrangian function. H(NH) A DOUBLE PRECISION Hessian matrix of the Lagrangian function (NH is equal to NF*(NF+1)/2). S(NF+1) A DOUBLE PRECISION direction vector. XO(NF) A DOUBLE PRECISION vector which contains increments of variables. GO(NF+1) A DOUBLE PRECISION vector which contains increments of partial derivatives. TOLX I DOUBLE PRECISION tolerance for the change of the coordinate vector X; the choice TOLX=0 causes that the default value 1.0D-16 will be taken. TOLF I DOUBLE PRECISION tolerance for the change of function values; the choice TOLF=0 causes that the default value 1.0D-8 will be taken. TOLB I DOUBLE PRECISION minimum acceptable function value; the choice TOLB=0 causes that the default value -1.0D60 will be taken. TOLG I DOUBLE PRECISION tolerance for the Lagrangian function gradient; the choice TOLG=0 causes that the default value 1.0D-6 will be taken. TOLD I DOUBLE PRECISION tolerance for a descent direction; the choice TOLD= 0 causes that the default value 1.0D-4 will be taken. TOLS I DOUBLE PRECISION tolerance parameter for a function decrease in a line search; the choice TOLS=0 causes that the default value 1.0D-2 will be taken. XMAX I DOUBLE PRECISION maximum stepsize; the choice XMAX=0 causes that the default value 1.0D3 will be taken. MET I INTEGER variable that specifies self scaling for variable metric updates: MET=1 - self scaling is suppressed, MET=2 - self scaling is used only in the first iteration (initial self scaling), MET=3 - self scaling in controlled by a special procedure. The choice MET=0 causes that the default value MET=2 will be taken. MEC I INTEGER variable that specifies correction for variable metric updates if a negative curvature occurs: MEC=1 - correction is suppressed, MEC=2 - Powell's correction is used. The choice MEC=0 causes that the default value MEC=1 will be taken. MER I INTEGER variable that specifies restart after unsuccesfull variable metric updates: MER=0 - restart is suppressed, MER=1 - restart is performed. MES I INTEGER variable that specifies the interpolation method selection in a line search: MES=1 - bisection, MES=2 - two point quadratic interpolation, MES=3 - three point quadratic interpolation, MES=4 - three point cubic interpolation. The choice MES=0 causes that the default value MES=1 will be taken. MIT I INTEGER variable that specifies the maximum number of iterations; the choice MIT=0 causes that the default value 200 will be taken. MFV I INTEGER variable that specifies the maximum number of function evaluations; the choice |MFV|=0 causes that the default value 500 will be taken. IPRNT I INTEGER variable that specifies PRINT: IPRNT= 0 - print is suppressed, IPRNT= 1 - basic print of final results, IPRNT=-1 - extended print of final results, IPRNT= 2 - basic print of intermediate and final results, IPRNT=-2 - extended print of intermediate and final results. The subroutine PMIN has a modular structure. The following list contains its most important subroutines: PA1MX2 - Minimax criterion evaluation. PDDXQ1 - Determination of the descent direction using quadratic programming subroutine. PLQDF1 - Dual range space method for solving a quadratic programming subproblem with linear constraints (see [1]). PS0LA2 - Line search using only function values. PUDBG1 - The BFGS variable metric update applied to the Choleski decomposition of the approximate Hessian matrix. The subroutine PMIN requires the user supplied subroutines FUN and DER which are described in Section 2. 4. Subroutine PLQDF1: --------------------- Since the dual range space method for special quadratic programming subproblems arising in nonlinear minimax optimization can be used separately in many applications (e.g. in bundle-type methods for nonsmooth optimization), we describe the subroutine ULQDF1 in more details. The calling sequence is CALL PLQDF1(NF,NA,NC,X,IX,XL,XU,AF,AFD,IA,IAA,AG,AR,AZ, & CF,IC,CL,CU,CG,G,H,S,MFP,KBF,KBC,IDECF,ETA0,ETA2,ETA9, & EPS7,EPS9,XNORM,UMAX,GMAX,N,ITERQ) The arguments NF, NA, NC, X, IX, XL, XU, AF, CF, IC, CL, CU, CG have the same meaning as in Section 2 (only with the difference that the arguments X and AF are of the type (I), i.e. they must have a value defined on entry to ULQDF1 and they are not changed). The arguments AFD, IA, IAA, AG, AR, AZ have the same meaning as in Section 3 (only with the difference that the arguments AFD, IAA, AR, AZ are of the type (O), i.e. their values can be used subsequently). Other arguments have the following meaning: Argument Type Significance ---------------------------------------------------------------------- G(NF+1) O DOUBLE PRECISION gradient of the Lagrangian function. H(NH) U DOUBLE PRECISION Choleski decomposition of the approximate Hessian (NH is equal to NF*(NF+1)/2). S(NF+1) O DOUBLE PRECISION direction vector. MFP I INTEGER variable that specifies the type of the computed point. MFP=1 - computation is terminated whenever an arbitrary feasible point is found, MFP=2 - computation is terminated whenever an optimum feasible point is found, MFP=3 - computation starts from the previously reached point and is terminated whenever an optimum feasible point is found. KBF I INTEGER variable that specifies simple bounds on variables. KBF=0 - simple bounds are suppressed, KBF=1 - one sided simple bounds, KBF=2 - two sided simple bounds. KBC I INTEGER variable that specifies general linear constraints. KBC=0 - linear constraints are suppressed, KBC=1 - one sided linear constraints, KBC=2 - two sided linear constraints. IDECF U INTEGER variable that specifies the type of matrix decomposition. IDECF= 0 - no decomposition, IDECF= 1 - Choleski decomposition, IDECF= 9 - inversion, IDECF=10 - diagonal matrix. ETA0 I DOUBLE PRECISION machine precision (the recommended value is 1.0D-15. ETA2 I DOUBLE PRECISION tolerance for positive definiteness in the Choleski decomposition. ETA9 I DOUBLE PRECISION maximum floating point number. EPS7 I DOUBLE PRECISION tolerance for linear independence of constraints (the recommended value is 1.0D-10). EPS9 I DOUBLE PRECISION tolerance for the definition of active constraints (the recommended value is 1.0D-8). XNORM O DOUBLE PRECISION value of the linearized minimax function. UMAX O DOUBLE PRECISION maximum absolute value of the negative Lagrange multiplier. GMAX O DOUBLE PRECISION infinity norm of the gradient of the Lagrangian function. N O INTEGER dimension of a manifold defined by active constraints. ITERQ O INTEGER variable that indicates the type of the computed feasible point. ITERQ= 1 - an arbitrary feasible point was found, ITERQ= 2 - the optimum feasible point was found, ITERQ=-1 - an arbitrary feasible point does not exist, ITERQ=-2 - the optimum feasible point does not exist. 5. Form of printed results: --------------------------- The form of printed results is specified by the parameter IPRNT as is described in Section 3. Here we demonstrate individual forms of printed results by the simple use of the program TMINL described in the next section (with NEXT=6). If we set IPRNT=1, then the printed results will have the form NIT= 15 NFV= 16 NFG= 15 F= .50694800D+00 G= .1488D-10 ITERM= 4 If we set IPRNT=-1, then the printed results will have the form EXIT FROM PMIN : NIT= 15 NFV= 16 NFG= 15 F= .50694800D+00 G= .1488D-10 ITERM= 4 X = .5000000D+00 .5000000D+00 .5000000D+00 .5000000D+00 .5000000D+00 .5000000D+00 .5000000D+00 .5000000D+00 .5000000D+00 .5000000D+00 -.4166693D+00 -.4166693D+00 -.4166693D+00 -.4166693D+00 -.4166693D+00 -.4166693D+00 -.4166693D+00 -.4166693D+00 -.4166693D+00 -.5069240D+00 If we set IPRNT=2, then the printed results will have the form ENTRY TO PMIN : NIT= 0 NFV= 1 NFG= 1 F= .21899000D+05 G= .1000D+61 NIT= 1 NFV= 2 NFG= 2 F= .13670000D+05 G= .2200D+02 NIT= 2 NFV= 3 NFG= 3 F= .35097538D+04 G= .1050D+02 NIT= 3 NFV= 4 NFG= 4 F= .90439182D+03 G= .2476D+01 NIT= 4 NFV= 5 NFG= 5 F= .21124136D+03 G= .4935D+00 NIT= 5 NFV= 6 NFG= 6 F= .36315848D+02 G= .1027D+00 NIT= 6 NFV= 7 NFG= 7 F= .33929080D+01 G= .3163D-01 NIT= 7 NFV= 8 NFG= 8 F= .82287170D+00 G= .1223D-01 NIT= 8 NFV= 9 NFG= 9 F= .73088967D+00 G= .4031D-01 NIT= 9 NFV= 10 NFG= 10 F= .69140770D+00 G= .6643D-01 NIT= 10 NFV= 11 NFG= 11 F= .56052270D+00 G= .1179D+00 NIT= 11 NFV= 13 NFG= 12 F= .53014436D+00 G= .1019D-01 NIT= 12 NFV= 14 NFG= 13 F= .52097640D+00 G= .2339D-01 NIT= 13 NFV= 15 NFG= 14 F= .50698339D+00 G= .8925D-03 NIT= 14 NFV= 16 NFG= 15 F= .50694800D+00 G= .2328D-05 EXIT FROM PMIN : NIT= 15 NFV= 16 NFG= 15 F= .50694800D+00 G= .1488D-10 ITERM= 4 If we set IPRNT=-2, then the printed results will have the form ENTRY TO PMIN : NIT= 0 NFV= 1 NFG= 1 F= .21899000D+05 G= .1000D+61 NIT= 1 NFV= 2 NFG= 2 F= .13670000D+05 G= .2200D+02 NIT= 2 NFV= 3 NFG= 3 F= .35097538D+04 G= .1050D+02 NIT= 3 NFV= 4 NFG= 4 F= .90439182D+03 G= .2476D+01 NIT= 4 NFV= 5 NFG= 5 F= .21124136D+03 G= .4935D+00 NIT= 5 NFV= 6 NFG= 6 F= .36315848D+02 G= .1027D+00 NIT= 6 NFV= 7 NFG= 7 F= .33929080D+01 G= .3163D-01 NIT= 7 NFV= 8 NFG= 8 F= .82287170D+00 G= .1223D-01 NIT= 8 NFV= 9 NFG= 9 F= .73088967D+00 G= .4031D-01 NIT= 9 NFV= 10 NFG= 10 F= .69140770D+00 G= .6643D-01 NIT= 10 NFV= 11 NFG= 11 F= .56052270D+00 G= .1179D+00 NIT= 11 NFV= 13 NFG= 12 F= .53014436D+00 G= .1019D-01 NIT= 12 NFV= 14 NFG= 13 F= .52097640D+00 G= .2339D-01 NIT= 13 NFV= 15 NFG= 14 F= .50698339D+00 G= .8925D-03 NIT= 14 NFV= 16 NFG= 15 F= .50694800D+00 G= .2328D-05 EXIT FROM PMIN: NIT= 15 NFV= 16 NFG= 15 F= .50694800D+00 G= .1488D-10 ITERM= 4 X = .5000000D+00 .5000000D+00 .5000000D+00 .5000000D+00 .5000000D+00 .5000000D+00 .5000000D+00 .5000000D+00 .5000000D+00 .5000000D+00 -.4166693D+00 -.4166693D+00 -.4166693D+00 -.4166693D+00 -.4166693D+00 -.4166693D+00 -.4166693D+00 -.4166693D+00 -.4166693D+00 -.5069240D+00 6. Verification of the subroutines: ----------------------------------- Subroutine PMINU can be verified and tested using the program TMINU. This program calls the subroutines TIUD06 (initiation), TAFU06 (function evaluation) and TAGU06 (subgradient evaluation) containing 25 academic test problems with at most 20 variables [4]. The results obtained by the program TMINU on a PC computer with Microsoft Power Station Fortran compiler have the following form. NIT= 7 NFV= 8 NFG= 8 F= .19522245D+01 G= .1041D-07 ITERM= 4 NIT= 7 NFV= 8 NFG= 8 F= .97131735D-09 G= .1066D-13 ITERM= 4 NIT= 93 NFV= 195 NFG= 94 F= .27312458D-10 G= .6955D-06 ITERM= 4 NIT= 13 NFV= 15 NFG= 14 F= .35997193D+01 G= .2498D-07 ITERM= 4 NIT= 11 NFV= 16 NFG= 12 F= -.44000000D+02 G= .2507D-06 ITERM= 4 NIT= 12 NFV= 21 NFG= 13 F= -.44000000D+02 G= .8543D-06 ITERM= 4 NIT= 8 NFV= 9 NFG= 9 F= .42021427D-02 G= .6568D-09 ITERM= 4 NIT= 5 NFV= 6 NFG= 6 F= .50816327D-01 G= .1502D-06 ITERM= 4 NIT= 10 NFV= 12 NFG= 11 F= .80843684D-02 G= .1874D-08 ITERM= 4 NIT= 11 NFV= 11 NFG= 11 F= .11570644D+03 G= .7077D-08 ITERM= 4 NIT= 35 NFV= 113 NFG= 36 F= .26359735D-02 G= .1488D-07 ITERM= 4 NIT= 34 NFV= 86 NFG= 35 F= .20160756D-02 G= .1581D-08 ITERM= 4 NIT= 7 NFV= 8 NFG= 8 F= .99665116D-05 G= .4525D-06 ITERM= 4 NIT= 6 NFV= 8 NFG= 7 F= .12237126D-03 G= .6839D-07 ITERM= 4 NIT= 16 NFV= 37 NFG= 16 F= .22340496D-01 G= .1960D-13 ITERM= 4 NIT= 21 NFV= 53 NFG= 22 F= .34904927D-01 G= .2522D-07 ITERM= 4 NIT= 11 NFV= 15 NFG= 12 F= .19729063D+00 G= .8187D-07 ITERM= 4 NIT= 17 NFV= 86 NFG= 18 F= .61852848D-02 G= .3254D-06 ITERM= 4 NIT= 19 NFV= 33 NFG= 20 F= .68063006D+03 G= .5743D-06 ITERM= 4 NIT= 13 NFV= 19 NFG= 14 F= .24306209D+02 G= .9366D-07 ITERM= 4 NIT= 19 NFV= 26 NFG= 20 F= .13372828D+03 G= .5547D-06 ITERM= 4 NIT= 37 NFV= 53 NFG= 38 F= .54598150D+02 G= .1320D-06 ITERM= 4 NIT= 21 NFV= 31 NFG= 22 F= .26108258D+03 G= .7934D-06 ITERM= 4 NIT= 18 NFV= 20 NFG= 19 F= .91150394D-07 G= .5473D-06 ITERM= 4 NIT= 80 NFV= 327 NFG= 81 F= .48028792D-01 G= .9071D-06 ITERM= 4 The rows corresponding to individual test problems contain the number of iterations NIT, the number of function evaluations NFV, the number of gradient evaluations NFG, the final value of the objective function F, the value of the criterion for the termination G and the cause of termination ITERM. Subroutines PMINL can be verified and tested using the program TMINL. This program calls the subroutines TIUD22 (initiation), TAFU22 (function evaluation), TAGU22 (subgradient evaluation) containing 15 academic test problems with at most 20 variables [4]. The results obtained by the program TMINL on a PC computer with Microsoft Power Station Fortran compiler have the following form. NIT= 6 NFV= 7 NFG= 7 F= -.38965952D+00 G= .6129D-08 ITERM= 4 NIT= 5 NFV= 5 NFG= 5 F= -.33035714D+00 G= .0000D+00 ITERM= 4 NIT= 8 NFV= 8 NFG= 8 F= -.44891079D+00 G= .2032D-10 ITERM= 4 NIT= 75 NFV= 75 NFG= 75 F= -.42928061D+00 G= .4449D-10 ITERM= 4 NIT= 9 NFV= 9 NFG= 9 F= -.18596187D+01 G= .8299D-12 ITERM= 4 NIT= 7 NFV= 9 NFG= 8 F= .10183089D+00 G= .8211D-06 ITERM= 4 NIT= 7 NFV= 10 NFG= 8 F= .10658141D-13 G= .6600D-06 ITERM= 4 NIT= 15 NFV= 23 NFG= 16 F= .24306209D+02 G= .3499D-06 ITERM= 4 NIT= 21 NFV= 29 NFG= 22 F= .13372828D+03 G= .1829D-06 ITERM= 4 NIT= 15 NFV= 16 NFG= 15 F= .50694800D+00 G= .1488D-10 ITERM= 4 NIT= 15 NFV= 20 NFG= 16 F= .27608127D-03 G= .2149D-09 ITERM= 4 NIT= 154 NFV= 850 NFG= 155 F= -.17688070D+04 G= .1304D-07 ITERM= 4 NIT= 15 NFV= 22 NFG= 16 F= .12272261D+04 G= .1706D-06 ITERM= 4 NIT= 148 NFV= 273 NFG= 149 F= .70492480D+04 G= .4700D-07 ITERM= 4 NIT= 62 NFV= 107 NFG= 63 F= .17478699D+03 G= .7868D-07 ITERM= 4 References: ----------- [1] Luksan L.: Dual Method for Solving a Special Problem of Quadratic Programming as a Subproblem at Linearly Constrained Nonlinear Minimax Approximation. Kybernetika 20 (1984) 445-457. [2] Luksan L.: An Implementation of Recursive Quadratic Programming Variable Metric Methods for Linearly Constrained Nonlinear Minimax Approximation. Kybernetika 21 (1985) 22-40. [3] Luksan L., Vlcek J.: NDA: Algorithms for Nondifferentiable Optimization. Research Report V-797, Institute of Computer Science, Academy of Sciences of the Czech Republic, Prague, Czech Republic, 2000. [4] Luksan L., Vlcek J.: Subroutines for Testing Nonsmooth Unconstrained and Linearly Constrained Optimization Problems. Research Report V-798, Institute of Computer Science, Academy of Sciences of the Czech Republic, Prague, Czech Republic, 2000.  SHAR_EOF fi # end of overwriting check if test -f 'pnew.txt' then echo shar: will not over-write existing file "'pnew.txt'" else cat << "SHAR_EOF" > 'pnew.txt' *********************************************************************** * * * PNEW - A BUNDLE-NEWTON ALGORITHM FOR NONSMOOTH * * UNCONSTRAINED OPTIMIZATION. * * * *********************************************************************** 1. Introduction: ---------------- The double-precision FORTRAN 77 basic subroutine PNEW is designed to find a close approximation to a local minimum of a nonlinear nonsmooth function F(X) with simple bounds on variables and general linear constraints. Here X is a vector of N variables and F(X), is assumed to be a locally Lipschitz continuous function. Simple bounds are assumed in the form X(I) unbounded if IX(I) = 0, XL(I) <= X(I) if IX(I) = 1, X(I) <= XU(I) if IX(I) = 2, XL(I) <= X(I) <= XU(I) if IX(I) = 3, XL(I) = X(I) = XU(I) if IX(I) = 5, where 1 <= I <= N. General linear constraints are assumed in the form C(I) unbounded if IC(I) = 0, CL(I) <= C(I) if IC(I) = 1, C(I) <= CU(I) if IC(I) = 2, CL(I) <= C(I) <= CU(I) if IC(I) = 3, CL(I) = C(I) = CU(I) if IC(I) = 5, where C(I) = A_I*X, 1 <= I <= NC, are linear functions. To simplify user's work, three additional easy to use subroutines are added. They call the basic general subroutine PNEW: PNEWU - unconstrained nonsmooth optimization, PNEWS - nonsmooth optimization with simple bounds, PNEWL - nonsmooth optimization with simple bounds and general linear constraints. All subroutines contain a description of formal parameters and extensive comments. Furthermore, two test programs TNEWU and TNEWL are included, which contain several test problems (see e.g. [4]). These test programs serve as examples for using the subroutines, verify their correctness and demonstrate their efficiency. In this short guide, we describe all subroutines which can be called from the user's program. A detailed description of methods is given in [2] and [3]. In the description of formal parameters, we introduce a type of the argument that specifies whether the argument must have a value defined on entry to the subroutine (I), whether it is a value which will be returned (O), or both (U), or whether it is an auxiliary value (A). Note that the arguments of the type I can be changed on output under some circumstances, especially if improper input values were given. Besides formal parameters, we can use a COMMON /STAT/ block containing statistical information. This block, used in each subroutine has the following form: COMMON /STAT/ NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH The arguments have the following meaning: Argument Type Significance ---------------------------------------------------------------------- NDECF O Positive INTEGER variable that indicates the number of matrix decompositions. NRES O Positive INTEGER variable that indicates the number of restarts. NRED O Positive INTEGER variable that indicates the number of reductions. NREM O Positive INTEGER variable that indicates the number of constraint deletions during the QP solutions. NADD O Positive INTEGER variable that indicates the number of constraint additions during the QP solutions. NIT O Positive INTEGER variable that indicates the number of iterations. NFV O Positive INTEGER variable that indicates the number of function evaluations. NFG O Positive INTEGER variable that specifies the number of gradient evaluations. NFH O Positive INTEGER variable that specifies the number of Hessian evaluations. 2. Subroutines PNEWU, PNEWS, PNEWL: ----------------------------------- The calling sequences are CALL PNEWU(NF,NA,X,IA,RA,IPAR,RPAR,FP,GMAX,IHES,ITERM) CALL PNEWS(NF,NA,NB,X,IX,XL,XU,IA,RA,IPAR,RPAR,FP,GMAX,IHES, & ITERM) CALL PNEWL(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,IA,RA,IPAR, & RPAR,FP,GMAX,IHES,ITERM) The arguments have the following meaning. Argument Type Significance ---------------------------------------------------------------------- NF I Positive INTEGER variable that specifies the number of variables of the objective function. NA I Nonnegative INTEGER variable that specifies the maximum bundle dimension. The choice NA=0 causes that the default value NA=NF+3 will be taken. NB I Nonnegative INTEGER variable that specifies whether the simple bounds are suppressed (NB=0) or accepted (NB>0). NC I Nonnegative INTEGER variable that specifies the number of linear constraints; if NC=0 the linear constraints are suppressed. X(NF) U On input, DOUBLE PRECISION vector with the initial estimate to the solution. On output, the approximation to the minimum. IX(NF) I On input (significant only if NB>0) INTEGER vector containing the simple bounds types: IX(I)=0 - the variable X(I) is unbounded, IX(I)=1 - the lower bound X(I) >= XL(I), IX(I)=2 - the upper bound X(I) <= XU(I), IX(I)=3 - the two side bound XL(I) <= X(I) <= XU(I), IX(I)=5 - the variable X(I) is fixed (given by its initial estimate). XL(NF) I DOUBLE PRECISION vector with lower bounds for variables (significant only if NB>0). XU(NF) I DOUBLE PRECISION vector with upper bounds for variables (significant only if NB>0). CF(NC) A DOUBLE PRECISION vector which contains values of constraint functions (only if NC>0). IC(NC) I On input (significant only if NC>0) INTEGER vector which contains constraint types: IC(K)=0 - the constraint CF(K) is not used, IC(K)=1 - the lower constraint CF(K) >= CL(K), IC(K)=2 - the upper constraint CF(K) <= CU(K), IC(K)=3 - the two side constraint CL(K) <= CF(K) <= CU(K), IC(K)=5 - the equality constraint CF(K) = CL(K). CL(NC) I DOUBLE PRECISION vector with lower bounds for constraint functions (significant only if NC>0). CU(NC) I DOUBLE PRECISION vector with upper bounds for constraint functions (significant only if NC>0). CG(NF*NC) I DOUBLE PRECISION matrix whose columns are normals of the linear constraints (significant only if NC>0). IA(NIA) A INTEGER working array of the dimension of at least NIA=NF+NA+1. RA(NRA) A DOUBLE PRECISION working array of the dimension of at least NRA=NF*(NF+1)*(NA+3)/2+NF*(NA+6)+5*NA+4. IPAR(7) A INTEGER parameters: IPAR(1)=MOS, IPAR(2)=MES, IPAR(3)=MTESX, IPAR(4)=MTESF, IPAR(5)=MIT, IPAR(6)=MFV, IPAR(7)=IPRNT. Parameters MOS, MES, MTESX, MTESF, MIT, MFV, IPRNT are described in Section 3 together with other parameters of the subroutine PNEW. RPAR(9) A DOUBLE PRECISION parameters: RPAR(1)=TOLX, RPAR(2)=TOLF, RPAR(3)=TOLB, RPAR(4)=TOLG, RPAR(5)=TOLD, RPAR(6)=TOLS, RPAR(7)=TOLP. RPAR(8)=ETA, RPAR(9)=XMAX. Parameters TOLX, TOLF, TOLB, TOLG, TOLD, TOLS, TOLP, ETA, XMAX are described in Section 3 together with other parameters of the subroutine PNEW. FP O DOUBLE PRECISION value of the objective function at the solution X. GMAX O DOUBLE PRECISION maximum absolute value of a partial derivative of the Lagrangian function. IHES I INTEGER variable that specifies a way for computing second derivatives: IHES=0 - numerical computation, IHES=1 - analytical computation by the user supplied subroutine HES. ITERM O INTEGER variable that indicates the cause of termination: ITERM= 1 - if |X - XO| was less than or equal to TOLX in MTESX subsequent iterations, ITERM= 2 - if |F - FO| was less than or equal to TOLF in MTESF subsequent iterations, ITERM= 3 - if F is less than or equal to TOLB, ITERM= 4 - if GMAX is less than or equal to TOLG, ITERM=11 - if NFV exceeded MFV, ITERM=12 - if NIT exceeded MIT, ITERM< 0 - if the method failed. The subroutines PNEWU, PNEWS, PNEWL require user supplied subroutines FUNDER and HES that defines the objective function, its subgradient and has the form SUBROUTINE FUNDER(NF,X,F,G) SUBROUTINE HES(NF,X,H) The arguments of user supplied subroutines have the following meaning. Argument Type Significance ---------------------------------------------------------------------- NF I Positive INTEGER variable that specifies the number of variables of the objective function. X(NF) I DOUBLE PRECISION an estimate to the solution. F O DOUBLE PRECISION value of the objective function at the point X. G(NF) O DOUBLE PRECISION subgradient of the objective function at the point X. H(NH) O DOUBLE PRECISION matrix containing the second order information at the point X (NH is equal to NF*(NF+1)/2). 3. Subroutine PNEW: ------------------- This general subroutine is called from all the subroutines described in Section 2. The calling sequence is CALL PNEW(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,AF,IA,AFD,AG, & IAA,AR,AZ,G,H,HF,AH,S,SO,XO,GO,TOLX,TOLF,TOLB,TOLG,TOLD,TOLS, & TOLP,ETA,XMAX,GMAX,FP,MOS,MES,MTESX,MTESF,MIT,MFV,IPRNT,IHES, & ITERM). The arguments NF, NA, NB, NC, X, IX, XL, XU, CF, IC, CL, CU, CG, GMAX, FP, ITERM, have the same meaning as in Section 2. Other arguments have the following meaning M is equal to NF*(NF+1)/2): Argument Type Significance --------------------------------------------------------------------- AF(5*NA) A DOUBLE PRECISION vector of bundle function values. IA(NA) A INTEGER vector containing types of bundle functions. AFD(NA) A DOUBLE PRECISION vector of bundle function increments. AG(NF*NA) A DOUBLE PRECISION matrix whose columns are bundle gradients. IAA(NA) A INTEGER vector containing indices of active functions. AR(NAR) A DOUBLE PRECISION matrix containing triangular decomposition of the orthogonal projection kernel (NAR is equal to (NF+1)*(NF+2)/2). AZ(NF+1) A DOUBLE PRECISION vector of Lagrange multipliers. G(NF) A DOUBLE PRECISION subgradient of the objective function. H(NH) A DOUBLE PRECISION aggregate Hessian matrix (NH is equal to NF*(NF+1)/2). HF(NH) A DOUBLE PRECISION Hessian matrix of the objective function. AH(NA*NH) A DOUBLE PRECISION Bundle of Hessian matrices. S(NF+1) A DOUBLE PRECISION direction vector. SO(NF) A DOUBLE PRECISION auxiliary vector. XO(NF) A DOUBLE PRECISION vector which contains increments of variables. GO(NF+1) A DOUBLE PRECISION gradient of the Lagrangian function. TOLX I DOUBLE PRECISION tolerance for the change of the coordinate vector X; the choice TOLX=0 causes that the default value TOLX=1.0D-16 will be taken. TOLF I DOUBLE PRECISION tolerance for the change of function values; the choice TOLF=0 causes that the default value TOLF=1.0D-8 will be taken. TOLB I DOUBLE PRECISION minimum acceptable function value; the choice TOLB=0 causes that the default value TOLB=-1.0D60 will be taken. TOLG I DOUBLE PRECISION tolerance for the Lagrangian function gradient; the choice TOLG=0 causes that the default value TOLG=1.0D-6 will be taken. TOLD I DOUBLE PRECISION tolerance for a descent direction; the choice TOLD= 0 causes that the default value TOLD=1.0D-4 will be taken. TOLS I DOUBLE PRECISION tolerance parameter for a function decrease in a line search; the choice TOLS=0 causes that the default value TOLS=1.0D-2 will be taken. TOLP I DOUBLE PRECISION tolerance parameter for a significant modification of the next line search direction; the choice TOLP=0 causes that the default value TOLP=0.5D0 will be taken. ETA I DOUBLE PRECISION distance measure parameter. XMAX I DOUBLE PRECISION maximum stepsize; the choice XMAX=0 causes that the default value 1.0D3 will be taken. MOS I INTEGER distance measure exponent (MOS=1 or MOS=2). The choice MOS=0 causes that the default value MOS=1 will be taken. MES I INTEGER variable that specifies the interpolation method selection in a line search: MES=1 - bisection, MES=2 - two point quadratic interpolation, MES=3 - three point quadratic interpolation, MES=4 - three point cubic interpolation. The choice MES=0 causes that the default value MES=1 will be taken. MTESX I INTEGER variable that specifies the maximum number of iterations with changes of the coordinate vector X smaller than TOLX; the choice MTESX=0 causes that the default value MTESX=20 will be taken. MTESF I INTEGER variable that specifies the maximum number of iterations with changes of function values smaller than TOLF; the choice MTESF=0 causes that the default value MTESF=2 will be taken. MIT I INTEGER variable that specifies the maximum number of iterations; the choice MIT=0 causes that the default value 200 will be taken. MFV I INTEGER variable that specifies the maximum number of function evaluations; the choice |MFV|=0 causes that the default value 500 will be taken. IPRNT I INTEGER variable that specifies PRINT: IPRNT= 0 - print is suppressed, IPRNT= 1 - basic print of final results, IPRNT=-1 - extended print of final results, IPRNT= 2 - basic print of intermediate and final results, IPRNT=-2 - extended print of intermediate and final results. The subroutine PNEW has a modular structure. The following list contains its most important subroutines: PF1HS1 - Numerical computation of the Hessian matrix. PDDBQ2 - Determination of the descent direction using quadratic programming subroutine and bundle updating. PLQDF1 - Dual range space method for solving a quadratic programming subproblem with linear constraints (see [1]). PS1L05 - Line search using function values and derivatives. The subroutine PNEW requires the user supplied subroutine FUNDER which is described in Section 2. 4. Subroutine PLQDF1: --------------------- Since the dual range space method for special quadratic programming subproblems arising in bundle type nonsmooth optimization can be used separately in many applications (e.g. in minimax optimization), we describe the subroutine PLQDF1 in more details. The calling sequence is CALL PLQDF1(NF,NA,NC,X,IX,XL,XU,AF,AFD,IA,IAA,AG,AR,AZ, & CF,IC,CL,CU,CG,G,H,S,MFP,KBF,KBC,IDECF,ETA0,ETA2,ETA9, & EPS7,EPS9,XNORM,UMAX,GMAX,N,ITERQ) The arguments NF, NA, NC, X, IX, XL, XU, AF, CF, IC, CL, CU, CG have the same meaning as in Section 2 (only with the difference that the arguments X and AF are of the type (I), i.e. they must have a value defined on entry to PLQDF1 and they are not changed). The arguments AFD, IA, IAA, AG, AR, AZ have the same meaning as in Section 3 (only with the difference that the arguments AFD, IAA, AR, AZ are of the type (O), i.e. their values can be used subsequently). Other arguments have the following meaning: Argument Type Significance ---------------------------------------------------------------------- G(NF+1) O DOUBLE PRECISION gradient of the Lagrangian function. H(NH) U DOUBLE PRECISION Choleski decomposition of the approximate Hessian matrix (NH is equal to NF*(NF+1)/2). S(NF+1) O DOUBLE PRECISION direction vector. MFP I INTEGER variable that specifies the type of the computed point. MFP=1 - computation is terminated whenever an arbitrary feasible point is found, MFP=2 - computation is terminated whenever an optimum feasible point is found, MFP=3 - computation starts from the previously reached point and is terminated whenever an optimum feasible point is found. KBF I INTEGER variable that specifies simple bounds on variables. KBF=0 - simple bounds are suppressed, KBF=1 - one sided simple bounds, KBF=2 - two sided simple bounds. KBC I INTEGER variable that specifies general linear constraints. KBC=0 - linear constraints are suppressed, KBC=1 - one sided linear constraints, KBC=2 - two sided linear constraints. IDECF U INTEGER variable that specifies the type of matrix decomposition. IDECF= 0 - no decomposition, IDECF= 1 - Choleski decomposition, IDECF= 9 - inversion, IDECF=10 - diagonal matrix. ETA0 I DOUBLE PRECISION machine precision (the recommended value is 1.0D-15. ETA2 I DOUBLE PRECISION tolerance for positive definiteness in the Choleski decomposition. ETA9 I DOUBLE PRECISION maximum floating point number. EPS7 I DOUBLE PRECISION tolerance for linear independence of constraints (the recommended value is 1.0D-10). EPS9 I DOUBLE PRECISION tolerance for the definition of active constraints (the recommended value is 1.0D-8). XNORM O DOUBLE PRECISION value of the linearized minimax function. UMAX O DOUBLE PRECISION maximum absolute value of the negative Lagrange multiplier. GMAX O DOUBLE PRECISION infinity norm of the gradient of the Lagrangian function. N O INTEGER dimension of a manifold defined by active constraints. ITERQ O INTEGER variable that indicates the type of the computed feasible point. ITERQ= 1 - an arbitrary feasible point was found, ITERQ= 2 - the optimum feasible point was found, ITERQ=-1 - an arbitrary feasible point does not exist, ITERQ=-2 - the optimum feasible point does not exist. 5. Form of printed results: --------------------------- The form of printed results is specified by the parameter IPRNT as is described in Section 3. Here we demonstrate individual forms of printed results by the simple use of the program TNEWU described in the next section (with NEXT=16). If we set IPRNT=1, then the printed results will have the form NIT= 12 NFV= 14 NFG= 14 F= -.84140833D+00 G= .6734D-06 ITERM= 4 If we set IPRNT=-1, then the printed results will have the form EXIT FROM PNEW : NIT= 12 NFV= 14 NFG= 14 F= -.84140833D+00 G= .6734D-06 ITERM= 4 X= -.1262566D+00 -.3437830D-01 -.6857198D-02 .2636066D-01 .6729492D-01 -.2783995D+00 .7421866D-01 .1385240D+00 .8403122D-01 .3858031D-01 If we set IPRNT=2, then the printed results will have the form ENTRY TO PNEW : NIT= 0 NFV= 1 NFG= 1 F= .00000000D+00 G= .1000D+61 NIT= 1 NFV= 3 NFG= 3 F= .53370664D+04 G= .1200D+05 NIT= 2 NFV= 4 NFG= 4 F= .66499712D+02 G= .2610D+02 NIT= 3 NFV= 5 NFG= 5 F= .33934270D+02 G= .3771D+02 NIT= 4 NFV= 6 NFG= 6 F= .12040341D+01 G= .3214D+01 NIT= 5 NFV= 7 NFG= 7 F= .51324695D+00 G= .1459D+01 NIT= 6 NFV= 8 NFG= 8 F= -.76915236D+00 G= .2347D+01 NIT= 7 NFV= 9 NFG= 9 F= -.83859100D+00 G= .2683D+00 NIT= 8 NFV= 10 NFG= 10 F= -.84140726D+00 G= .2491D-02 NIT= 9 NFV= 11 NFG= 11 F= -.84140726D+00 G= .3213D-03 NIT= 10 NFV= 12 NFG= 12 F= -.84140726D+00 G= .4862D-03 NIT= 11 NFV= 13 NFG= 13 F= -.84140726D+00 G= .5265D-05 NIT= 12 NFV= 14 NFG= 14 F= -.84140833D+00 G= .6734D-06 EXIT FROM PNEW : NIT= 12 NFV= 14 NFG= 14 F= -.84140833D+00 G= .6734D-06 ITERM= 4 If we set IPRNT=-2, then the printed results will have the form ENTRY TO PNEW : NIT= 0 NFV= 1 NFG= 1 F= .00000000D+00 G= .1000D+61 NIT= 1 NFV= 3 NFG= 3 F= .53370664D+04 G= .1200D+05 NIT= 2 NFV= 4 NFG= 4 F= .66499712D+02 G= .2610D+02 NIT= 3 NFV= 5 NFG= 5 F= .33934270D+02 G= .3771D+02 NIT= 4 NFV= 6 NFG= 6 F= .12040341D+01 G= .3214D+01 NIT= 5 NFV= 7 NFG= 7 F= .51324695D+00 G= .1459D+01 NIT= 6 NFV= 8 NFG= 8 F= -.76915236D+00 G= .2347D+01 NIT= 7 NFV= 9 NFG= 9 F= -.83859100D+00 G= .2683D+00 NIT= 8 NFV= 10 NFG= 10 F= -.84140726D+00 G= .2491D-02 NIT= 9 NFV= 11 NFG= 11 F= -.84140726D+00 G= .3213D-03 NIT= 10 NFV= 12 NFG= 12 F= -.84140726D+00 G= .4862D-03 NIT= 11 NFV= 13 NFG= 13 F= -.84140726D+00 G= .5265D-05 NIT= 12 NFV= 14 NFG= 14 F= -.84140833D+00 G= .6734D-06 EXIT FROM PNEW : NIT= 12 NFV= 14 NFG= 14 F= -.84140833D+00 G= .6734D-06 ITERM= 4 X= -.1262566D+00 -.3437830D-01 -.6857198D-02 .2636066D-01 .6729492D-01 -.2783995D+00 .7421866D-01 .1385240D+00 .8403122D-01 .3858031D-01 6. Verification of the subroutines: ----------------------------------- Subroutine PNEWU can be verified and tested using the program TNEWU. This program calls the subroutines TIUD19 (initiation), TFFU19 (function evaluation) and TFGU19 (subgradient evaluation) containing 20 academic test problems with at most 50 variables [4]. The results obtained by the program TNEWU on a PC computer with Microsoft Power Station Fortran compiler have the following form. NIT= 58 NFV= 59 NFG= 59 F= .22533111D-15 G= .8624D-05 ITERM= 2 NIT= 7 NFV= 8 NFG= 8 F= .16765701D-10 G= .5792D-05 ITERM= 4 NIT= 9 NFV= 10 NFG= 10 F= .19522245D+01 G= .2172D-05 ITERM= 4 NIT= 10 NFV= 11 NFG= 11 F= .20000068D+01 G= .2161D-04 ITERM= 4 NIT= 14 NFV= 15 NFG= 15 F= -.30000000D+01 G= .5398D-08 ITERM= 2 NIT= 4 NFV= 6 NFG= 6 F= .72000000D+01 G= .1445D-08 ITERM= 4 NIT= 16 NFV= 17 NFG= 17 F= -.14142136D+01 G= .5653D-07 ITERM= 4 NIT= 11 NFV= 13 NFG= 13 F= -.10000000D+01 G= .4158D-07 ITERM= 4 NIT= 10 NFV= 11 NFG= 11 F= -.10000000D+01 G= .4562D-06 ITERM= 4 NIT= 25 NFV= 26 NFG= 26 F= -.79999999D+01 G= .3813D-02 ITERM= 4 NIT= 13 NFV= 15 NFG= 15 F= -.44000000D+02 G= .4215D-05 ITERM= 4 NIT= 7 NFV= 8 NFG= 8 F= .22600173D+02 G= .1263D-02 ITERM= 4 NIT= 22 NFV= 24 NFG= 24 F= -.32348679D+02 G= .3409D-02 ITERM= 4 NIT= 76 NFV= 77 NFG= 77 F= -.29197002D+01 G= .1061D-02 ITERM= 4 NIT= 89 NFV= 91 NFG= 91 F= .55981330D+00 G= .1528D-05 ITERM= 4 NIT= 12 NFV= 14 NFG= 14 F= -.84140833D+00 G= .6734D-06 ITERM= 4 NIT= 52 NFV= 53 NFG= 53 F= .97857721D+01 G= .2964D-03 ITERM= 4 NIT= 40 NFV= 42 NFG= 42 F= .16703855D+02 G= .1778D+00 ITERM= 4 NIT= 36 NFV= 37 NFG= 37 F= .38373702D-08 G= .5758D-08 ITERM= 2 NIT= 24 NFV= 25 NFG= 25 F= .45289427D-08 G= .1100D-09 ITERM= 2 The rows corresponding to individual test problems contain the number of iterations NIT, the number of function evaluations NFV, the number of gradient evaluations NFG, the final value of the objective function F, the value of the criterion for the termination G and the cause of termination ITERM. Subroutine PNEWL can be verified and tested using the program TNEWL. This program calls the subroutines TIUD22 (initiation), TAFU22 (function evaluation), TAGU22 (subgradient evaluation) containing 6 academic test problems with at most 20 variables [4]. The results obtained by the program TNEWL on a PC computer with Microsoft Power Station Fortran compiler have the following form. NIT= 6 NFV= 7 NFG= 7 F= -.38965952D+00 G= .1650D-07 ITERM= 4 NIT= 2 NFV= 13 NFG= 13 F= -.33035714D+00 G= .1110D-15 ITERM= 4 NIT= 49 NFV= 50 NFG= 50 F= -.44891079D+00 G= .1014D-06 ITERM= 4 NIT= 10 NFV= 11 NFG= 11 F= -.42928061D+00 G= .1269D-03 ITERM= 4 NIT= 5 NFV= 6 NFG= 6 F= -.18141200D+01 G= .1618D-03 ITERM= 4 NIT= 20 NFV= 21 NFG= 21 F= .10183089D+00 G= .2697D-06 ITERM= 4 NIT= 93 NFV= 98 NFG= 98 F= .53905532D-03 G= .3304D-06 ITERM= 2 NIT= 6 NFV= 7 NFG= 7 F= .24852881D+03 G= .1167D-06 ITERM= 4 NIT= 10 NFV= 12 NFG= 12 F= .35240929D+03 G= .6705D-04 ITERM= 4 NIT= 94 NFV= 98 NFG= 98 F= .50694800D+00 G= .4083D-06 ITERM= 4 References: ----------- [1] Luksan L.: Dual Method for Solving a Special Problem of Quadratic Programming as a Subproblem at Linearly Constrained Nonlinear Minimax Approximation. Kybernetika 20 (1984) 445-457. [2] Luksan L., Vlcek J.: A Bundle-Newton Method for Nonsmooth Unconstrained Minimization. Mathematical Programming. [3] Luksan L., Vlcek J.: NDA: Algorithms for Nondifferentiable Optimization. Research Report V-797, Institute of Computer Science, Academy of Sciences of the Czech Republic, Prague, Czech Republic, 2000. [4] Luksan L., Vlcek J.: Subroutines for Testing Nonsmooth Unconstrained and Linearly Constrained Optimization Problems. Research Report V-798, Institute of Computer Science, Academy of Sciences of the Czech Republic, Prague, Czech Republic, 2000.  SHAR_EOF fi # end of overwriting check if test -f 'pvar.txt' then echo shar: will not over-write existing file "'pvar.txt'" else cat << "SHAR_EOF" > 'pvar.txt' *********************************************************************** * * * PVAR - A PROXIMAL BUNDLE ALGORITHM FOR NONSMOOTH * * OPTIMIZATION. * * * *********************************************************************** 1. Introduction: ---------------- The double-precision FORTRAN 77 basic subroutine PVAR is designed to find a close approximation to a local minimum of a nonlinear nonsmooth function F(X) with simple bounds on variables and general linear constraints. Here X is a vector of N variables and F(X), is assumed to be a locally Lipschitz continuous function. Simple bounds are assumed in the form X(I) unbounded if IX(I) = 0, XL(I) <= X(I) if IX(I) = 1, X(I) <= XU(I) if IX(I) = 2, XL(I) <= X(I) <= XU(I) if IX(I) = 3, XL(I) = X(I) = XU(I) if IX(I) = 5, where 1 <= I <= N. General linear constraints are assumed in the form C(I) unbounded if IC(I) = 0, CL(I) <= C(I) if IC(I) = 1, C(I) <= CU(I) if IC(I) = 2, CL(I) <= C(I) <= CU(I) if IC(I) = 3, CL(I) = C(I) = CU(I) if IC(I) = 5, where C(I) = A_I*X, 1 <= I <= NC, are linear functions. To simplify user's work, three additional easy to use subroutines are added. They call the basic general subroutine PVAR: PVARU - unconstrained nonsmooth optimization, PVARS - nonsmooth optimization with simple bounds, PVARL - nonsmooth optimization with simple bounds and general linear constraints. All subroutines contain a description of formal parameters and extensive comments. Furthermore, two test programs TVARU and TVARL are included, which contain several test problems (see e.g. [4]). These test programs serve as examples for using the subroutines, verify their correctness and demonstrate their efficiency. In this short guide, we describe all subroutines which can be called from the user's program. A detailed description of methods is given in [1], [2], [3]. In the description of formal parameters, we introduce a type of the argument that specifies whether the argument must have a value defined on entry to the subroutine (I), whether it is a value which will be returned (O), or both (U), or whether it is an auxiliary value (A). Note that the arguments of the type I can be changed on output under some circumstances, especially if improper input values were given. Besides formal parameters, we can use a COMMON /STAT/ block containing statistical information. This block, used in each subroutine has the following form: COMMON /STAT/ NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH The arguments have the following meaning: Argument Type Significance ---------------------------------------------------------------------- NDECF O Positive INTEGER variable that indicates the number of matrix decompositions. NRES O Positive INTEGER variable that indicates the number of restarts. NRED O Positive INTEGER variable that indicates the number of reductions. NREM O Positive INTEGER variable that indicates the number of constraint deletions during the QP solutions. NADD O Positive INTEGER variable that indicates the number of constraint additions during the QP solutions. NIT O Positive INTEGER variable that indicates the number of iterations. NFV O Positive INTEGER variable that indicates the number of function evaluations. NFG O Positive INTEGER variable that specifies the number of gradient evaluations. NFH O Positive INTEGER variable that specifies the number of Hessian evaluations. 2. Subroutines PVARU, PVARS, PVARL: ----------------------------------- The calling sequences are CALL PVARU(NF,NA,X,RA,IPAR,RPAR,F,GMAX,ITERM) CALL PVARS(NF,NA,NB,X,IX,XL,XU,IA,RA,IPAR,RPAR,FP,GMAX,ITERM) CALL PVARL(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,IA,RA,IPAR, & RPAR,FP,GMAX,ITERM) The arguments have the following meaning. Argument Type Significance ---------------------------------------------------------------------- NF I Positive INTEGER variable that specifies the number of variables of the objective function. NA I Nonnegative INTEGER variable that specifies the maximum bundle dimension. The choice NA=0 causes that the default value NA=NF+3 will be taken. NB I Nonnegative INTEGER variable that specifies whether the simple bounds are suppressed (NB=0) or accepted (NB>0). NC I Nonnegative INTEGER variable that specifies the number of linear constraints; if NC=0 the linear constraints are suppressed. X(NF) U On input, DOUBLE PRECISION vector with the initial estimate to the solution. On output, the approximation to the minimum. IX(NF) I On input (significant only if NB>0) INTEGER vector containing the simple bounds types: IX(I)=0 - the variable X(I) is unbounded, IX(I)=1 - the lower bound X(I) >= XL(I), IX(I)=2 - the upper bound X(I) <= XU(I), IX(I)=3 - the two side bound XL(I) <= X(I) <= XU(I), IX(I)=5 - the variable X(I) is fixed (given by its initial estimate). XL(NF) I DOUBLE PRECISION vector with lower bounds for variables (significant only if NB>0). XU(NF) I DOUBLE PRECISION vector with upper bounds for variables (significant only if NB>0). CF(NC) A DOUBLE PRECISION vector which contains values of constraint functions (only if NC>0). IC(NC) I On input (significant only if NC>0) INTEGER vector which contains constraint types: IC(K)=0 - the constraint CF(K) is not used, IC(K)=1 - the lower constraint CF(K) >= CL(K), IC(K)=2 - the upper constraint CF(K) <= CU(K), IC(K)=3 - the two side constraint CL(K) <= CF(K) <= CU(K), IC(K)=5 - the equality constraint CF(K) = CL(K). CL(NC) I DOUBLE PRECISION vector with lower bounds for constraint functions (significant only if NC>0). CU(NC) I DOUBLE PRECISION vector with upper bounds for constraint functions (significant only if NC>0). CG(NF*NC) I DOUBLE PRECISION matrix whose columns are normals of the linear constraints (significant only if NC>0). IA(NIA) A INTEGER working array of the dimension of at least NIA=NF+NA+1. RA(NRA) A DOUBLE PRECISION working array of the dimension of at least NRA=NF*(NF+11)/2+NA*(NF+2). IPAR(7) A INTEGER parameters: IPAR(1)=MEX, IPAR(2)=MOS, IPAR(3)=MTESX, IPAR(4)=MTESF, IPAR(5)=MIT, IPAR(6)=MFV, IPAR(7)=IPRNT. Parameters MEX, MOS, MTESX, MTESF, MIT, MFV, IPRNT are described in Section 3 together with other parameters of the subroutine PVAR. RPAR(7) A DOUBLE PRECISION parameters: RPAR(1)=TOLX, RPAR(2)=TOLF, RPAR(3)=TOLB, RPAR(4)=TOLG, RPAR(5)=ETA, RPAR(6)=EPS, RPAR(7)=XMAX. Parameters TOLX, TOLF, TOLB, TOLG, ETA, EPS, XMAX are described in Section 3 together with other parameters of the subroutine PVAR. F O DOUBLE PRECISION value of the objective function at the solution X. GMAX O DOUBLE PRECISION maximum absolute value of a partial derivative of the Lagrangian function. ITERM O INTEGER variable that indicates the cause of termination: ITERM= 1 - if |X - XO| was less than or equal to TOLX in MTESX subsequent iterations, ITERM= 2 - if |F - FO| was less than or equal to TOLF in MTESF subsequent iterations, ITERM= 3 - if F is less than or equal to TOLB, ITERM= 4 - if GMAX is less than or equal to TOLG, ITERM=11 - if NFV exceeded MFV, ITERM=12 - if NIT exceeded MIT, ITERM< 0 - if the method failed. The subroutines PVARU, PVARS, PVARL require the user supplied subroutine FUNDER that defines the objective function and its subgradient and has the form SUBROUTINE FUNDER(NF,X,F,G) The arguments of the user supplied subroutine have the following meaning. Argument Type Significance ---------------------------------------------------------------------- NF I Positive INTEGER variable that specifies the number of variables of the objective function. X(NF) I DOUBLE PRECISION an estimate to the solution. F O DOUBLE PRECISION value of the objective function at the point X. G(NF) O DOUBLE PRECISION subgradient of the objective function at the point X. 3. Subroutine PVAR: ------------------- This general subroutine is called from all the subroutines described in Section 2. The calling sequence is CALL PVAR(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,ICA,CFD,CR,CZ, & AF,AX,AG,G,GN,H,S,SN,XO,GO,GP,GS,TOLX,TOLF,TOLB,TOLG,ETA,EPS, & XMAX,GMAX,F,MEX,MOS,MTESX,MTESF,MIT,MFV,IPRNT,ITERM). The arguments NF, NA, NB, NC, X, IX, XL, XU, CF, IC, CL, CU, CG, GMAX, F, ITERM, have the same meaning as in Section 2. Other arguments have the following meaning: Argument Type Significance ---------------------------------------------------------------------- ICA(NC) A INTEGER vector containing indices of active constraints. CFD(NC) A DOUBLE PRECISION vector of constraint function increments. CR(NCR) A DOUBLE PRECISION matrix containing triangular decomposition of the orthogonal projection kernel (NCR is equal to NF*(NF+1)/2). CZ(NF*NF) A DOUBLE PRECISION matrix containing orthogonal basis of linear manifold defined by active constraints. AF(4*NA) A DOUBLE PRECISION vector of bundle function values. AX(NF*NA) A DOUBLE PRECISION matrix whose columns are bundle points. AG(NF*NA) A DOUBLE PRECISION matrix whose columns are bundle gradients. G(NF) A DOUBLE PRECISION subgradient of the objective function. GN(NF) A DOUBLE PRECISION Reduced aggregated subgradient of the objective function. H(NH) A DOUBLE PRECISION variable metric approximation of the Hessian matrix. S(NF) A DOUBLE PRECISION direction vector. SN(NF) A DOUBLE PRECISION reduced direction vector. XO(NF) A DOUBLE PRECISION vector which contains increments of variables. GO(NF) A DOUBLE PRECISION vector which contains increments of gradients. GP(NF) A DOUBLE PRECISION Aggregated subgradient of the objective function. GS(NF) A DOUBLE PRECISION Auxiliary vector. TOLX I DOUBLE PRECISION tolerance for the change of the coordinate vector X; the choice TOLX=0 causes that the default value TOLX=1.0D-16 will be taken. TOLF I DOUBLE PRECISION tolerance for the change of function values; the choice TOLF=0 causes that the default value TOLF=1.0D-8 will be taken. TOLB I DOUBLE PRECISION minimum acceptable function value; the choice TOLB=0 causes that the default value TOLB=-1.0D60 will be taken. TOLG I DOUBLE PRECISION tolerance for the Lagrangian function gradient; the choice TOLG=0 causes that the default value TOLG=1.0D-6 will be taken. ETA I DOUBLE PRECISION distance measure parameter. EPS I DOUBLE PRECISION parameter for constraint deletion; the choice EPS=0 causes that the default value EPS=5.0D-1 will be taken. XMAX I DOUBLE PRECISION maximum stepsize; the choice XMAX=0 causes that the default value 1.0D3 will be taken. MEX I INTEGER version of nonsmooth variable metric method: MEX=0 - convex version, MET=1 - nonconvex version. MOS I INTEGER distance measure exponent (MOS=1 or MOS=2). The choice MOS=0 causes that the default value MOS=1 will be taken. MTESX I INTEGER variable that specifies the maximum number of iterations with changes of the coordinate vector X smaller than TOLX; the choice MTESX=0 causes that the default value MTESX=20 will be taken. MTESF I INTEGER variable that specifies the maximum number of iterations with changes of function values smaller than TOLF; the choice MTESF=0 causes that the default value MTESF=2 will be taken. MIT I INTEGER variable that specifies the maximum number of iterations; the choice MIT=0 causes that the default value 200 will be taken. MFV I INTEGER variable that specifies the maximum number of function evaluations; the choice |MFV|=0 causes that the default value 500 will be taken. IPRNT I INTEGER variable that specifies PRINT: IPRNT= 0 - print is suppressed, IPRNT= 1 - basic print of final results, IPRNT=-1 - extended print of final results, IPRNT= 2 - basic print of intermediate and final results, IPRNT=-2 - extended print of intermediate and final results. The subroutine PVAR has a modular structure. The following list contains its most important subroutines: PLLPB1 - Primal null space method for solving a linear programming subproblem with linear constraints. PS1L07 - Simplified line search using function values and derivatives. PS1L08 - Nonsmooth line search using function values and derivatives. PUDVI2 - Special nonsmooth variable metric updates. The subroutine PVAR requires the user supplied subroutine FUNDER which is described in Section 2. 4. Subroutine PLLPB1: --------------------- Since the primal null space method for linear programming subproblems can be used separately in many applications, we describe the subroutine PLLPB1 in more details. The calling sequence is CALL PLLPB1(NF,NC,X,IX,XO,XL,XU,CF,CFD,IC,ICA,CL,CU,CG,CR, & CZ,G,GO,S,MFP,KBF,KBC,ETA9,EPS7,EPS9,UMAX,GMAX,N,ITERL) The arguments NF, NC, X, IX, XL, XU, CF, IC, CL, CU, CG have the same meaning as in Section 2 (only with the difference that the arguments X and CF are of the type (I), i.e. they must have a value defined on entry to PLLPB1 and they are not changed). The arguments CFD, ICA, CR, CZ have the same meaning as in Section 3 (only with the difference that the arguments CFD, ICA, CR, CZ are of the type (O), i.e. their values can be used subsequently). Other arguments have the following meaning: Argument Type Significance --------------------------------------------------------------------- G(NF) I DOUBLE PRECISION gradient of the objective function. XO(NF) A DOUBLE PRECISION auxiliary vector. approximate Hessian (NH is equal to NF*(NF+1)/2). S(NF) O DOUBLE PRECISION direction vector. MFP I INTEGER variable that specifies the type of the computed point. MFP=1 - computation is terminated whenever an arbitrary feasible point is found, MFP=2 - computation is terminated whenever an optimum feasible point is found, MFP=3 - computation starts from the previously reached point and is terminated whenever an optimum feasible point is found. KBF I INTEGER variable that specifies simple bounds on variables. KBF=0 - simple bounds are suppressed, KBF=1 - one sided simple bounds, KBF=2 - two sided simple bounds. KBC I INTEGER variable that specifies general linear constraints. KBC=0 - linear constraints are suppressed, KBC=1 - one sided linear constraints, KBC=2 - two sided linear constraints. ETA9 I DOUBLE PRECISION maximum floating point number. EPS7 I DOUBLE PRECISION tolerance for linear independence of constraints (the recommended value is 1.0D-10). EPS9 I DOUBLE PRECISION tolerance for the definition of active constraints (the recommended value is 1.0D-8). UMAX O DOUBLE PRECISION maximum absolute value of the negative Lagrange multiplier. GMAX O DOUBLE PRECISION infinity norm of the gradient of the Lagrangian function. N O INTEGER dimension of the manifold defined by active constraints. ITERL O INTEGER variable that indicates the type of the computed feasible point. ITERL= 1 - an arbitrary feasible point was found, ITERL= 2 - the optimum feasible point was found, ITERL=-1 - an arbitrary feasible point does not exist, ITERL=-2 - the optimum feasible point does not exist. 5. Form of printed results: --------------------------- The form of printed results is specified by the parameter IPRNT as is described in Section 3. Here we demonstrate individual forms of printed results by the simple use of the program TVARU described in the next section (with NEXT=11). If we set IPRNT=1, then the printed results will have the form NIT= 14 NFV= 14 NFG= 14 F= -.79999998D+01 G= .4535D-06 ITERM= 4 If we set IPRNT=-1, then the printed results will have the form EXIT FROM PVAR : NIT= 14 NFV= 14 NFG= 14 F= -.79999998D+01 G= .4535D-06 ITERM= 4 X= -.1000072D+01 -.1728811D-09 If we set IPRNT=2, then the printed results will have the form ENTRY TO PVAR : NIT= 0 NFV= 1 NFG= 1 F= .60207973D+02 G= .1329D+02 NIT= 1 NFV= 2 NFG= 2 F= .43113601D+02 G= .1229D+02 NIT= 2 NFV= 3 NFG= 3 F= .26633740D+02 G= .1346D+02 NIT= 3 NFV= 4 NFG= 4 F= .11345282D+02 G= .1495D+02 NIT= 4 NFV= 5 NFG= 5 F= .37878798D+01 G= .1600D+02 NIT= 5 NFV= 6 NFG= 6 F= -.52179782D+01 G= .1600D+02 NIT= 6 NFV= 7 NFG= 7 F= -.52179782D+01 G= .6225D+01 NIT= 7 NFV= 8 NFG= 8 F= -.65520912D+01 G= .1600D+02 NIT= 8 NFV= 9 NFG= 9 F= -.77403014D+01 G= .1600D+02 NIT= 9 NFV= 10 NFG= 10 F= -.79743187D+01 G= .1600D+02 NIT= 10 NFV= 11 NFG= 11 F= -.79987188D+01 G= .1600D+02 NIT= 11 NFV= 12 NFG= 12 F= -.79999678D+01 G= .1600D+02 NIT= 12 NFV= 13 NFG= 13 F= -.79999994D+01 G= .1600D+02 NIT= 13 NFV= 14 NFG= 14 F= -.79999998D+01 G= .1600D+02 EXIT FROM PVAR : NIT= 14 NFV= 14 NFG= 14 F= -.79999998D+01 G= .4535D-06 ITERM= 4 If we set IPRNT=-2, then the printed results will have the form ENTRY TO PVAR : NIT= 0 NFV= 1 NFG= 1 F= .60207973D+02 G= .1329D+02 NIT= 1 NFV= 2 NFG= 2 F= .43113601D+02 G= .1229D+02 NIT= 2 NFV= 3 NFG= 3 F= .26633740D+02 G= .1346D+02 NIT= 3 NFV= 4 NFG= 4 F= .11345282D+02 G= .1495D+02 NIT= 4 NFV= 5 NFG= 5 F= .37878798D+01 G= .1600D+02 NIT= 5 NFV= 6 NFG= 6 F= -.52179782D+01 G= .1600D+02 NIT= 6 NFV= 7 NFG= 7 F= -.52179782D+01 G= .6225D+01 NIT= 7 NFV= 8 NFG= 8 F= -.65520912D+01 G= .1600D+02 NIT= 8 NFV= 9 NFG= 9 F= -.77403014D+01 G= .1600D+02 NIT= 9 NFV= 10 NFG= 10 F= -.79743187D+01 G= .1600D+02 NIT= 10 NFV= 11 NFG= 11 F= -.79987188D+01 G= .1600D+02 NIT= 11 NFV= 12 NFG= 12 F= -.79999678D+01 G= .1600D+02 NIT= 12 NFV= 13 NFG= 13 F= -.79999994D+01 G= .1600D+02 NIT= 13 NFV= 14 NFG= 14 F= -.79999998D+01 G= .1600D+02 EXIT FROM PVAR : NIT= 14 NFV= 14 NFG= 14 F= -.79999998D+01 G= .4535D-06 ITERM= 4 X= -.1000072D+01 -.1728811D-09 6. Verification of the subroutines: ----------------------------------- Subroutine PVARU can be verified and tested using the program TVARU. This program calls the subroutines TIUD19 (initiation), TFFU19 (function evaluation) and TFGU19 (subgradient evaluation) containing 20 academic test problems with at most 50 variables [4]. The results obtained by the program TVARU (with MEX=0) on a PC computer with Microsoft Power Station Fortran compiler have the following form. NIT= 33 NFV= 33 NFG= 33 F= .31998143D-07 G= .6222D-07 ITERM= 4 NIT= 15 NFV= 16 NFG= 16 F= .94894120D-10 G= .4745D-10 ITERM= 4 NIT= 17 NFV= 17 NFG= 17 F= .19522247D+01 G= .9348D-06 ITERM= 4 NIT= 17 NFV= 17 NFG= 17 F= .20000000D+01 G= .2918D-07 ITERM= 4 NIT= 20 NFV= 20 NFG= 20 F= -.29999997D+01 G= .4258D-06 ITERM= 4 NIT= 19 NFV= 19 NFG= 19 F= .72000001D+01 G= .1901D-06 ITERM= 4 NIT= 10 NFV= 10 NFG= 10 F= -.14142133D+01 G= .1414D-06 ITERM= 4 NIT= 55 NFV= 59 NFG= 59 F= -.99999247D+00 G= .4052D-06 ITERM= 4 NIT= 35 NFV= 35 NFG= 35 F= -.99999978D+00 G= .9370D-06 ITERM= 4 NIT= 14 NFV= 14 NFG= 14 F= -.79999998D+01 G= .4535D-06 ITERM= 4 NIT= 35 NFV= 36 NFG= 36 F= -.43999995D+02 G= .5050D-05 ITERM= 2 NIT= 30 NFV= 31 NFG= 31 F= .22600186D+02 G= .5327D-05 ITERM= 2 NIT= 46 NFV= 47 NFG= 47 F= -.32348674D+02 G= .9524D-05 ITERM= 2 NIT= 32 NFV= 32 NFG= 32 F= -.29197004D+01 G= .3444D-06 ITERM= 4 NIT= 74 NFV= 76 NFG= 76 F= .55981840D+00 G= .7330D-06 ITERM= 4 NIT= 89 NFV= 89 NFG= 89 F= -.84140570D+00 G= .3911D-06 ITERM= 4 NIT= 176 NFV= 176 NFG= 176 F= .97859847D+01 G= .9253D-06 ITERM= 4 NIT= 77 NFV= 78 NFG= 78 F= .16703846D+02 G= .1430D-04 ITERM= 2 NIT= 123 NFV= 123 NFG= 123 F= .14683216D-05 G= .9099D-06 ITERM= 4 NIT= 23 NFV= 23 NFG= 23 F= .00000000D+00 G= .3200D-22 ITERM= 4 The rows corresponding to individual test problems contain the number of iterations NIT, the number of function evaluations NFV, the number of gradient evaluations NFG, the final value of the objective function F, the value of the criterion for the termination G and the cause of termination ITERM. Subroutine PVARL can be verified and tested using the program TVARL. This program calls the subroutines TIUD22 (initiation), TAFU22 (function evaluation), TAGU22 (subgradient evaluation) containing 6 academic test problems with at most 20 variables [4]. The results obtained by the program TVARL on a PC computer with Microsoft Power Station Fortran compiler have the following form. NIT= 10 NFV= 10 NFG= 10 F= -.38965950D+00 G= .4188D-06 ITERM= 4 NIT= 4 NFV= 4 NFG= 4 F= -.33035714D+00 G= .8804D-32 ITERM= 4 NIT= 14 NFV= 14 NFG= 14 F= -.44891078D+00 G= .3474D-07 ITERM= 4 NIT= 88 NFV= 89 NFG= 89 F= -.42928061D+00 G= .2323D+01 ITERM= 2 NIT= 24 NFV= 24 NFG= 24 F= -.18596186D+01 G= .2939D-06 ITERM= 4 NIT= 25 NFV= 25 NFG= 25 F= .10183094D+00 G= .9428D-07 ITERM= 4 NIT= 93 NFV= 93 NFG= 93 F= .37907365D-05 G= .7469D-06 ITERM= 4 NIT= 137 NFV= 138 NFG= 138 F= .24306604D+02 G= .2434D-05 ITERM= 2 NIT= 119 NFV= 120 NFG= 120 F= .13372950D+03 G= .1969D-04 ITERM= 2 NIT= 138 NFV= 139 NFG= 139 F= .50695309D+00 G= .5476D-01 ITERM= 2 References: ----------- [1] Luksan L., Vlcek J.: Globally convergent variable metric method for convex nonsmooth unconstrained minimization. Journal of Optimization Theory and Applications Vol.102, 1999, pp.593-613. [2] Vlcek J., Luksan L.: Globally convergent variable metric method for nonconvex nondifferentiable unconstrained minimization. Technical Report B 8/1999. Department of Mathematical Information Technology. University of Jyvaskyla, 1999. [3] Luksan L., Vlcek J.: NDA: Algorithms for Nondifferentiable Optimization. Research Report V-797, Institute of Computer Science, Academy of Sciences of the Czech Republic, Prague, Czech Republic, 2000. [4] Luksan L., Vlcek J.: Subroutines for Testing Nonsmooth Unconstrained and Linearly Constrained Optimization Problems. Research Report V-798, Institute of Computer Science, Academy of Sciences of the Czech Republic, Prague, Czech Republic, 2000.  SHAR_EOF fi # end of overwriting check if test -f 'readme.txt' then echo shar: will not over-write existing file "'readme.txt'" else cat << "SHAR_EOF" > 'readme.txt' The NDA collection contains the following files: 1) File psubs.f containing optimization subroutines. 2) File mbsubs.f containing matrix subroutines. 3) File tbsubs.f containing test subroutines. 4) Files tminu.f, tminl.f, tbunu.f, tbunl.f, tnewu.f, tnewl.f, tvaru.f, tvarl.f, containing sample routines for the demonstration of the NDA subroutines. 5) Files pmin.txt, pbun.txt, pnew.txt pvar.txt containing descriptions of the basic NDA subroutines. 6) File com which is a batch file for starting the sample routines. SHAR_EOF fi # end of overwriting check if test -f 'routinedoc.tex' then echo shar: will not over-write existing file "'routinedoc.tex'" else cat << "SHAR_EOF" > 'routinedoc.tex' \documentclass{article} \begin{document} \section*{DESCRIPTION OF SUBROUTINES} \noindent In this section we describe easy-to-use subroutines which can be called from the user's program. In the description of formal parameters we introduce a type of the argument denoted by two letters. The first letter is either \texttt{I} for integer arguments or \texttt{R} for double precision real arguments. The second letter specifies whether the argument must have a value defined on the entry to the subroutine (\texttt{I}), whether it is a value which will be returned (\texttt{O}), or both (\texttt{U}), or whether it is an auxiliary value (\texttt{A}). Notice that the input type arguments can be changed on the output under some circumstances, especially if improper input values were given. Besides the formal parameters, we use a \verb|COMMON /STAT/| block containing statistical information. This block, used in each subroutine, has the following form: {\small \begin{verbatim} COMMON /STAT/ NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH \end{verbatim} } Its elements have the following meanings: \vspace{2mm} {\small \noindent\parbox{20mm}{Element}\parbox{10mm}{$\!$Type}\parbox[t]{91mm} {Significance}\par\noindent\rule[1mm]{121mm}{.4pt} \par \noindent\parbox{20mm}{\texttt{NDECF}}\parbox{10mm}{\texttt{IO}}\parbox[t]{91mm}{ Number of matrix decompositions.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{NRES}}\parbox{10mm}{\texttt{IO}}\parbox[t]{91mm}{ Number of restarts.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{NRED}}\parbox{10mm}{\texttt{IO}}\parbox[t]{91mm}{ Number of reductions.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{NREM}}\parbox{10mm}{\texttt{IO}}\parbox[t]{91mm}{ Number of constraint deletions during the QP solutions.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{NADD}}\parbox{10mm}{\texttt{IO}}\parbox[t]{91mm}{ Number of constraint additions during the QP solutions.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{NIT}}\parbox{10mm}{\texttt{IO}}\parbox[t]{91mm}{ Number of iterations.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{NFV}}\parbox{10mm}{\texttt{IO}}\parbox[t]{91mm}{ Number of function evaluations.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{NFG}}\parbox{10mm}{\texttt{IO}}\parbox[t]{91mm}{ Number of gradient evaluations.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{NFH}}\parbox{10mm}{\texttt{IO}}\parbox[t]{91mm}{ Number of Hessian evaluations.} \vspace{2mm} } \noindent Easy-to-use subroutines are called by the following statements: {\small \begin{verbatim} CALL PMINU(NF,NA,X,AF,IA,RA,IPAR,RPAR,F,GMAX,IEXT,ITERM) CALL PMINS(NF,NA,NB,X,IX,XL,XU,AF,IA,RA,IPAR,RPAR,F,GMAX,IEXT,ITERM) CALL PMINL(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,AF,IA,RA,IPAR,RPAR, & F,GMAX,IEXT,ITERM) CALL PBUNU(NF,NA,X,IA,RA,IPAR,RPAR,F,GMAX,ITERM) CALL PBUNS(NF,NA,NB,X,IX,XL,XU,IA,RA,IPAR,RPAR,F,GMAX,ITERM) CALL PBUNL(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,IA,RA,IPAR,RPAR, & F,GMAX,ITERM) CALL PNEWU(NF,NA,X,IA,RA,IPAR,RPAR,F,GMAX,IHES,ITERM) CALL PNEWS(NF,NA,NB,X,IX,XL,XU,IA,RA,IPAR,RPAR,F,GMAX,IHES,ITERM) CALL PNEWL(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,IA,RA,IPAR,RPAR, & F,GMAX,IHES,ITERM) CALL PVARU(NF,NA,X,RA,IPAR,RPAR,F,GMAX,ITERM) CALL PVARS(NF,NA,NB,X,IX,XL,XU,RA,IPAR,RPAR,F,GMAX,ITERM) CALL PVARL(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,IA,RA,IPAR,RPAR, & F,GMAX,ITERM) \end{verbatim} } Their arguments have the following meanings: %\newpage \vspace{2mm} {\small \noindent\parbox{20mm}{Argument}\parbox{10mm}{$\!$Type}\parbox[t]{91mm} {Significance}\par\noindent\rule[1mm]{121mm}{.4pt} \par \noindent\parbox{20mm}{\texttt{NF}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ Number of variables of the objective function.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{NA}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ Number of functions in the minimax criterion for subroutines {\tt PMINU}, {\tt PMINS}, {\tt PMINL} or the maximum bundle dimension for the other subroutines (choice $\texttt{NA}=0$ causes that the default value $\texttt{NA}=$\texttt{NF}+3 will be taken in a later case)} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{NB}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ Specification whether the simple bounds are suppressed ($\texttt{NB}=0$) or accepted ($\texttt{NB}>0$).} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{NC}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ Number of linear constraints; if $\texttt{NC}=0$ the linear constraints are suppressed.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{X(NF)}}\parbox{10mm}{\texttt{RU}}\parbox[t]{91mm}{ On input, vector with the initial estimate to the solution. On output, the approximation to the minimum.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{IX(NF)}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ Vector containing the simple bound types (significant only if $\texttt{NB}>0$):} \par\vspace{1mm} \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{IX(I)}=0$:}\parbox[t]{71mm}{ the variable X(I) is unbounded,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{IX(I)}=1$:}\parbox[t]{71mm}{ the lower bound $\texttt{X(I)}\ge\texttt{XL(I)}$,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{IX(I)}=2$:}\parbox[t]{71mm}{ the upper bound $\texttt{X(I)}\le\texttt{XU(I)}$,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{IX(I)}=3$:}\parbox[t]{71mm}{ the two-side bound $\texttt{XL(I)}\le\texttt{X(I)}\le\texttt{XU(I)}$,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{IX(I)}=5$:}\parbox[t]{71mm}{ the variable \texttt{X(I)} is fixed (given by its initial estimate).} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{XL(NF)}}\parbox{10mm}{\texttt{RI}}\parbox[t]{91mm}{ Vector with lower bounds for variables (significant only if $\texttt{NB}>0$).} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{XU(NF)}}\parbox{10mm}{\texttt{RI}}\parbox[t]{91mm}{ Vector with upper bounds for variables (significant only if $\texttt{NB}>0$).} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{CF(NC)}}\parbox{10mm}{\texttt{RA}}\parbox[t]{91mm}{ Vector which contains values of constraint functions (significant only if $\texttt{NC}>0$).} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{IC(NC)}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ INTEGER vector which contains constraint types (significant only if $\texttt{NC}>0$):} \par\vspace{1mm} \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{IC(K)}=0$:}\parbox[t]{71mm}{ the constraint \texttt{CF(K)} is not used,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{IC(K)}=1$:}\parbox[t]{71mm}{ the lower constraint $\texttt{CF(K)}\ge\texttt{CL(K)}$,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{IC(K)}=2$:}\parbox[t]{71mm}{ the upper constraint $\texttt{CF(K)}\le\texttt{CU(K)}$,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{IC(K)}=3$:}\parbox[t]{71mm}{ the two-side constraint $\texttt{CL(K)}\le\texttt{CF(K)}\le\texttt{CU(K)}$,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{IC(K)}=5$:}\parbox[t]{71mm}{ the equality constraint $\texttt{CF(K)}=\texttt{CL(K)}$.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{CL(NC)}}\parbox{10mm}{\texttt{RI}}\parbox[t]{91mm}{ Vector with lower bounds for constraint functions (significant only if $\texttt{NC}>0$).} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{CU(NC)}}\parbox{10mm}{\texttt{RI}}\parbox[t]{91mm}{ Vector with upper bounds for constraint functions (significant only if $\texttt{NC}>0$).} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{CG(NF*NC)}}\parbox{10mm}{\texttt{RI}}\parbox[t]{91mm}{ Matrix whose columns are normals of the linear constraints (significant only if $\texttt{NC}>0$).} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{AF(NA)}}\parbox{10mm}{\texttt{RO}}\parbox[t]{91mm}{ Vector which contains the values of functions in the minimax criterion.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{IA(NIA)}}\parbox{10mm}{\texttt{IA}}\parbox[t]{91mm}{ Working array of the dimension \texttt{NIA}, where at least \texttt{NIA}=\texttt{NF}+\texttt{NA}+1.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{RA(NRA)}}\parbox{10mm}{\texttt{RA}}\parbox[t]{91mm}{ Working array of the dimension \texttt{NRA}. The minimum values of \texttt{NRA} required in individual subroutines can be found in text files {\tt PMIN.TXT}, {\tt PBUN.TXT}, {\tt PNEW.TXT}, {\tt PVAR.TXT}.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{IPAR(7)}}\parbox{10mm}{\texttt{IA}}\parbox[t]{91mm}{ Integer parameters (see Table 5.1).} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{RPAR(7)}}\parbox{10mm}{\texttt{RA}}\parbox[t]{91mm}{ Real parameters (see Table 5.1).} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{F}}\parbox{10mm}{\texttt{RO}}\parbox[t]{91mm}{ Value of the objective function at the solution \texttt{X}.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{GMAX}}\parbox{10mm}{\texttt{RO}}\parbox[t]{91mm}{ value indicating the termination ($\|g^k\|_{\infty}$ in {\tt PMIN} or $w^k$ in {\tt PBUN}, {\tt PNEW} and {\tt PVAR}).} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{IEXT}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ Variable that specifies the minimax criterion:} \par\vspace{1mm} \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{IEXT}<0$:}\parbox[t]{71mm}{ maximum of positive values,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{IEXT}=0$:}\parbox[t]{71mm}{ maximum of absolute values,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{IEXT}>0$:}\parbox[t]{71mm}{ maximum of negative values,} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{IHES}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ Variable that specifies a way for computing second derivatives:} \par\vspace{1mm} \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{IHES}=0$:}\parbox[t]{71mm}{ numerical computation,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{IHES}=1$:}\parbox[t]{71mm}{ analytical computation by the user supplied subroutine HES.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{ITERM}}\parbox{10mm}{\texttt{IO}}\parbox[t]{91mm}{ Variable that indicates the cause of termination:} \par\vspace{1mm} \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{ITERM}=1$:}\parbox[t]{71mm}{ if $|x - x_{old}|$ was less than or equal to \texttt{TOLX} in \texttt{MTESX} subsequent iterations,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{ITERM}=2$:}\parbox[t]{71mm}{ if $|F - F_{old}|$ was less than or equal to \texttt{TOLF} in \texttt{MTESF} subsequent iterations,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{ITERM}=3$:}\parbox[t]{71mm}{ if \texttt{F} is less than or equal to \texttt{TOLB},} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{ITERM}=4$:}\parbox[t]{71mm}{ if \texttt{GMAX} is less than or equal to \texttt{TOLG},} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{ITERM}=11$:}\parbox[t]{71mm}{ if \texttt{NFV} exceeded \texttt{MFV},} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{ITERM}=12$:}\parbox[t]{71mm}{ if \texttt{NIT} exceeded \texttt{MIT},} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{ITERM}<0$:}\parbox[t]{71mm}{ if the method failed ({$\texttt{ITERM}=-6$} if the required precision was not achieved, {$\texttt{ITERM}=-10$} if two consecutive restarts were required, {$\texttt{ITERM}=-12$} if the quadratic programming subroutine failed).} } The integer and real parameters are listed in the following table: \vspace{2mm} \begin{center} \begin{tabular}{c|llll} \hline Parameter & {\tt PMIN} & {\tt PBUN} & {\tt PNEW} & {\tt PVAR} \\ \hline {\tt IPAR(1)} & {\tt MET} & {\tt MOT} & {\tt MOS} & {\tt MEX} \\ {\tt IPAR(2)} & {\tt MEC} & {\tt MES} & {\tt MES} & {\tt MOS} \\ {\tt IPAR(3)} & {\tt MER} & {\tt MTESX} & {\tt MTESX} & {\tt MTESX} \\ {\tt IPAR(4)} & {\tt MES} & {\tt MTESF} & {\tt MTESF} & {\tt MTESF} \\ {\tt IPAR(5)} & {\tt MIT} & {\tt MIT} & {\tt MIT} & {\tt MIT} \\ {\tt IPAR(6)} & {\tt MFV} & {\tt MFV} & {\tt MFV} & {\tt MFV} \\ {\tt IPAR(7)} & {\tt IPRNT} & {\tt IPRNT} & {\tt IPRNT} & {\tt IPRNT} \\ \hline {\tt RPAR(1)} & {\tt TOLX} & {\tt TOLX} & {\tt TOLX} & {\tt TOLX} \\ {\tt RPAR(2)} & {\tt TOLF} & {\tt TOLF} & {\tt TOLF} & {\tt TOLF} \\ {\tt RPAR(3)} & {\tt TOLB} & {\tt TOLB} & {\tt TOLB} & {\tt TOLB} \\ {\tt RPAR(4)} & {\tt TOLG} & {\tt TOLG} & {\tt TOLG} & {\tt TOLG} \\ {\tt RPAR(5)} & {\tt TOLD} & {\tt TOLD} & {\tt TOLD} & {\tt ETA} \\ {\tt RPAR(6)} & {\tt TOLS} & {\tt TOLS} & {\tt TOLS} & {\tt EPS} \\ {\tt RPAR(7)} & {\tt XMAX} & {\tt TOLP }& {\tt TOLP} & {\tt XMAX} \\ {\tt RPAR(8)} & - & {\tt ETA} & {\tt ETA} & - \\ {\tt RPAR(9)} & - & {\tt XMAX} & {\tt XMAX} & - \\ \hline \end{tabular} \vspace{4mm} Table 5.2 - Integer and real parameters \end{center} \vspace{2mm} Integer and real parameters have the following meanings: \vspace{2mm} {\small \noindent\parbox{20mm}{Argument}\parbox{10mm}{$\!$Type}\parbox[t]{91mm} {Significance}\par\noindent\rule[1mm]{121mm}{.4pt} \par \noindent\parbox{20mm}{\texttt{MET}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ Variable that specifies self-scaling for variable metric updates:} \par\vspace{1mm} \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{MET}=1$:}\parbox[t]{71mm}{ self-scaling is suppressed,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{MET}=2$:}\parbox[t]{71mm}{ self-scaling is used only in the first iteration (initial self-scaling),} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{MET}=3$:}\parbox[t]{71mm}{ self-scaling is controlled by a special procedure.} \par\vspace{1mm} \noindent\parbox{30mm}{$\;$}\parbox[t]{91mm}{The choice $\texttt{MET}=0$ causes that the default value $\texttt{MET}=3$ will be taken.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{MEC}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ Variable that specifies correction of variable metric updates if negative curvature occurs:} \par\vspace{1mm} \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{MEC}=1$:}\parbox[t]{71mm}{ correction is suppressed,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{MEC}=2$:}\parbox[t]{71mm}{ Powell's correction is used.} \par\vspace{1mm} \noindent\parbox{30mm}{$\;$}\parbox[t]{91mm}{The choice $\texttt{MEC}=0$ causes that the default value $\texttt{MEC}=1$ will be taken.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{MER}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ Variable that specifies restart after unsuccessgful variable metric updates:} \par\vspace{1mm} \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{MER}=0$:}\parbox[t]{71mm}{ restart is suppressed,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{MER}=1$:}\parbox[t]{71mm}{ variable metric method is restarted by using the unit matrix.} \par\vspace{1mm} \noindent\parbox{20mm}{\texttt{MEX}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ Variable that specifies version of nonsmooth variable metric method:} \par\vspace{1mm} \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{MEX}=0$:}\parbox[t]{71mm}{ convex version is used,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{MEX}=1$:}\parbox[t]{71mm}{ nonconvex version is used.} \par\vspace{1mm} \noindent\parbox{20mm}{\texttt{MOT}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ Variable that specifies the weight updating method:} \par\vspace{1mm} \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{MOT}=1$:}\parbox[t]{71mm}{ quadratic interpolation,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{MOT}=2$:}\parbox[t]{71mm}{ local minimization,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{MOT}=3$:}\parbox[t]{71mm}{ quasi-Newton condition.} \par\vspace{1mm} \noindent\parbox{30mm}{$\;$}\parbox[t]{91mm}{The choice $\texttt{MOT}=0$ causes that the default value $\texttt{MOT}=1$ will be taken.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{MOS}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ Distance measure exponent $\omega$ (either $1$ or $2$). The choice $\texttt{MOS}=0$ causes that the default value $\texttt{MOS}=1$ will be taken.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{MES}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ Variable that specifies the interpolation method selection in a line search (until a sufficient function decrease is reached; then only bisection will be used):} \par\vspace{1mm} \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{MES}=1$:}\parbox[t]{71mm}{ bisection,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{MES}=2$:}\parbox[t]{71mm}{ two-point quadratic interpolation.} \par\vspace{1mm} \noindent\parbox{30mm}{$\;$}\parbox[t]{91mm}{The choice $\texttt{MES}=0$ causes that the default value $\texttt{MES}=2$ will be taken.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{MTESX}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ Maximum number of iterations with changes of the coordinate vector \texttt{X} smaller than \texttt{TOLX}; the choice $\texttt{MTESX}=0$ causes that the default value $20$ will be taken.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{MTESF}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ Maximum number of iterations with changes of function values smaller than TOLF; the choice $\texttt{MTESF}=0$ causes that the default value $2$ will be taken.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{MIT}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ Maximum number of iterations; the choice $\texttt{MIT}=0$ causes that the default value $200$ will be taken.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{MFV}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ Maximum number of function evaluations; the choice $\texttt{MFV}=0$ causes that the default value $500$ will be taken.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{IPRNT}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ Print specification:} \par\vspace{1mm} \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{IPRNT}= 0$:}\parbox[t]{71mm}{ print is suppressed,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{IPRNT}= 1$:}\parbox[t]{71mm}{ basic print of final results,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{IPRNT}=-1$:}\parbox[t]{71mm}{ extended print of final results,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{IPRNT}= 2$:}\parbox[t]{71mm}{ basic print of intermediate and final results,} \par \noindent\parbox{30mm}{$\;$}\parbox{20mm}{$\texttt{IPRNT}=-2$:}\parbox[t]{71mm}{ extended print of intermediate and final results,} \par \noindent\parbox{20mm}{\texttt{TOLX}}\parbox{10mm}{\texttt{RI}}\parbox[t]{91mm}{ Tolerance for the change of the coordinate vector \texttt{X}; the choice $\texttt{TOLX}=0$ causes that the default value $10^{-16}$ will be taken.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{TOLF}}\parbox{10mm}{\texttt{RI}}\parbox[t]{91mm}{ Tolerance for the change of the function value; the choice $\texttt{TOLF}=0$ causes that the default value $10^{-8}$ will be taken.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{TOLB}}\parbox{10mm}{\texttt{RI}}\parbox[t]{91mm}{ Minimum acceptable function value; the choice $\texttt{TOLB}= 0$ causes that the default value $-10^{60}$ will be taken.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{TOLG}}\parbox{10mm}{\texttt{RI}}\parbox[t]{91mm}{ Tolerance for the gradient of the Lagrangian function; the choice $\texttt{TOLG}=0$ causes that the default value $10^{-6}$ will be taken.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{TOLD}}\parbox{10mm}{\texttt{RI}}\parbox[t]{91mm}{ Restart tolerance $\underline{\varepsilon}$; the choice $\texttt{TOLD}=0$ causes that the default value $10^{-4}$ will be taken.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{TOLS}}\parbox{10mm}{\texttt{RI}}\parbox[t]{91mm}{ Line search tolerance $m_L$; the choice $\texttt{TOLS}=0$ causes that the default value $10^{-2}$ will be taken.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{TOLP}}\parbox{10mm}{\texttt{RI}}\parbox[t]{91mm}{ Line search tolerance $m_R$; the choice $\texttt{TOLP}=0$ causes that the default value $0.5$ will be taken.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{ETA}}\parbox{10mm}{\texttt{RI}}\parbox[t]{91mm}{ Distance measure parameter $\gamma$.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{EPS}}\parbox{10mm}{\texttt{RI}}\parbox[t]{91mm}{ Parameter for constraint deletion; the choice $\texttt{EPS}=0$ causes that the default value $0.5$ will be taken.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{XMAX}}\parbox{10mm}{\texttt{RI}}\parbox[t]{91mm}{ Maximum stepsize; the choice $\texttt{XMAX}=0$ causes that the default value $10^3$ will be taken.} } \vspace{2mm} The choice of parameters {\texttt{ETA}} and {\texttt{XMAX}} is rather delicate. It can considerably influence the efficiency of the method. Therefore, these parameters should be tuned carefully. Briefly, the parameter {\texttt{ETA}} should be smaller (e.g. $10^{-12}-10^{-6}$) for convex problems and larger (e.g. $10^{-4}-10^2$) for nonconvex problems. The parameter {\texttt{XMAX}} reduces the stepsize so that it plays an important role in the neighborhood of the kink. The other parameters are not so important, but small {\texttt{MTESX}} or {\texttt{MTESF}} can lead to premature termination of the iterative process and an unsuitable value of {\texttt{EPS}} can unfavourably influence constraint handling in the linearly constrained case. Subroutines {\tt PMINU}, {\tt PMINS}, {\tt PMINL} require the user supplied subroutines {\tt FUN} and {\tt DER} which define the values and the gradients of the functions in the minimax criterion and have the form \begin{verbatim} SUBROUTINE FUN(NF,KA,X,FA) SUBROUTINE DER(NF,KA,X,GA) \end{verbatim} \noindent Subroutines {\tt PBUNU}, {\tt PBUNS}, {\tt PBUNL}, {\tt PNEWU}, {\tt PNEWS}, {\tt PNEWL}, {\tt PVARU}, {\tt PVARS}, {\tt PVARL} require the user supplied subroutine {\tt FUNDER} which defines the objective function and its subgradient and has the form \begin{verbatim} SUBROUTINE FUNDER(NF,X,F,G) \end{verbatim} \noindent Subroutines {\tt PNEWU}, {\tt PNEWS}, {\tt PNEWL} require the additional user supplied subroutine {\tt HES} which defines the matrix of the second-order information (usually the Hessian matrix) and has the form \begin{verbatim} SUBROUTINE HES(NF,X,H) \end{verbatim} \noindent If \texttt{IHES}=0, then the user supplied subroutine {\tt HES} can be empty. The arguments of user supplied subroutines have the following meanings: \vspace{2mm} %\newpage {\small \noindent\parbox{20mm}{Argument}\parbox{10mm}{$\!$Type}\parbox[t]{91mm} {Significance}\par\noindent\rule[1mm]{121mm}{.4pt} \par \noindent\parbox{20mm}{\texttt{NF}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ Number of variables of the objective function.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{KA}}\parbox{10mm}{\texttt{II}}\parbox[t]{91mm}{ Index of a function in the minimax criterion.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{X(NF)}}\parbox{10mm}{\texttt{RI}}\parbox[t]{91mm}{ An estimate to the solution.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{FA}}\parbox{10mm}{\texttt{RO}}\parbox[t]{91mm}{ Value of a function with the index \texttt{KA} at point \texttt{X}.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{GA(NF)}}\parbox{10mm}{\texttt{RO}}\parbox[t]{91mm}{ Gradient of a function with the index \texttt{KA} at point \texttt{X}.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{F}}\parbox{10mm}{\texttt{RO}}\parbox[t]{91mm}{ Value of the objective function at point \texttt{X}.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{G(NF)}}\parbox{10mm}{\texttt{RO}}\parbox[t]{91mm}{ Subgradient of the objective function at point \texttt{X}.} \par\vspace{2mm} \noindent\parbox{20mm}{\texttt{H(NH)}}\parbox{10mm}{\texttt{RO}}\parbox[t]{91mm}{ Matrix of the second-order information at point \texttt{X} (NH is equal to NF*(NF+1)/2).} \vspace{5mm} } \vspace{5mm} \end{document} SHAR_EOF fi # end of overwriting check cd .. if test ! -d 'Fortran' then mkdir 'Fortran' fi cd 'Fortran' if test ! -d 'Dp' then mkdir 'Dp' fi cd 'Dp' if test ! -d 'Drivers' then mkdir 'Drivers' fi cd 'Drivers' if test -f 'data1' then echo shar: will not over-write existing file "'data1'" else cat << "SHAR_EOF" > 'data1' 273 1272 744 1138 1972 1580 1878 1539 1457 429 1129 1251 1421 588 334 837 1364 229 961 754 1169 1488 720 1280 816 664 1178 939 1698 983 1119 1029 1815 721 1753 330 1499 1107 1576 942 484 617 896 1184 1030 1718 604 999 809 866 1722 1338 1640 1266 1185 440 894 992 1173 334 358 626 1124 358 847 533 915 1219 481 1009 543 937 915 667 1441 812 848 776 1560 526 1494 598 1244 1304 1306 685 668 444 1157 1359 1176 1475 335 1519 140 937 697 951 267 227 1229 587 369 554 721 1212 739 596 1291 1114 701 426 285 676 155 456 1936 319 337 604 907 214 424 748 817 666 1592 521 2172 356 467 1583 882 2139 2182 1961 781 678 1425 1861 1473 1713 1761 1617 370 1073 1304 1369 1092 453 798 1283 973 565 1315 1204 1796 846 1447 1143 959 1275 1213 2085 742 1309 1479 1760 703 1727 872 1479 686 1698 1057 387 1252 904 668 443 1600 930 1052 776 1049 402 361 1119 578 406 618 581 1095 670 641 1152 1060 567 433 374 579 235 325 1802 331 217 665 862 182 312 864 732 783 1456 608 2066 491 400 1466 744 2013 2082 1865 875 552 400 182 820 721 1735 851 740 551 1551 1769 1159 613 2072 1300 1605 807 1017 1251 818 1259 2596 826 1137 1255 1123 943 1359 188 1282 271 2300 483 2540 609 1038 2099 1766 2699 2493 2266 264 1398 304 699 538 1335 454 393 173 1198 1370 760 216 1692 919 1286 435 879 861 548 913 2198 483 803 1181 731 627 1086 292 883 279 1906 178 2156 490 662 1699 1430 2300 2117 1888 138 1023 884 755 1612 749 690 476 1501 1654 1049 516 1995 1149 1580 739 1079 1161 815 1214 2485 780 1100 1347 985 916 1361 260 1171 328 2202 445 2385 665 966 1969 1729 2568 2333 2108 177 1327 177 1486 757 506 609 981 1474 967 681 1552 1317 936 594 197 928 316 723 2203 500 604 482 1104 455 630 641 1058 562 1857 528 2425 220 704 1845 1122 2405 2428 2204 738 945 1362 587 335 435 930 1358 819 504 1496 1153 927 428 341 803 180 649 2119 343 521 652 939 340 649 533 918 451 1783 362 2290 130 568 1727 1105 2301 2285 2059 595 853 891 1082 1199 726 96 583 1125 653 563 947 986 1493 560 1183 813 882 1033 902 1763 642 1032 1131 1604 463 1556 663 1298 947 1461 795 371 882 967 973 768 1472 588 252 308 803 920 309 238 1252 569 940 165 863 414 454 552 1745 269 482 1188 355 397 833 713 432 666 1453 410 1758 642 262 1260 1051 1858 1737 1508 592 598 222 814 1094 510 235 1335 820 892 100 626 541 219 524 1897 90 410 952 605 238 706 570 622 503 1581 257 1985 396 309 1453 1039 2043 1972 1744 514 661 1025 1227 617 90 1525 835 1114 263 770 700 400 740 2049 311 630 1087 630 459 924 405 739 360 1749 115 2055 428 492 1568 1256 2166 2026 1796 303 853 663 632 999 572 972 225 763 908 451 767 293 1240 726 420 1111 862 617 443 1374 586 1299 887 1070 1633 1057 547 999 252 1483 1681 1489 1326 236 610 1156 557 642 879 1000 1467 558 1178 780 831 1038 879 1726 700 1023 1082 1631 488 1579 586 1320 982 1463 796 371 802 949 1021 826 1508 550 546 983 397 821 411 1023 180 651 478 1438 476 485 1333 235 525 827 1022 123 973 1155 715 1475 902 273 953 882 1550 1467 1240 898 396 1479 745 1105 240 831 645 442 723 1983 316 623 1152 543 470 939 482 669 443 1690 205 1969 510 455 1492 1238 2091 1938 1709 354 813 1163 676 1264 1473 839 1326 847 801 1254 976 1643 1157 1169 983 1905 878 1836 346 1590 1286 1621 1034 689 503 995 1376 1239 1828 674 1183 725 1399 549 1004 869 1427 818 882 1716 214 902 1222 1210 390 1184 1225 949 1239 1210 660 863 1207 1446 1197 969 1042 741 865 821 644 790 388 1374 803 484 968 1056 665 318 1420 794 1341 1017 1137 1836 1056 679 1200 189 1645 1891 1704 1403 442 699 453 290 483 1809 107 384 1024 511 251 712 646 525 585 1499 330 1885 495 231 1356 999 1949 1872 1644 567 591 950 410 690 2147 594 590 326 1191 499 504 838 1098 758 1794 703 2439 414 751 1837 1011 2374 2455 2237 928 921 624 325 1356 480 369 1241 413 473 680 1097 166 1038 1049 781 1497 905 238 925 702 1506 1506 1287 998 216 479 1941 188 350 736 792 161 547 632 745 552 1607 375 2115 296 392 1547 959 2121 2114 1890 641 676 1480 435 129 949 708 325 355 1081 492 1007 1137 779 1759 774 291 1148 516 1688 1785 1573 1038 231 1829 1603 2339 1524 1780 1673 2421 1315 2394 357 2136 825 2237 1589 579 1204 347 959 940 2336 1266 320 919 605 154 623 652 580 582 1508 344 1950 429 242 1402 949 1986 1943 1717 603 582 872 699 197 358 957 529 881 1263 660 1849 645 240 1250 631 1802 1867 1650 923 341 1511 815 669 1092 1397 1019 1982 1010 2708 695 1061 2089 1148 2594 2734 2520 1212 1176 697 1051 1018 290 985 1280 743 1427 996 466 987 1110 1584 1395 1166 861 626 469 761 607 685 1446 472 1969 457 254 1393 823 1963 1975 1752 739 515 1171 847 1089 1316 919 2063 776 598 1434 507 1926 2101 1898 1187 548 1144 83 2145 317 2445 426 875 1972 1584 2571 2408 2179 194 1231 1094 1036 836 1371 1008 354 833 828 1429 1369 1146 1021 352 2083 259 2412 345 811 1925 1507 2523 2380 2151 220 1163 1628 1005 1903 1272 504 849 653 1114 1019 2044 932 2165 330 559 1668 1291 2264 2138 1908 268 917 2377 1723 636 1720 534 145 290 2281 1531 667 1829 1235 2410 2367 2139 519 972 1162 792 1744 1724 1500 796 361 1087 600 701 550 1835 917 1490 1787 1614 1553 486 678 727 2435 1461 229 2238 1560 2010 1353 1157 61 67 24 84 13 86 89 46 48 50 74 75 88 40 29 45 32 21 61 21 51 14 89 79 38 20 97 19 10 73 59 92 52 66 89 65 63 47 7 61 87 19 36 43 9 12 8 67 22 53 64 15 66 37 16 23 67 18 52 69 17 29 50 13 95 34 59 36 22 94 28 34 36 38 55 77 45 34 32 58 30 88 74 59 93 54 89 30 79 46 35 41 99 52 76 93 144 257 0 483 89 -165 -72 -252 -88 -178 311 126 7 -135 158 209 101 -92 229 80 95 71 -244 102 -12 132 337 61 104 41 261 118 99 -246 156 -270 330 -130 952 -62 161 484 122 474 1086 861 -170 206 SHAR_EOF fi # end of overwriting check if test -f 'driver1.f' then echo shar: will not over-write existing file "'driver1.f'" else cat << "SHAR_EOF" > 'driver1.f' C PROGRAM TBUNL C C TEST PROGRAM FOR THE SUBROUTINE PBUNL C C CALL TYTIM1(ITIME) C C LOOP FOR 10 TEST PROBLEMS C C .. Scalars in Common .. INTEGER IEXT,KAP,LAP,NAA,NADD,NDECF,NEXT,NFG,NFH,NFV,NIT,NRED, + NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION F,FMIN,GMAX INTEGER I,IERR,ITERM,NA,NB,NC,NF C .. C .. Local Arrays .. DOUBLE PRECISION CF(20),CG(200),CL(20),CU(20),RA(5000),RPAR(9), + X(40),XL(40),XU(40) INTEGER IA(200),IC(20),IPAR(7),IX(40) C .. C .. External Subroutines .. EXTERNAL PBUNL,TILD22 C .. C .. Common blocks .. COMMON /PROB/IEXT,NEXT,NAA,KAP,LAP COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. DO 30 NEXT = 1,10 C C CHOICE OF INTEGER AND REAL PARAMETERS C DO 10 I = 1,7 IPAR(I) = 0 10 CONTINUE DO 20 I = 1,9 RPAR(I) = 0.0D0 20 CONTINUE IPAR(7) = 1 RPAR(8) = 0.25D0 IF (NEXT.EQ.1 .OR. NEXT.EQ.3) RPAR(8) = 0.0D0 C C PROBLEM DIMENSION C NF = 20 NA = 0 NB = 20 NC = 15 NAA = 165 C C INITIATION OF X AND CHOICE OF RPAR(9) C CALL TILD22(NF,NAA,NB,NC,X,IX,XL,XU,IC,CL,CU,CG,FMIN,RPAR(9), + NEXT,IEXT,IERR) IF (NEXT.EQ.4) RPAR(8) = 0.1D0 IF (NEXT.EQ.5) RPAR(8) = 0.0D0 IF (NEXT.EQ.6) RPAR(8) = 0.5D0 IF (NEXT.EQ.7) RPAR(9) = 0.5D-1 IF (NEXT.EQ.8) RPAR(8) = 1.0D0 IF (NEXT.EQ.10) RPAR(8) = 0.5D0 IF (NEXT.EQ.10) RPAR(9) = 1.0D2 IF (NEXT.EQ.11) RPAR(8) = 1.0D-4 IF (NEXT.EQ.11) RPAR(9) = 1.0D1 IF (NEXT.EQ.12) RPAR(8) = 0.0D0 IF (NEXT.EQ.13) RPAR(8) = 1.0D-2 IF (NEXT.EQ.14) RPAR(8) = 0.0D0 IF (NEXT.EQ.15) RPAR(8) = 0.0D0 IF (NEXT.EQ.15) RPAR(9) = 1.0D2 IF (IERR.NE.0) GO TO 30 C C SOLUTION C CALL PBUNL(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,IA,RA,IPAR, + RPAR,F,GMAX,ITERM) 30 CONTINUE C CALL TYTIM2(ITIME) STOP END C C USER SUPPLIED SUBROUTINE (CALCULATION OF FA) C SUBROUTINE FUNDER(NF,X,F,G) C C FUNCTION EVALUATION C C .. Scalar Arguments .. DOUBLE PRECISION F INTEGER NF C .. C .. Array Arguments .. DOUBLE PRECISION G(*),X(*) C .. C .. Scalars in Common .. INTEGER IEXT,KAP,LAP,NA,NEXT C .. C .. Local Scalars .. DOUBLE PRECISION FTEMP,FVAL INTEGER K,KA C .. C .. External Subroutines .. EXTERNAL MXVNEG,TAFU22,TAGU22 C .. C .. Common blocks .. COMMON /PROB/IEXT,NEXT,NA,KAP,LAP C .. DO 10 KA = 1,NA CALL TAFU22(NF,KA,X,F,NEXT) IF (IEXT.EQ.0 .AND. F.GE.0.0D0 .OR. IEXT.LT.0) THEN FTEMP = F K = 1 ELSE FTEMP = -F K = -1 END IF IF (KA.EQ.1 .OR. FVAL.LT.FTEMP) THEN FVAL = FTEMP KAP = KA LAP = K END IF 10 CONTINUE F = FVAL C C GRADIENT EVALUATION C CALL TAGU22(NF,KAP,X,G,NEXT) IF (LAP.GE.0) THEN ELSE CALL MXVNEG(NF,G,G) END IF RETURN END * * EMPTY SUBROUTINES * SUBROUTINE FUN(NF,KA,X,FA) C .. Scalar Arguments .. DOUBLE PRECISION FA INTEGER KA,NF C .. C .. Array Arguments .. DOUBLE PRECISION X(*) C .. RETURN END SUBROUTINE DER(NF,KA,X,GA) C .. Scalar Arguments .. INTEGER KA,NF C .. C .. Array Arguments .. DOUBLE PRECISION GA(*),X(*) C .. RETURN END SUBROUTINE HES(NF,X,H) C .. Scalar Arguments .. INTEGER NF C .. C .. Array Arguments .. DOUBLE PRECISION H(*),X(*) C .. RETURN END SHAR_EOF fi # end of overwriting check if test -f 'driver2.f' then echo shar: will not over-write existing file "'driver2.f'" else cat << "SHAR_EOF" > 'driver2.f' * PROGRAM TBUNU * * TEST PROGRAM FOR THE SUBROUTINE PBUNU * C .. Scalars in Common .. INTEGER NADD,NDECF,NEXT,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION F,FMIN,GMAX INTEGER I,IERR,ITERM,NA,NF C .. C .. Local Arrays .. DOUBLE PRECISION RA(5000),RPAR(9),X(50) INTEGER IA(200),IPAR(7) C .. C .. External Subroutines .. EXTERNAL PBUNU,TIUD19 C .. C .. Common blocks .. COMMON /PROB/NEXT COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. C CALL TYTIM1(ITIME) * * LOOP FOR 20 TEST PROBLEMS * DO 30 NEXT = 1,20 * * CHOICE OF INTEGER AND REAL PARAMETERS * DO 10 I = 1,7 IPAR(I) = 0 10 CONTINUE DO 20 I = 1,9 RPAR(I) = 0.0D0 20 CONTINUE IF (NEXT.EQ.1) RPAR(8) = 0.25D0 IF (NEXT.EQ.2) RPAR(8) = 0.25D0 IF (NEXT.EQ.3) RPAR(8) = 0.25D0 IF (NEXT.EQ.4) RPAR(8) = 0.25D0 IF (NEXT.EQ.5) RPAR(8) = 0.25D0 IF (NEXT.EQ.6) RPAR(8) = 0.25D0 IF (NEXT.EQ.7) RPAR(8) = 0.25D0 IF (NEXT.EQ.8) RPAR(8) = 0.25D0 IF (NEXT.EQ.13) RPAR(8) = 0.25D0 IF (NEXT.EQ.15) RPAR(8) = 0.25D0 IF (NEXT.EQ.17) RPAR(8) = 0.25D0 IF (NEXT.EQ.18) RPAR(8) = 0.25D0 IF (NEXT.EQ.25) RPAR(8) = 0.25D0 IF (NEXT.EQ.1) IPAR(1) = 2 IF (NEXT.EQ.6) IPAR(1) = 2 IF (NEXT.EQ.8) IPAR(1) = 2 IF (NEXT.EQ.10) IPAR(1) = 2 IF (NEXT.EQ.13) IPAR(1) = 2 IF (NEXT.EQ.15) IPAR(1) = 2 IF (NEXT.EQ.17) IPAR(1) = 2 IF (NEXT.EQ.18) IPAR(1) = 2 IF (NEXT.EQ.21) IPAR(1) = 2 IF (NEXT.EQ.23) IPAR(1) = 2 IF (NEXT.EQ.24) IPAR(1) = 2 IF (NEXT.EQ.25) IPAR(1) = 2 IF (NEXT.EQ.20) IPAR(4) = 7 IPAR(7) = 1 * * PROBLEM DIMENSION * NF = 50 NA = 0 * * INITIATION OF X AND CHOICE OF RPAR(9) * CALL TIUD19(NF,X,FMIN,RPAR(9),NEXT,IERR) IF (NEXT.EQ.14) RPAR(9) = 0.1D0 IF (IERR.NE.0) GO TO 30 * * SOLUTION * CALL PBUNU(NF,NA,X,IA,RA,IPAR,RPAR,F,GMAX,ITERM) 30 CONTINUE C CALL TYTIM2(ITIME) STOP END * * USER SUPPLIED SUBROUTINE (CALCULATION OF F AND G) * SUBROUTINE FUNDER(NF,X,F,G) * * FUNCTION EVALUATION * C .. Scalar Arguments .. DOUBLE PRECISION F INTEGER NF C .. C .. Array Arguments .. DOUBLE PRECISION G(*),X(*) C .. C .. Scalars in Common .. INTEGER NEXT C .. C .. External Subroutines .. EXTERNAL TFFU19,TFGU19 C .. C .. Common blocks .. COMMON /PROB/NEXT C .. CALL TFFU19(NF,X,F,NEXT) * * GRADIENT EVALUATION * CALL TFGU19(NF,X,G,NEXT) RETURN END * * EMPTY SUBROUTINES * SUBROUTINE FUN(NF,KA,X,FA) C .. Scalar Arguments .. DOUBLE PRECISION FA INTEGER KA,NF C .. C .. Array Arguments .. DOUBLE PRECISION X(*) C .. RETURN END SUBROUTINE DER(NF,KA,X,GA) C .. Scalar Arguments .. INTEGER KA,NF C .. C .. Array Arguments .. DOUBLE PRECISION GA(*),X(*) C .. RETURN END SUBROUTINE HES(NF,X,H) C .. Scalar Arguments .. INTEGER NF C .. C .. Array Arguments .. DOUBLE PRECISION H(*),X(*) C .. RETURN END SHAR_EOF fi # end of overwriting check if test -f 'driver3.f' then echo shar: will not over-write existing file "'driver3.f'" else cat << "SHAR_EOF" > 'driver3.f' * PROGRAM TMINL * * TEST PROGRAM FOR THE SUBROUTINE PMINL * C .. Scalars in Common .. INTEGER NADD,NDECF,NEXT,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION F,FMIN,GMAX INTEGER I,IERR,IEXT,ITERM,NA,NB,NC,NF C .. C .. Local Arrays .. DOUBLE PRECISION AF(200),CF(20),CG(200),CL(20),CU(20),RA(4000), + RPAR(7),X(40),XL(40),XU(40) INTEGER IA(200),IC(20),IPAR(7),IX(40) C .. C .. External Subroutines .. EXTERNAL PMINL,TILD22 C .. C .. Common blocks .. COMMON /PROB/NEXT COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. C CALL TYTIM1(ITIME) * * LOOP FOR 15 TEST PROBLEMS * DO 30 NEXT = 1,15 * * CHOICE OF INTEGER AND REAL PARAMETERS * DO 10 I = 1,7 IPAR(I) = 0 10 CONTINUE DO 20 I = 1,7 RPAR(I) = 0.0D0 20 CONTINUE IPAR(7) = 1 IF (NEXT.EQ.11) IPAR(3) = 1 * * PROBLEM DIMENSION * NF = 20 NA = 165 NB = 20 NC = 15 * * INITIATION OF X AND CHOICE OF RPAR(7) * CALL TILD22(NF,NA,NB,NC,X,IX,XL,XU,IC,CL,CU,CG,FMIN,RPAR(7), + NEXT,IEXT,IERR) IF (IERR.NE.0) GO TO 30 * * SOLUTION * CALL PMINL(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,AF,IA,RA, + IPAR,RPAR,F,GMAX,IEXT,ITERM) 30 CONTINUE C CALL TYTIM2(ITIME) STOP END * * USER SUPPLIED SUBROUTINE (CALCULATION OF FA) * SUBROUTINE FUN(NF,KA,X,FA) * * FUNCTION EVALUATION * C .. Scalar Arguments .. DOUBLE PRECISION FA INTEGER KA,NF C .. C .. Array Arguments .. DOUBLE PRECISION X(*) C .. C .. Scalars in Common .. INTEGER NEXT C .. C .. External Subroutines .. EXTERNAL TAFU22 C .. C .. Common blocks .. COMMON /PROB/NEXT C .. CALL TAFU22(NF,KA,X,FA,NEXT) RETURN END * * USER SUPPLIED SUBROUTINE (CALCULATION OF GA) * SUBROUTINE DER(NF,KA,X,GA) * * GRADIENT EVALUATION * C .. Scalar Arguments .. INTEGER KA,NF C .. C .. Array Arguments .. DOUBLE PRECISION GA(*),X(*) C .. C .. Scalars in Common .. INTEGER NEXT C .. C .. External Subroutines .. EXTERNAL TAGU22 C .. C .. Common blocks .. COMMON /PROB/NEXT C .. CALL TAGU22(NF,KA,X,GA,NEXT) RETURN END * * EMPTY SUBROUTINES * SUBROUTINE FUNDER(NF,X,F,G) C .. Scalar Arguments .. DOUBLE PRECISION F INTEGER NF C .. C .. Array Arguments .. DOUBLE PRECISION G(*),X(*) C .. RETURN END SUBROUTINE HES(NF,X,H) C .. Scalar Arguments .. INTEGER NF C .. C .. Array Arguments .. DOUBLE PRECISION H(*),X(*) C .. RETURN END SHAR_EOF fi # end of overwriting check if test -f 'driver4.f' then echo shar: will not over-write existing file "'driver4.f'" else cat << "SHAR_EOF" > 'driver4.f' * PROGRAM TMINU * * TEST PROGRAM FOR THE SUBROUTINE PMINU * C .. Scalars in Common .. INTEGER NADD,NDECF,NEXT,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION F,FMIN,GMAX INTEGER I,IERR,IEXT,ITERM,NA,NF C .. C .. Local Arrays .. DOUBLE PRECISION AF(200),RA(4000),RPAR(7),X(40) INTEGER IA(200),IPAR(7) C .. C .. External Subroutines .. EXTERNAL PMINU,TIUD06 C .. C .. Common blocks .. COMMON /PROB/NEXT COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. C CALL TYTIM1(ITIME) * * LOOP FOR 25 TEST PROBLEMS * DO 30 NEXT = 1,25 * * CHOICE OF INTEGER AND REAL PARAMETERS * DO 10 I = 1,6 IPAR(I) = 0 10 CONTINUE DO 20 I = 1,7 RPAR(I) = 0.0D0 20 CONTINUE IPAR(2) = 2 IPAR(7) = 1 * * PROBLEM DIMENSION * NF = 20 NA = 65 * * INITIATION OF X AND CHOICE OF RPAR(7) * CALL TIUD06(NF,NA,X,FMIN,RPAR(7),NEXT,IEXT,IERR) IF (IERR.NE.0) GO TO 30 * * SOLUTION * CALL PMINU(NF,NA,X,AF,IA,RA,IPAR,RPAR,F,GMAX,IEXT,ITERM) 30 CONTINUE C CALL TYTIM2(ITIME) STOP END * * USER SUPPLIED SUBROUTINE (CALCULATION OF FA) * SUBROUTINE FUN(NF,KA,X,FA) * * FUNCTION EVALUATION * C .. Scalar Arguments .. DOUBLE PRECISION FA INTEGER KA,NF C .. C .. Array Arguments .. DOUBLE PRECISION X(*) C .. C .. Scalars in Common .. INTEGER NEXT C .. C .. External Subroutines .. EXTERNAL TAFU06 C .. C .. Common blocks .. COMMON /PROB/NEXT C .. CALL TAFU06(NF,KA,X,FA,NEXT) RETURN END * * USER SUPPLIED SUBROUTINE (CALCULATION OF GA) * SUBROUTINE DER(NF,KA,X,GA) * * GRADIENT EVALUATION * C .. Scalar Arguments .. INTEGER KA,NF C .. C .. Array Arguments .. DOUBLE PRECISION GA(*),X(*) C .. C .. Scalars in Common .. INTEGER NEXT C .. C .. External Subroutines .. EXTERNAL TAGU06 C .. C .. Common blocks .. COMMON /PROB/NEXT C .. CALL TAGU06(NF,KA,X,GA,NEXT) RETURN END * * EMPTY SUBROUTINES * SUBROUTINE FUNDER(NF,X,F,G) C .. Scalar Arguments .. DOUBLE PRECISION F INTEGER NF C .. C .. Array Arguments .. DOUBLE PRECISION G(*),X(*) C .. RETURN END SUBROUTINE HES(NF,X,H) C .. Scalar Arguments .. INTEGER NF C .. C .. Array Arguments .. DOUBLE PRECISION H(*),X(*) C .. RETURN END SHAR_EOF fi # end of overwriting check if test -f 'driver5.f' then echo shar: will not over-write existing file "'driver5.f'" else cat << "SHAR_EOF" > 'driver5.f' C PROGRAM TNEWL C C TEST PROGRAM FOR THE SUBROUTINE PNEWL C C CALL TYTIM1(ITIME) C C LOOP FOR 10 TEST PROBLEMS C C .. Scalars in Common .. INTEGER IEXT,KAP,LAP,NAA,NADD,NDECF,NEXT,NFG,NFH,NFV,NIT,NRED, + NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION F,FMIN,GMAX INTEGER I,IERR,IHES,ITERM,NA,NB,NC,NF C .. C .. Local Arrays .. DOUBLE PRECISION CF(20),CG(200),CL(20),CU(20),RA(19000),RPAR(9), + X(40),XL(40),XU(40) INTEGER IA(200),IC(20),IPAR(7),IX(40) C .. C .. External Subroutines .. EXTERNAL PNEWL,TILD22 C .. C .. Common blocks .. COMMON /PROB/IEXT,NEXT,NAA,KAP,LAP COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. DO 30 NEXT = 1,10 C C CHOICE OF INTEGER AND REAL PARAMETERS C DO 10 I = 1,7 IPAR(I) = 0 10 CONTINUE DO 20 I = 1,9 RPAR(I) = 0.0D0 20 CONTINUE IPAR(7) = 1 RPAR(8) = 1.0D-10 IF (NEXT.EQ.3) RPAR(8) = 0.5D0 IF (NEXT.EQ.5) RPAR(8) = 1.0D-2 IF (NEXT.EQ.7) RPAR(8) = 1.0D0 IF (NEXT.EQ.8) RPAR(8) = 0.5D0 IF (NEXT.EQ.9) RPAR(8) = 1.0D0 IF (NEXT.EQ.11) RPAR(8) = 0.5D0 IF (NEXT.EQ.12) RPAR(8) = 1.0D-4 IF (NEXT.EQ.13) RPAR(8) = 1.0D-2 IF (NEXT.EQ.14) RPAR(8) = 1.0D-3 IF (NEXT.EQ.15) RPAR(8) = 5.0D-4 C C PROBLEM DIMENSION C NF = 20 NA = 0 NB = 20 NC = 15 NAA = 165 C C INITIATION OF X AND CHOICE OF RPAR(9) C CALL TILD22(NF,NAA,NB,NC,X,IX,XL,XU,IC,CL,CU,CG,FMIN,RPAR(9), + NEXT,IEXT,IERR) IF (IERR.NE.0) GO TO 30 IF (NEXT.EQ.1) RPAR(9) = 1.0D2 IF (NEXT.EQ.2) RPAR(9) = 1.0D0 IF (NEXT.EQ.3) RPAR(9) = 1.0D0 IF (NEXT.EQ.5) RPAR(9) = 5.0D-2 IF (NEXT.EQ.7) RPAR(9) = 5.0D-2 IF (NEXT.EQ.8) RPAR(9) = 1.0D1 IF (NEXT.EQ.9) RPAR(9) = 1.0D2 IF (NEXT.EQ.10) RPAR(9) = 1.0D2 IF (NEXT.EQ.11) RPAR(9) = 1.0D1 IF (NEXT.EQ.12) RPAR(9) = 1.0D2 IF (NEXT.EQ.13) RPAR(9) = 1.0D2 C C SOLUTION C IHES = 1 CALL PNEWL(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,IA,RA,IPAR, + RPAR,F,GMAX,IHES,ITERM) 30 CONTINUE C CALL TYTIM2(ITIME) STOP END C C USER SUPPLIED SUBROUTINE (CALCULATION OF FA) C SUBROUTINE FUNDER(NF,X,F,G) C C FUNCTION EVALUATION C C .. Scalar Arguments .. DOUBLE PRECISION F INTEGER NF C .. C .. Array Arguments .. DOUBLE PRECISION G(*),X(*) C .. C .. Scalars in Common .. INTEGER IEXT,KAP,LAP,NA,NEXT C .. C .. Local Scalars .. DOUBLE PRECISION FTEMP,FVAL INTEGER K,KA C .. C .. External Subroutines .. EXTERNAL MXVNEG,TAFU22,TAGU22 C .. C .. Common blocks .. COMMON /PROB/IEXT,NEXT,NA,KAP,LAP C .. DO 10 KA = 1,NA CALL TAFU22(NF,KA,X,F,NEXT) IF (IEXT.EQ.0 .AND. F.GE.0.0D0 .OR. IEXT.LT.0) THEN FTEMP = F K = 1 ELSE FTEMP = -F K = -1 END IF IF (KA.EQ.1 .OR. FVAL.LT.FTEMP) THEN FVAL = FTEMP KAP = KA LAP = K END IF 10 CONTINUE F = FVAL C C GRADIENT EVALUATION C CALL TAGU22(NF,KAP,X,G,NEXT) IF (LAP.GE.0) THEN ELSE CALL MXVNEG(NF,G,G) END IF RETURN END SUBROUTINE HES(NF,X,H) C C HESSIAN EVALUATION C C .. Scalar Arguments .. INTEGER NF C .. C .. Array Arguments .. DOUBLE PRECISION H(*),X(*) C .. C .. Scalars in Common .. INTEGER IEXT,KAP,LAP,NA,NEXT C .. C .. External Subroutines .. EXTERNAL MXVNEG,TAHD22 C .. C .. Common blocks .. COMMON /PROB/IEXT,NEXT,NA,KAP,LAP C .. CALL TAHD22(NF,KAP,X,H,NEXT) IF (LAP.GE.0) THEN ELSE CALL MXVNEG(NF* (NF+1)/2,H,H) END IF RETURN END * * EMPTY SUBROUTINES * SUBROUTINE FUN(NF,KA,X,FA) C .. Scalar Arguments .. DOUBLE PRECISION FA INTEGER KA,NF C .. C .. Array Arguments .. DOUBLE PRECISION X(*) C .. RETURN END SUBROUTINE DER(NF,KA,X,GA) C .. Scalar Arguments .. INTEGER KA,NF C .. C .. Array Arguments .. DOUBLE PRECISION GA(*),X(*) C .. RETURN END SHAR_EOF fi # end of overwriting check if test -f 'driver6.f' then echo shar: will not over-write existing file "'driver6.f'" else cat << "SHAR_EOF" > 'driver6.f' * PROGRAM TNEWU * * TEST PROGRAM FOR THE SUBROUTINE PNEWU * C .. Scalars in Common .. INTEGER NADD,NDECF,NEXT,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION F,FMIN,GMAX INTEGER I,IERR,IHES,ITERM,NA,NF C .. C .. Local Arrays .. DOUBLE PRECISION RA(75000),RPAR(9),X(50) INTEGER IA(200),IPAR(7) C .. C .. External Subroutines .. EXTERNAL PNEWU,TIUD19 C .. C .. Common blocks .. COMMON /PROB/NEXT COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. C CALL TYTIM1(ITIME) * * LOOP FOR 20 TEST PROBLEMS * DO 30 NEXT = 1,20 * * CHOICE OF INTEGER AND REAL PARAMETERS * DO 10 I = 1,7 IPAR(I) = 0 10 CONTINUE DO 20 I = 1,9 RPAR(I) = 0.0D0 20 CONTINUE IPAR(1) = 2 IPAR(2) = 4 IF (NEXT.EQ.25) IPAR(3) = 50 IF (NEXT.EQ.10) IPAR(4) = 4 IF (NEXT.EQ.15) IPAR(4) = 4 IPAR(7) = 1 RPAR(8) = 1D-10 IF (IPAR(1).EQ.1) THEN IF (NEXT.EQ.1) RPAR(8) = 0.5D0 IF (NEXT.EQ.2) RPAR(8) = 1.0D-4 IF (NEXT.EQ.3) RPAR(8) = 0.25D0 IF (NEXT.EQ.4) RPAR(8) = 1.0D-2 IF (NEXT.EQ.5) RPAR(8) = 1.0D-1 IF (NEXT.EQ.8) RPAR(8) = 1.0D-1 IF (NEXT.EQ.10) RPAR(8) = 1.0D-4 IF (NEXT.EQ.13) RPAR(8) = 4.0D-2 IF (NEXT.EQ.16) RPAR(8) = 1.0D-4 IF (NEXT.EQ.17) RPAR(8) = 0.25D0 IF (NEXT.EQ.18) RPAR(8) = 1.0D-2 IF (NEXT.EQ.25) RPAR(8) = 5.0D-2 ELSE IF (NEXT.EQ.1) RPAR(8) = 1.3D0 IF (NEXT.EQ.2) RPAR(8) = 1.0D-3 IF (NEXT.EQ.3) RPAR(8) = 1.0D-1 IF (NEXT.EQ.5) RPAR(8) = 0.25D0 IF (NEXT.EQ.8) RPAR(8) = 1.0D-4 IF (NEXT.EQ.10) RPAR(8) = 0.25D0 IF (NEXT.EQ.13) RPAR(8) = 0.25D0 IF (NEXT.EQ.14) RPAR(8) = 1.0D-3 IF (NEXT.EQ.15) RPAR(8) = 1.0D-3 IF (NEXT.EQ.16) RPAR(8) = 1.0D-2 IF (NEXT.EQ.17) RPAR(8) = 0.25D0 IF (NEXT.EQ.18) RPAR(8) = 1.0D-2 IF (NEXT.EQ.21) RPAR(8) = 0.5D0 IF (NEXT.EQ.25) RPAR(8) = 5.0D-2 END IF * * PROBLEM DIMENSION * NF = 50 NA = 0 * * INITIATION OF X AND CHOICE OF RPAR(9) * CALL TIUD19(NF,X,FMIN,RPAR(9),NEXT,IERR) IF (IERR.NE.0) GO TO 30 IF (NEXT.EQ.3) RPAR(9) = 1.0D0 IF (NEXT.EQ.4) RPAR(9) = 1.0D4 IF (NEXT.EQ.5) RPAR(9) = 1.0D0 IF (NEXT.EQ.8) RPAR(9) = 1.0D4 IF (NEXT.EQ.10) RPAR(9) = 1.0D1 IF (NEXT.EQ.17) RPAR(9) = 1.0D0 IF (NEXT.EQ.21) RPAR(9) = 5.0D1 IF (NEXT.EQ.22) RPAR(9) = 2.0D1 IF (NEXT.EQ.24) RPAR(9) = 1.0D4 IHES = 1 * * SOLUTION * CALL PNEWU(NF,NA,X,IA,RA,IPAR,RPAR,F,GMAX,IHES,ITERM) 30 CONTINUE C CALL TYTIM2(ITIME) STOP END * * USER SUPPLIED SUBROUTINE (CALCULATION OF F AND G) * SUBROUTINE FUNDER(NF,X,F,G) * * FUNCTION EVALUATION * C .. Scalar Arguments .. DOUBLE PRECISION F INTEGER NF C .. C .. Array Arguments .. DOUBLE PRECISION G(*),X(*) C .. C .. Scalars in Common .. INTEGER NEXT C .. C .. External Subroutines .. EXTERNAL TFFU19,TFGU19 C .. C .. Common blocks .. COMMON /PROB/NEXT C .. CALL TFFU19(NF,X,F,NEXT) * * GRADIENT EVALUATION * CALL TFGU19(NF,X,G,NEXT) RETURN END * * USER SUPPLIED SUBROUTINE (CALCULATION OF H) * SUBROUTINE HES(NF,X,H) * * HESSIAN EVALUATION * C .. Scalar Arguments .. INTEGER NF C .. C .. Array Arguments .. DOUBLE PRECISION H(*),X(*) C .. C .. Scalars in Common .. INTEGER NEXT C .. C .. External Subroutines .. EXTERNAL TFHD19 C .. C .. Common blocks .. COMMON /PROB/NEXT C .. CALL TFHD19(NF,X,H,NEXT) RETURN END * * EMPTY SUBROUTINES * SUBROUTINE FUN(NF,KA,X,FA) C .. Scalar Arguments .. DOUBLE PRECISION FA INTEGER KA,NF C .. C .. Array Arguments .. DOUBLE PRECISION X(*) C .. RETURN END SUBROUTINE DER(NF,KA,X,GA) C .. Scalar Arguments .. INTEGER KA,NF C .. C .. Array Arguments .. DOUBLE PRECISION GA(*),X(*) C .. RETURN END SHAR_EOF fi # end of overwriting check if test -f 'driver7.f' then echo shar: will not over-write existing file "'driver7.f'" else cat << "SHAR_EOF" > 'driver7.f' C PROGRAM TVARL C C TEST PROGRAM FOR THE SUBROUTINE PVARL C C CALL TYTIM1(ITIME) C C LOOP FOR 10 TEST PROBLEMS C C .. Scalars in Common .. INTEGER IEXT,KAP,LAP,NAA,NADD,NDECF,NEXT,NFG,NFH,NFV,NIT,NRED, + NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION F,FMIN,GMAX INTEGER I,IERR,ITERM,NA,NB,NC,NF C .. C .. Local Arrays .. DOUBLE PRECISION CF(20),CG(400),CL(20),CU(20),RA(2000),RPAR(7), + X(40),XL(40),XU(40) INTEGER IA(100),IC(20),IPAR(7),IX(40) C .. C .. External Subroutines .. EXTERNAL PVARL,TILD22 C .. C .. Common blocks .. COMMON /PROB/IEXT,NEXT,NAA,KAP,LAP COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. DO 30 NEXT = 1,10 C C CHOICE OF INTEGER AND REAL PARAMETERS C DO 10 I = 1,7 IPAR(I) = 0 10 CONTINUE DO 20 I = 1,7 RPAR(I) = 0.0D0 20 CONTINUE IPAR(1) = 1 IPAR(7) = 1 IF (IPAR(1).EQ.1) THEN RPAR(5) = 0.25D0 IF (NEXT.EQ.3) RPAR(5) = 0.0D0 IF (NEXT.EQ.5) RPAR(5) = 0.5D0 IF (NEXT.EQ.6) RPAR(5) = 0.5D0 IF (NEXT.EQ.7) RPAR(5) = 0.1D0 IF (NEXT.EQ.9) RPAR(5) = 1.0D-3 IF (NEXT.EQ.10) RPAR(5) = 0.5D0 IF (NEXT.EQ.11) RPAR(5) = 1.0D0 IF (NEXT.EQ.12) RPAR(5) = 1.0D-2 IF (NEXT.EQ.13) RPAR(5) = 1.0D-3 IF (NEXT.EQ.14) RPAR(5) = 0.1D0 END IF C C PROBLEM DIMENSION C NF = 20 NA = 0 NB = 20 NC = 15 NAA = 165 C C INITIATION OF X AND CHOICE OF RPAR(9) C CALL TILD22(NF,NAA,NB,NC,X,IX,XL,XU,IC,CL,CU,CG,FMIN,RPAR(7), + NEXT,IEXT,IERR) IF (NEXT.EQ.3) RPAR(7) = 1.0D0 IF (NEXT.EQ.7) RPAR(7) = 0.5D-1 IF (NEXT.EQ.9) RPAR(7) = 1.0D0 IF (NEXT.EQ.10) RPAR(7) = 1.0D2 IF (NEXT.EQ.11) RPAR(7) = 1.0D0 IF (NEXT.EQ.13) RPAR(7) = 1.0D0 IF (IERR.NE.0) GO TO 30 C C SOLUTION C CALL PVARL(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,IA,RA,IPAR, + RPAR,F,GMAX,ITERM) 30 CONTINUE C CALL TYTIM2(ITIME) STOP END C C USER SUPPLIED SUBROUTINE (CALCULATION OF FA) C SUBROUTINE FUNDER(NF,X,F,G) C C FUNCTION EVALUATION C C .. Scalar Arguments .. DOUBLE PRECISION F INTEGER NF C .. C .. Array Arguments .. DOUBLE PRECISION G(*),X(*) C .. C .. Scalars in Common .. INTEGER IEXT,KAP,LAP,NA,NEXT C .. C .. Local Scalars .. DOUBLE PRECISION FTEMP,FVAL INTEGER K,KA C .. C .. External Subroutines .. EXTERNAL MXVNEG,TAFU22,TAGU22 C .. C .. Common blocks .. COMMON /PROB/IEXT,NEXT,NA,KAP,LAP C .. DO 10 KA = 1,NA CALL TAFU22(NF,KA,X,F,NEXT) IF (IEXT.EQ.0 .AND. F.GE.0.0D0 .OR. IEXT.LT.0) THEN FTEMP = F K = 1 ELSE FTEMP = -F K = -1 END IF IF (KA.EQ.1 .OR. FVAL.LT.FTEMP) THEN FVAL = FTEMP KAP = KA LAP = K END IF 10 CONTINUE F = FVAL C C GRADIENT EVALUATION C CALL TAGU22(NF,KAP,X,G,NEXT) IF (LAP.GE.0) THEN ELSE CALL MXVNEG(NF,G,G) END IF RETURN END * * EMPTY SUBROUTINES * SUBROUTINE FUN(NF,KA,X,FA) C .. Scalar Arguments .. DOUBLE PRECISION FA INTEGER KA,NF C .. C .. Array Arguments .. DOUBLE PRECISION X(*) C .. RETURN END SUBROUTINE DER(NF,KA,X,GA) C .. Scalar Arguments .. INTEGER KA,NF C .. C .. Array Arguments .. DOUBLE PRECISION GA(*),X(*) C .. RETURN END SUBROUTINE HES(NF,X,H) C .. Scalar Arguments .. INTEGER NF C .. C .. Array Arguments .. DOUBLE PRECISION H(*),X(*) C .. RETURN END SHAR_EOF fi # end of overwriting check if test -f 'driver8.f' then echo shar: will not over-write existing file "'driver8.f'" else cat << "SHAR_EOF" > 'driver8.f' C PROGRAM TVARU C C TEST PROGRAM FOR THE SUBROUTINE PVARU C C C CALL TYTIM1(ITIME) C C LOOP FOR 20 TEST PROBLEMS C C .. Scalars in Common .. INTEGER NADD,NDECF,NEXT,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION F,FMIN,GMAX INTEGER I,IERR,ITERM,NA,NF C .. C .. Local Arrays .. DOUBLE PRECISION RA(8000),RPAR(7),X(50) INTEGER IPAR(7) C .. C .. External Subroutines .. EXTERNAL PVARU,TIUD19 C .. C .. Common blocks .. COMMON /PROB/NEXT COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. DO 30 NEXT = 1,20 C C CHOICE OF INTEGER AND REAL PARAMETERS C DO 10 I = 1,7 IPAR(I) = 0 10 CONTINUE DO 20 I = 1,7 RPAR(I) = 0.0D0 20 CONTINUE IPAR(1) = 1 IPAR(7) = 1 C C PROBLEM DIMENSION C NF = 50 NA = 0 C C INITIATION OF X AND CHOICE OF RPAR(7) C CALL TIUD19(NF,X,FMIN,RPAR(7),NEXT,IERR) IF (IERR.NE.0) GO TO 30 C C THE USER SUPPLIED VALUES C IF (IPAR(1).EQ.0) THEN IF (NEXT.EQ.25) IPAR(4) = 5 RPAR(7) = 1.0D3 IF (NEXT.EQ.1) RPAR(7) = 1.0D0 IF (NEXT.EQ.2) RPAR(7) = 1.0D0 IF (NEXT.EQ.3) RPAR(7) = 1.0D0 IF (NEXT.EQ.8) RPAR(7) = 5.0D0 IF (NEXT.EQ.9) RPAR(7) = 1.0D0 IF (NEXT.EQ.10) RPAR(7) = 1.0D0 IF (NEXT.EQ.11) RPAR(7) = 1.0D0 IF (NEXT.EQ.13) RPAR(7) = 1.0D-1 IF (NEXT.EQ.14) RPAR(7) = 2.0D-1 IF (NEXT.EQ.15) RPAR(7) = 1.0D0 IF (NEXT.EQ.16) RPAR(7) = 1.0D0 IF (NEXT.EQ.17) RPAR(7) = 1.0D1 IF (NEXT.EQ.18) RPAR(7) = 1.0D0 IF (NEXT.EQ.19) RPAR(7) = 1.0D1 IF (NEXT.EQ.23) RPAR(7) = 2.0D0 IF (NEXT.EQ.24) RPAR(7) = 1.0D1 IF (NEXT.EQ.25) RPAR(7) = 5.0D0 ELSE IF (NEXT.EQ.21) IPAR(4) = 3 IF (NEXT.EQ.22) IPAR(4) = 4 IF (NEXT.EQ.25) IPAR(4) = 5 RPAR(5) = 1.0D-9 IF (NEXT.EQ.1) RPAR(5) = 1.0D0 IF (NEXT.EQ.2) RPAR(5) = 2.0D0 IF (NEXT.EQ.3) RPAR(5) = 2.0D0 IF (NEXT.EQ.5) RPAR(5) = 1.0D0 IF (NEXT.EQ.7) RPAR(5) = 2.0D0 IF (NEXT.EQ.8) RPAR(5) = 1.0D-2 IF (NEXT.EQ.10) RPAR(5) = 1.0D0 IF (NEXT.EQ.13) RPAR(5) = 2.5D-1 IF (NEXT.EQ.14) RPAR(5) = 1.0D-3 IF (NEXT.EQ.15) RPAR(5) = 1.0D0 IF (NEXT.EQ.16) RPAR(5) = 1.0D-3 IF (NEXT.EQ.17) RPAR(5) = 2.5D-1 IF (NEXT.EQ.18) RPAR(5) = 2.0D0 IF (NEXT.EQ.19) RPAR(5) = 1.0D-1 IF (NEXT.EQ.21) RPAR(5) = 1.0D-1 IF (NEXT.EQ.23) RPAR(5) = 1.0D-5 IF (NEXT.EQ.24) RPAR(5) = 1.0D-1 IF (NEXT.EQ.25) RPAR(5) = 1.0D-1 RPAR(7) = 1.0D3 IF (NEXT.EQ.1) RPAR(7) = 1.0D0 IF (NEXT.EQ.3) RPAR(7) = 1.0D0 IF (NEXT.EQ.6) RPAR(7) = 1.0D0 IF (NEXT.EQ.7) RPAR(7) = 1.0D0 IF (NEXT.EQ.8) RPAR(7) = 2.0D-1 IF (NEXT.EQ.9) RPAR(7) = 1.0D0 IF (NEXT.EQ.10) RPAR(7) = 1.0D0 IF (NEXT.EQ.11) RPAR(7) = 1.0D0 IF (NEXT.EQ.12) RPAR(7) = 1.0D0 IF (NEXT.EQ.13) RPAR(7) = 5.0D-1 IF (NEXT.EQ.14) RPAR(7) = 2.0D-1 IF (NEXT.EQ.15) RPAR(7) = 1.0D0 IF (NEXT.EQ.16) RPAR(7) = 2.0D1 IF (NEXT.EQ.17) RPAR(7) = 1.0D1 IF (NEXT.EQ.18) RPAR(7) = 1.0D0 IF (NEXT.EQ.19) RPAR(7) = 1.0D1 IF (NEXT.EQ.23) RPAR(7) = 1.0D0 IF (NEXT.EQ.24) RPAR(7) = 5.0D0 IF (NEXT.EQ.25) RPAR(7) = 1.0D1 END IF C C SOLUTION C CALL PVARU(NF,NA,X,RA,IPAR,RPAR,F,GMAX,ITERM) 30 CONTINUE C CALL TYTIM2(ITIME) STOP END C C USER SUPPLIED SUBROUTINE (CALCULATION OF F AND G) C SUBROUTINE FUNDER(NF,X,F,G) C C FUNCTION EVALUATION C C .. Scalar Arguments .. DOUBLE PRECISION F INTEGER NF C .. C .. Array Arguments .. DOUBLE PRECISION G(*),X(*) C .. C .. Scalars in Common .. INTEGER NEXT C .. C .. External Subroutines .. EXTERNAL TFFU19,TFGU19 C .. C .. Common blocks .. COMMON /PROB/NEXT C .. CALL TFFU19(NF,X,F,NEXT) C C GRADIENT EVALUATION C CALL TFGU19(NF,X,G,NEXT) RETURN END * * EMPTY SUBROUTINES * SUBROUTINE FUN(NF,KA,X,FA) C .. Scalar Arguments .. DOUBLE PRECISION FA INTEGER KA,NF C .. C .. Array Arguments .. DOUBLE PRECISION X(*) C .. RETURN END SUBROUTINE DER(NF,KA,X,GA) C .. Scalar Arguments .. INTEGER KA,NF C .. C .. Array Arguments .. DOUBLE PRECISION GA(*),X(*) C .. RETURN END SUBROUTINE HES(NF,X,H) C .. Scalar Arguments .. INTEGER NF C .. C .. Array Arguments .. DOUBLE PRECISION H(*),X(*) C .. RETURN END SHAR_EOF fi # end of overwriting check if test -f 'res1' then echo shar: will not over-write existing file "'res1'" else cat << "SHAR_EOF" > 'res1' NIT= 10 NFV= 11 NFG= 11 F =-0.38965952D+00 G = 0.4532D-04 ITERM= 4 NIT= 4 NFV= 5 NFG= 5 F =-0.33035714D+00 G = 0.3886D-14 ITERM= 4 NIT= 8 NFV= 10 NFG= 10 F =-0.44891079D+00 G = 0.6982D-03 ITERM= 4 NIT= 79 NFV= 80 NFG= 80 F =-0.42928061D+00 G = 0.7703D-05 ITERM= 2 NIT= 16 NFV= 17 NFG= 17 F =-0.18596138D+01 G = 0.2017D-10 ITERM= 2 NIT= 16 NFV= 17 NFG= 17 F = 0.10183089D+00 G = 0.1272D-06 ITERM= 2 NIT= 43 NFV= 44 NFG= 44 F = 0.28724428D-08 G = 0.1966D-07 ITERM= 2 NIT= 74 NFV= 76 NFG= 76 F = 0.24306219D+02 G = 0.5835D-02 ITERM= 4 NIT= 140 NFV= 143 NFG= 143 F = 0.13372840D+03 G = 0.2872D-01 ITERM= 2 NIT= 65 NFV= 68 NFG= 68 F = 0.50694798D+00 G = 0.3576D-04 ITERM= 2 SHAR_EOF fi # end of overwriting check if test -f 'res2' then echo shar: will not over-write existing file "'res2'" else cat << "SHAR_EOF" > 'res2' NIT= 42 NFV= 45 NFG= 45 F = 0.38117065D-06 G = 0.1135D-02 ITERM= 2 NIT= 18 NFV= 20 NFG= 20 F = 0.29892889D-15 G = 0.5439D-08 ITERM= 2 NIT= 31 NFV= 33 NFG= 33 F = 0.19522245D+01 G = 0.3085D-03 ITERM= 2 NIT= 14 NFV= 16 NFG= 16 F = 0.20000000D+01 G = 0.1921D-06 ITERM= 2 NIT= 17 NFV= 19 NFG= 19 F =-0.30000000D+01 G = 0.5564D-08 ITERM= 4 NIT= 13 NFV= 15 NFG= 15 F = 0.72000015D+01 G = 0.2212D-02 ITERM= 4 NIT= 11 NFV= 12 NFG= 12 F =-0.14142136D+01 G = 0.1437D-04 ITERM= 4 NIT= 66 NFV= 68 NFG= 68 F =-0.99999941D+00 G = 0.1089D-02 ITERM= 4 NIT= 13 NFV= 15 NFG= 15 F =-0.10000000D+01 G = 0.9859D-07 ITERM= 4 NIT= 43 NFV= 46 NFG= 46 F =-0.80000000D+01 G = 0.1282D-02 ITERM= 4 NIT= 43 NFV= 45 NFG= 45 F =-0.43999999D+02 G = 0.3734D-02 ITERM= 2 NIT= 27 NFV= 29 NFG= 29 F = 0.22600162D+02 G = 0.1451D-03 ITERM= 4 NIT= 60 NFV= 62 NFG= 62 F =-0.32348679D+02 G = 0.2190D-02 ITERM= 2 NIT= 115 NFV= 116 NFG= 116 F =-0.29196928D+01 G = 0.1318D-02 ITERM= 2 NIT= 92 NFV= 93 NFG= 93 F = 0.55981567D+00 G = 0.8266D-03 ITERM= 4 NIT= 74 NFV= 75 NFG= 75 F =-0.84140829D+00 G = 0.7236D-03 ITERM= 2 NIT= 160 NFV= 162 NFG= 162 F = 0.97857725D+01 G = 0.5459D-03 ITERM= 2 NIT= 143 NFV= 157 NFG= 157 F = 0.16703852D+02 G = 0.4138D-02 ITERM= 2 NIT= 150 NFV= 151 NFG= 151 F = 0.16712381D-06 G = 0.7782D-04 ITERM= 2 NIT= 39 NFV= 40 NFG= 40 F = 0.27274665D-12 G = 0.1250D+00 ITERM= 2 SHAR_EOF fi # end of overwriting check if test -f 'res3' then echo shar: will not over-write existing file "'res3'" else cat << "SHAR_EOF" > 'res3' NIT= 6 NFV= 7 NFG= 7 F =-0.38965952D+00 G = 0.6129D-08 ITERM= 4 NIT= 5 NFV= 5 NFG= 5 F =-0.33035714D+00 G = 0.2220D-15 ITERM= 4 NIT= 8 NFV= 8 NFG= 8 F =-0.44891079D+00 G = 0.2031D-10 ITERM= 4 NIT= 75 NFV= 75 NFG= 75 F =-0.42928061D+00 G = 0.4449D-10 ITERM= 4 NIT= 9 NFV= 9 NFG= 9 F =-0.18596187D+01 G = 0.8299D-12 ITERM= 4 NIT= 7 NFV= 9 NFG= 8 F = 0.10183089D+00 G = 0.8211D-06 ITERM= 4 NIT= 7 NFV= 10 NFG= 8 F = 0.38580250D-14 G = 0.6600D-06 ITERM= 4 NIT= 15 NFV= 23 NFG= 16 F = 0.24306209D+02 G = 0.3499D-06 ITERM= 4 NIT= 23 NFV= 37 NFG= 24 F = 0.13372828D+03 G = 0.2859D-07 ITERM= 4 NIT= 15 NFV= 16 NFG= 15 F = 0.50694800D+00 G = 0.1487D-10 ITERM= 4 NIT= 15 NFV= 20 NFG= 16 F = 0.27608128D-03 G = 0.2132D-09 ITERM= 4 NIT= 157 NFV= 864 NFG= 158 F =-0.17688070D+04 G = 0.3565D-07 ITERM= 4 NIT= 15 NFV= 22 NFG= 16 F = 0.12272261D+04 G = 0.1706D-06 ITERM= 4 NIT= 147 NFV= 270 NFG= 148 F = 0.70492480D+04 G = 0.1030D-06 ITERM= 4 NIT= 65 NFV= 109 NFG= 65 F = 0.17478699D+03 G = 0.2174D-08 ITERM= 4 SHAR_EOF fi # end of overwriting check if test -f 'res4' then echo shar: will not over-write existing file "'res4'" else cat << "SHAR_EOF" > 'res4' NIT= 7 NFV= 8 NFG= 8 F = 0.19522245D+01 G = 0.1041D-07 ITERM= 4 NIT= 7 NFV= 8 NFG= 8 F = 0.21607942D-09 G = 0.1776D-13 ITERM= 4 NIT= 95 NFV= 208 NFG= 96 F = 0.20907262D-11 G = 0.8599D-07 ITERM= 4 NIT= 13 NFV= 15 NFG= 14 F = 0.35997193D+01 G = 0.2498D-07 ITERM= 4 NIT= 11 NFV= 16 NFG= 12 F =-0.44000000D+02 G = 0.2507D-06 ITERM= 4 NIT= 12 NFV= 21 NFG= 13 F =-0.44000000D+02 G = 0.8543D-06 ITERM= 4 NIT= 8 NFV= 9 NFG= 9 F = 0.42021427D-02 G = 0.6670D-09 ITERM= 4 NIT= 5 NFV= 6 NFG= 6 F = 0.50816327D-01 G = 0.1502D-06 ITERM= 4 NIT= 10 NFV= 12 NFG= 11 F = 0.80843684D-02 G = 0.1874D-08 ITERM= 4 NIT= 11 NFV= 11 NFG= 11 F = 0.11570644D+03 G = 0.7077D-08 ITERM= 4 NIT= 35 NFV= 113 NFG= 36 F = 0.26359735D-02 G = 0.1488D-07 ITERM= 4 NIT= 34 NFV= 86 NFG= 35 F = 0.20160754D-02 G = 0.1539D-08 ITERM= 4 NIT= 7 NFV= 8 NFG= 8 F = 0.99665146D-05 G = 0.4525D-06 ITERM= 4 NIT= 6 NFV= 8 NFG= 7 F = 0.12237127D-03 G = 0.6839D-07 ITERM= 4 NIT= 16 NFV= 37 NFG= 16 F = 0.22340496D-01 G = 0.5926D-13 ITERM= 4 NIT= 21 NFV= 53 NFG= 22 F = 0.34904927D-01 G = 0.2523D-07 ITERM= 4 NIT= 11 NFV= 16 NFG= 12 F = 0.19729062D+00 G = 0.4825D-06 ITERM= 4 NIT= 21 NFV= 118 NFG= 22 F = 0.61852848D-02 G = 0.2251D-07 ITERM= 4 NIT= 19 NFV= 45 NFG= 20 F = 0.68063006D+03 G = 0.5743D-06 ITERM= 4 NIT= 13 NFV= 19 NFG= 14 F = 0.24306209D+02 G = 0.9366D-07 ITERM= 4 NIT= 19 NFV= 30 NFG= 20 F = 0.13372828D+03 G = 0.5547D-06 ITERM= 4 NIT= 36 NFV= 92 NFG= 36 F = 0.54598150D+02 G = 0.3554D-05 ITERM= -6 NIT= 21 NFV= 33 NFG= 22 F = 0.26108258D+03 G = 0.7934D-06 ITERM= 4 NIT= 18 NFV= 20 NFG= 19 F = 0.91142124D-07 G = 0.5473D-06 ITERM= 4 NIT= 55 NFV= 192 NFG= 56 F = 0.48029466D-01 G = 0.2541D-06 ITERM= 4 SHAR_EOF fi # end of overwriting check if test -f 'res5' then echo shar: will not over-write existing file "'res5'" else cat << "SHAR_EOF" > 'res5' NIT= 6 NFV= 7 NFG= 7 F =-0.38965952D+00 G = 0.1650D-07 ITERM= 4 NIT= 3 NFV= 4 NFG= 4 F =-0.33035714D+00 G = 0.6661D-15 ITERM= 4 NIT= 49 NFV= 50 NFG= 50 F =-0.44891079D+00 G = 0.1014D-06 ITERM= 4 NIT= 9 NFV= 10 NFG= 10 F =-0.42928019D+00 G = 0.2923D-04 ITERM= 4 NIT= 28 NFV= 29 NFG= 29 F =-0.18596187D+01 G = 0.8903D-05 ITERM= 4 NIT= 9 NFV= 10 NFG= 10 F = 0.10183089D+00 G = 0.1136D-06 ITERM= 4 NIT= 54 NFV= 55 NFG= 55 F = 0.28329342D-08 G = 0.5279D-04 ITERM= 2 NIT= 18 NFV= 19 NFG= 19 F = 0.24306209D+02 G = 0.5075D-03 ITERM= 4 NIT= 47 NFV= 49 NFG= 49 F = 0.13372920D+03 G = 0.4180D-04 ITERM= 4 NIT= 94 NFV= 98 NFG= 98 F = 0.50694800D+00 G = 0.4072D-06 ITERM= 4 SHAR_EOF fi # end of overwriting check if test -f 'res6' then echo shar: will not over-write existing file "'res6'" else cat << "SHAR_EOF" > 'res6' NIT= 58 NFV= 59 NFG= 59 F = 0.22533113D-15 G = 0.8624D-05 ITERM= 2 NIT= 7 NFV= 8 NFG= 8 F = 0.16765701D-10 G = 0.5792D-05 ITERM= 4 NIT= 9 NFV= 10 NFG= 10 F = 0.19522245D+01 G = 0.2172D-05 ITERM= 4 NIT= 10 NFV= 11 NFG= 11 F = 0.20000068D+01 G = 0.2161D-04 ITERM= 4 NIT= 14 NFV= 15 NFG= 15 F =-0.30000000D+01 G = 0.5398D-08 ITERM= 2 NIT= 4 NFV= 6 NFG= 6 F = 0.72000000D+01 G = 0.1445D-08 ITERM= 4 NIT= 16 NFV= 17 NFG= 17 F =-0.14142136D+01 G = 0.5653D-07 ITERM= 4 NIT= 11 NFV= 13 NFG= 13 F =-0.10000000D+01 G = 0.4158D-07 ITERM= 4 NIT= 10 NFV= 11 NFG= 11 F =-0.10000000D+01 G = 0.4562D-06 ITERM= 4 NIT= 25 NFV= 26 NFG= 26 F =-0.79999999D+01 G = 0.3813D-02 ITERM= 4 NIT= 13 NFV= 15 NFG= 15 F =-0.44000000D+02 G = 0.4215D-05 ITERM= 4 NIT= 7 NFV= 8 NFG= 8 F = 0.22600173D+02 G = 0.1263D-02 ITERM= 4 NIT= 22 NFV= 24 NFG= 24 F =-0.32348679D+02 G = 0.3409D-02 ITERM= 4 NIT= 76 NFV= 77 NFG= 77 F =-0.29197002D+01 G = 0.1061D-02 ITERM= 4 NIT= 89 NFV= 91 NFG= 91 F = 0.55981330D+00 G = 0.1528D-05 ITERM= 4 NIT= 12 NFV= 14 NFG= 14 F =-0.84140833D+00 G = 0.6734D-06 ITERM= 4 NIT= 52 NFV= 53 NFG= 53 F = 0.97857721D+01 G = 0.2964D-03 ITERM= 4 NIT= 40 NFV= 42 NFG= 42 F = 0.16703855D+02 G = 0.1784D+00 ITERM= 4 NIT= 36 NFV= 37 NFG= 37 F = 0.38373702D-08 G = 0.5758D-08 ITERM= 2 NIT= 24 NFV= 25 NFG= 25 F = 0.45289427D-08 G = 0.1100D-09 ITERM= 2 SHAR_EOF fi # end of overwriting check if test -f 'res7' then echo shar: will not over-write existing file "'res7'" else cat << "SHAR_EOF" > 'res7' NIT= 6 NFV= 7 NFG= 7 F =-0.38965952D+00 G = 0.1650D-07 ITERM= 4 NIT= 3 NFV= 4 NFG= 4 F =-0.33035714D+00 G = 0.6661D-15 ITERM= 4 NIT= 49 NFV= 50 NFG= 50 F =-0.44891079D+00 G = 0.1014D-06 ITERM= 4 NIT= 9 NFV= 10 NFG= 10 F =-0.42928019D+00 G = 0.2923D-04 ITERM= 4 NIT= 28 NFV= 29 NFG= 29 F =-0.18596187D+01 G = 0.8903D-05 ITERM= 4 NIT= 9 NFV= 10 NFG= 10 F = 0.10183089D+00 G = 0.1136D-06 ITERM= 4 NIT= 54 NFV= 55 NFG= 55 F = 0.28329342D-08 G = 0.5279D-04 ITERM= 2 NIT= 18 NFV= 19 NFG= 19 F = 0.24306209D+02 G = 0.5075D-03 ITERM= 4 NIT= 47 NFV= 49 NFG= 49 F = 0.13372920D+03 G = 0.4180D-04 ITERM= 4 NIT= 94 NFV= 98 NFG= 98 F = 0.50694800D+00 G = 0.4072D-06 ITERM= 4 SHAR_EOF fi # end of overwriting check if test -f 'res8' then echo shar: will not over-write existing file "'res8'" else cat << "SHAR_EOF" > 'res8' NIT= 58 NFV= 59 NFG= 59 F = 0.22533113D-15 G = 0.8624D-05 ITERM= 2 NIT= 7 NFV= 8 NFG= 8 F = 0.16765701D-10 G = 0.5792D-05 ITERM= 4 NIT= 9 NFV= 10 NFG= 10 F = 0.19522245D+01 G = 0.2172D-05 ITERM= 4 NIT= 10 NFV= 11 NFG= 11 F = 0.20000068D+01 G = 0.2161D-04 ITERM= 4 NIT= 14 NFV= 15 NFG= 15 F =-0.30000000D+01 G = 0.5398D-08 ITERM= 2 NIT= 4 NFV= 6 NFG= 6 F = 0.72000000D+01 G = 0.1445D-08 ITERM= 4 NIT= 16 NFV= 17 NFG= 17 F =-0.14142136D+01 G = 0.5653D-07 ITERM= 4 NIT= 11 NFV= 13 NFG= 13 F =-0.10000000D+01 G = 0.4158D-07 ITERM= 4 NIT= 10 NFV= 11 NFG= 11 F =-0.10000000D+01 G = 0.4562D-06 ITERM= 4 NIT= 25 NFV= 26 NFG= 26 F =-0.79999999D+01 G = 0.3813D-02 ITERM= 4 NIT= 13 NFV= 15 NFG= 15 F =-0.44000000D+02 G = 0.4215D-05 ITERM= 4 NIT= 7 NFV= 8 NFG= 8 F = 0.22600173D+02 G = 0.1263D-02 ITERM= 4 NIT= 22 NFV= 24 NFG= 24 F =-0.32348679D+02 G = 0.3409D-02 ITERM= 4 NIT= 76 NFV= 77 NFG= 77 F =-0.29197002D+01 G = 0.1061D-02 ITERM= 4 NIT= 89 NFV= 91 NFG= 91 F = 0.55981330D+00 G = 0.1528D-05 ITERM= 4 NIT= 12 NFV= 14 NFG= 14 F =-0.84140833D+00 G = 0.6734D-06 ITERM= 4 NIT= 52 NFV= 53 NFG= 53 F = 0.97857721D+01 G = 0.2964D-03 ITERM= 4 NIT= 40 NFV= 42 NFG= 42 F = 0.16703855D+02 G = 0.1784D+00 ITERM= 4 NIT= 36 NFV= 37 NFG= 37 F = 0.38373702D-08 G = 0.5758D-08 ITERM= 2 NIT= 24 NFV= 25 NFG= 25 F = 0.45289427D-08 G = 0.1100D-09 ITERM= 2 SHAR_EOF fi # end of overwriting check if test -f 'subs.f' then echo shar: will not over-write existing file "'subs.f'" else cat << "SHAR_EOF" > 'subs.f' * * TEST SUBROUTINES FOR NONSMOOTH OPTIMIZATION * * SUBROUTINE TIUD06 ALL SYSTEMS 99/12/01 C PORTABILITY : ALL SYSTEMS C 90/12/01 LU : ORIGINAL VERSION * * PURPOSE : * INITIATION OF VARIABLES FOR NONLINEAR MINIMAX APPROXIMATION. * UNCONSTRAINED DENSE VERSION. * * PARAMETERS : * IO N NUMBER OF VARIABLES. * IO NA NUMBER OF PARTIAL FUNCTIONS. * RO X(N) VECTOR OF VARIABLES. * RO FMIN LOWER BOUND FOR VALUE OF THE OBJECTIVE FUNCTION. * RO XMAX MAXIMUM STEPSIZE. * IO NEXT NUMBER OF THE TEST PROBLEM. * IO IEXT TYPE OF OBJECTIVE FUNCTION. IEXT<0-MAXIMUM OF VALUES. * IEXT=0-MAXIMUM OF ABSOLUTE VALUES. * IO IERR ERROR INDICATOR. * SUBROUTINE TIUD06(N,NA,X,FMIN,XMAX,NEXT,IEXT,IERR) C .. Scalar Arguments .. DOUBLE PRECISION FMIN,XMAX INTEGER IERR,IEXT,N,NA,NEXT C .. C .. Array Arguments .. DOUBLE PRECISION X(N) C .. C .. Arrays in Common .. DOUBLE PRECISION Y(123) C .. C .. Local Scalars .. DOUBLE PRECISION T INTEGER I C .. C .. Intrinsic Functions .. INTRINSIC ATAN,COS,DBLE,EXP,SIN,SQRT C .. C .. Common blocks .. COMMON /EMPR06/Y C .. FMIN = -1.0D60 XMAX = 1.0D3 IEXT = -1 IERR = 0 GO TO (10,20,30,40,50,70,90,120,130, + 140,150,180,200,220,240,260,280,290, + 350,360,370,380,400,420,440) NEXT 10 IF (N.GE.2 .AND. NA.GE.3) THEN N = 2 NA = 3 X(1) = 2.0D0 X(2) = 2.0D0 ELSE IERR = 1 END IF RETURN 20 IF (N.GE.2 .AND. NA.GE.3) THEN N = 2 NA = 3 X(1) = 3.0D0 X(2) = 1.0D0 ELSE IERR = 1 END IF RETURN 30 IF (N.GE.2 .AND. NA.GE.2) THEN N = 2 NA = 2 X(1) = 1.41831D0 X(2) = -4.79462D0 XMAX = 1.0D0 ELSE IERR = 1 END IF RETURN 40 IF (N.GE.3 .AND. NA.GE.6) THEN N = 3 NA = 6 X(1) = 1.0D0 X(2) = 1.0D0 X(3) = 1.0D0 ELSE IERR = 1 END IF RETURN 50 IF (N.GE.4 .AND. NA.GE.4) THEN N = 4 NA = 4 DO 60 I = 1,N X(I) = 0.0D0 60 CONTINUE ELSE IERR = 1 END IF RETURN 70 IF (N.GE.4 .AND. NA.GE.4) THEN N = 4 NA = 4 DO 80 I = 1,N X(I) = 0.0D0 80 CONTINUE ELSE IERR = 1 END IF RETURN 90 IF (N.GE.3 .AND. NA.GE.21) THEN N = 3 NA = 21 DO 100 I = 1,N X(I) = 1.0D0 100 CONTINUE DO 110 I = 1,NA T = 1.0D1*DBLE(I-1)/DBLE(NA-1) Y(I) = T Y(NA+I) = (3.0D0/2.0D1)*EXP(-T) + + (1.0D0/5.2D1)*EXP(-5.0D0*T) - + (1.0D0/6.5D1)*EXP(-2.0D0*T)* + (3.0D0*SIN(2.0D0*T)+1.1D1*COS(2.0D0*T)) 110 CONTINUE IEXT = 0 ELSE IERR = 1 END IF RETURN 120 IF (N.GE.3 .AND. NA.GE.15) THEN N = 3 NA = 15 X(1) = 1.0D0 X(2) = 1.0D0 X(3) = 1.0D0 Y(1) = 0.14D0 Y(2) = 0.18D0 Y(3) = 0.22D0 Y(4) = 0.25D0 Y(5) = 0.29D0 Y(6) = 0.32D0 Y(7) = 0.35D0 Y(8) = 0.39D0 Y(9) = 0.37D0 Y(10) = 0.58D0 Y(11) = 0.73D0 Y(12) = 0.96D0 Y(13) = 1.34D0 Y(14) = 2.10D0 Y(15) = 4.39D0 IEXT = 0 ELSE IERR = 1 END IF RETURN 130 IF (N.GE.4 .AND. NA.GE.11) THEN N = 4 NA = 11 X(1) = 0.25D0 X(2) = 0.39D0 X(3) = 4.15D-1 X(4) = 0.39D0 Y(1) = 0.1957D0 Y(2) = 0.1947D0 Y(3) = 0.1735D0 Y(4) = 0.1600D0 Y(5) = 0.0844D0 Y(6) = 0.0627D0 Y(7) = 0.0456D0 Y(8) = 0.0342D0 Y(9) = 0.0323D0 Y(10) = 0.0235D0 Y(11) = 0.0246D0 Y(12) = 4.0000D0 Y(13) = 2.0000D0 Y(14) = 1.0000D0 Y(15) = 0.5000D0 Y(16) = 0.2500D0 Y(17) = 0.1670D0 Y(18) = 0.1250D0 Y(19) = 0.1000D0 Y(20) = 0.0833D0 Y(21) = 0.0714D0 Y(22) = 0.0625D0 IEXT = 0 ELSE IERR = 1 END IF RETURN 140 IF (N.GE.4 .AND. NA.GE.20) THEN N = 4 NA = 20 X(1) = 2.5D1 X(2) = 5.0D0 X(3) = -5.0D0 X(4) = -1.0D0 IEXT = 0 ELSE IERR = 1 END IF RETURN 150 IF (N.GE.4 .AND. NA.GE.21) THEN N = 4 NA = 21 DO 160 I = 1,N X(I) = 1.0D0 160 CONTINUE DO 170 I = 1,NA Y(I) = 0.25D0 + 0.75D0*DBLE(I-1)/DBLE(NA-1) Y(NA+I) = SQRT(Y(I)) 170 CONTINUE IEXT = 0 ELSE IERR = 1 END IF RETURN 180 IF (N.GE.4 .AND. NA.GE.21) THEN N = 4 NA = 21 X(1) = 1.0D0 X(2) = 1.0D0 X(3) = -3.0D0 X(4) = -1.0D0 DO 190 I = 1,NA Y(I) = -0.5D0 + DBLE(I-1)/DBLE(NA-1) Y(NA+I) = 1.0D0/ (1.0D0+Y(I)) 190 CONTINUE XMAX = 1.0D-1 IEXT = 0 ELSE IERR = 1 END IF RETURN 200 IF (N.GE.4 .AND. NA.GE.61) THEN N = 4 NA = 61 IEXT = 0 DO 210 I = 1,N X(I) = 1.0D0 210 CONTINUE X(3) = 1.0D1 Y(1) = 1.0D0 Y(2) = 1.01D0 Y(3) = 1.02D0 Y(4) = 1.03D0 Y(5) = 1.05D0 Y(6) = 1.075D0 Y(7) = 1.1D0 Y(8) = 1.125D0 Y(9) = 1.15D0 Y(10) = 1.2D0 Y(11) = 1.25D0 Y(12) = 1.3D0 Y(13) = 1.35D0 Y(14) = 1.4D0 Y(15) = 1.5D0 Y(16) = 1.6D0 Y(17) = 1.7D0 Y(18) = 1.8D0 Y(19) = 1.9D0 Y(20) = 2.0D0 Y(21) = 2.1D0 Y(22) = 2.2D0 Y(23) = 2.3D0 Y(24) = 2.5D0 Y(25) = 2.75D0 Y(26) = 3.0D0 Y(27) = 3.25D0 Y(28) = 3.5D0 Y(29) = 4.0D0 Y(30) = 4.5D0 Y(31) = 5.0D0 Y(32) = 5.5D0 Y(33) = 6.0D0 Y(34) = 6.5D0 Y(35) = 7.0D0 Y(36) = 7.5D0 Y(37) = 8.0D0 Y(38) = 8.5D0 Y(39) = 9.0D0 Y(40) = 10.0D0 Y(41) = 11.0D0 Y(42) = 12.0D0 Y(43) = 13.0D0 Y(44) = 15.0D0 Y(45) = 17.5D0 Y(46) = 20.0D0 Y(47) = 22.5D0 Y(48) = 25.0D0 Y(49) = 30.0D0 Y(50) = 35.0D0 Y(51) = 40.0D0 Y(52) = 50.0D0 Y(53) = 60.0D0 Y(54) = 70.0D0 Y(55) = 80.0D0 Y(56) = 100.0D0 Y(57) = 150.0D0 Y(58) = 200.0D0 Y(59) = 300.0D0 Y(60) = 500.0D0 Y(61) = 1.0D5 Y(61+1) = 0.97386702052733792831D0 Y(61+2) = 0.97390711665677071911D0 Y(61+3) = 0.97394794566286525039D0 Y(61+4) = 0.97398947529386626621D0 Y(61+5) = 0.97407451325974368215D0 Y(61+6) = 0.97418422166965892644D0 Y(61+7) = 0.97429732692565188272D0 Y(61+8) = 0.97441344289222034304D0 Y(61+9) = 0.97453221704823108216D0 Y(61+10) = 0.97477647977277153145D0 Y(61+11) = 0.97502785781178233026D0 Y(61+12) = 0.97528446418205610067D0 Y(61+13) = 0.97554472005909873148D0 Y(61+14) = 0.97580730389916439626D0 Y(61+15) = 0.97633521198091785788D0 Y(61+16) = 0.97686134356195586299D0 Y(61+17) = 0.97738094095418268249D0 Y(61+18) = 0.97789073928751194169D0 Y(61+19) = 0.97838854811088140808D0 Y(61+20) = 0.97887295363155439576D0 Y(61+21) = 0.97934310478576951385D0 Y(61+22) = 0.97979855827226762515D0 Y(61+23) = 0.98023916551033862691D0 Y(61+24) = 0.98107624468416045728D0 Y(61+25) = 0.98204290774765289406D0 Y(61+26) = 0.98292719363632655668D0 Y(61+27) = 0.98373656564197279264D0 Y(61+28) = 0.98447846610682328991D0 Y(61+29) = 0.98578713114264981186D0 Y(61+30) = 0.98690124654380846379D0 Y(61+31) = 0.98785879054855173380D0 Y(61+32) = 0.98868928566806726978D0 Y(61+33) = 0.98941568049711884384D0 Y(61+34) = 0.99005592865089067038D0 Y(61+35) = 0.99062420259214811899D0 Y(61+36) = 0.99113180018738487730D0 Y(61+37) = 0.99158781685339306121D0 Y(61+38) = 0.99199964493176098231D0 Y(61+39) = 0.99237334707422899195D0 Y(61+40) = 0.99302559755582945576D0 Y(61+41) = 0.99357562712206729735D0 Y(61+42) = 0.99404560031581354300D0 Y(61+43) = 0.99445173790980305195D0 Y(61+44) = 0.99511816085114882367D0 Y(61+45) = 0.99575584307408838284D0 Y(61+46) = 0.99624640327264396775D0 Y(61+47) = 0.99663543022201287399D0 Y(61+48) = 0.99695146031888813172D0 Y(61+49) = 0.99743367936799001685D0 Y(61+50) = 0.99778424120023198554D0 Y(61+51) = 0.99805056960591223604D0 Y(61+52) = 0.99842841443786596919D0 Y(61+53) = 0.99868358857261655169D0 Y(61+54) = 0.99886748198687248566D0 Y(61+55) = 0.99900629944600342584D0 Y(61+56) = 0.99920194660435455419D0 Y(61+57) = 0.99946519560889341627D0 Y(61+58) = 0.99959785208794891934D0 Y(61+59) = 0.99973120214935885075D0 Y(61+60) = 0.99983838442420395745D0 Y(61+61) = 0.999999189398046846077D0 ELSE IERR = 1 END IF RETURN 220 IF (N.GE.5 .AND. NA.GE.21) THEN N = 5 NA = 21 DO 230 I = 1,N X(I) = 0.0D0 230 CONTINUE X(1) = 0.5D0 IEXT = 0 ELSE IERR = 1 END IF RETURN 240 IF (N.GE.5 .AND. NA.GE.30) THEN N = 5 NA = 30 X(1) = 0.0D0 X(2) = -1.0D0 X(3) = 1.0D1 X(4) = 1.0D0 X(5) = 1.0D1 DO 250 I = 1,NA Y(I) = -1.0D0 + 2.0D0*DBLE(I-1)/DBLE(NA-1) T = 8.0D0*Y(I) Y(NA+I) = SQRT((T-1.0D0)**2+1.0D0)*ATAN(T)/T 250 CONTINUE IEXT = 0 ELSE IERR = 1 END IF RETURN 260 IF (N.GE.6 .AND. NA.GE.51) THEN N = 6 NA = 51 X(1) = 2.0D0 X(2) = 2.0D0 X(3) = 7.0D0 X(4) = 0.0D0 X(5) = -2.0D0 X(6) = 1.0D0 DO 270 I = 1,NA T = 0.1D0*DBLE(I-1) Y(I) = 0.5D0*EXP(-T) - EXP(-2.0D0*T) + + 0.5D0*EXP(-3.0D0*T) + 1.5D0*EXP(-1.5D0*T)* + SIN(7.0D0*T) + EXP(-2.5D0*T)*SIN(5.0D0*T) 270 CONTINUE IEXT = 0 ELSE IERR = 1 END IF RETURN 280 IF (N.GE.6 .AND. NA.GE.11) THEN N = 6 NA = 11 X(1) = 0.8D0 X(2) = 1.5D0 X(3) = 1.2D0 X(4) = 3.0D0 X(5) = 0.8D0 X(6) = 6.0D0 Y(1) = 0.5D0 Y(2) = 0.6D0 Y(3) = 0.7D0 Y(4) = 0.77D0 Y(5) = 0.9D0 Y(6) = 1.0D0 Y(7) = 1.1D0 Y(8) = 1.23D0 Y(9) = 1.3D0 Y(10) = 1.4D0 Y(11) = 1.5D0 ELSE IERR = 1 END IF RETURN 290 IF (N.GE.9 .AND. NA.GE.41) THEN N = 9 NA = 41 X(1) = 0D0 X(2) = 1D0 X(3) = 0D0 X(4) = -1.5D-1 X(5) = 0D0 X(6) = -6.8D-1 X(7) = 0D0 X(8) = -7.2D-1 X(9) = 3.7D-1 DO 300 I = 1,6 Y(I) = 1D-2* (I-1) 300 CONTINUE DO 310 I = 7,20 Y(I) = 3D-2* (I-7) + 7D-2 310 CONTINUE Y(21) = 5D-1 DO 320 I = 22,35 Y(I) = 3D-2* (I-22) + 54D-2 320 CONTINUE DO 330 I = 36,41 Y(I) = 1D-2* (I-36) + 95D-2 330 CONTINUE DO 340 I = 1,41 Y(41+I) = COS(Y(I)*3.14159265358979324D0) Y(82+I) = SIN(Y(I)*3.14159265358979324D0) 340 CONTINUE IEXT = 0 ELSE IERR = 1 END IF RETURN 350 IF (N.GE.7 .AND. NA.GE.5) THEN N = 7 NA = 5 X(1) = 1.0D0 X(2) = 2.0D0 X(3) = 0.0D0 X(4) = 4.0D0 X(5) = 0.0D0 X(6) = 1.0D0 X(7) = 1.0D0 ELSE IERR = 1 END IF RETURN 360 IF (N.GE.10 .AND. NA.GE.9) THEN N = 10 NA = 9 X(1) = 2.0D0 X(2) = 3.0D0 X(3) = 5.0D0 X(4) = 5.0D0 X(5) = 1.0D0 X(6) = 2.0D0 X(7) = 7.0D0 X(8) = 3.0D0 X(9) = 6.0D0 X(10) = 1.0D1 ELSE IERR = 1 END IF RETURN 370 IF (N.GE.20 .AND. NA.GE.18) THEN N = 20 NA = 18 X(1) = 2.0D0 X(2) = 3.0D0 X(3) = 5.0D0 X(4) = 5.0D0 X(5) = 1.0D0 X(6) = 2.0D0 X(7) = 7.0D0 X(8) = 3.0D0 X(9) = 6.0D0 X(10) = 1.0D1 X(11) = 2.0D0 X(12) = 2.0D0 X(13) = 6.0D0 X(14) = 1.5D1 X(15) = 1.0D0 X(16) = 2.0D0 X(17) = 1.0D0 X(18) = 2.0D0 X(19) = 1.0D0 X(20) = 3.0D0 ELSE IERR = 1 END IF RETURN 380 IF (N.GE.10 .AND. NA.GE.2) THEN N = 10 NA = 2 DO 390 I = 1,N X(I) = 0.1D0 390 CONTINUE X(1) = 1.0D2 XMAX = 1.0D1 ELSE IERR = 1 END IF RETURN 400 IF (N.GE.11 .AND. NA.GE.10) THEN N = 11 NA = 10 DO 410 I = 1,N X(I) = 1.0D0 410 CONTINUE ELSE IERR = 1 END IF RETURN 420 IF (N.GE.20 .AND. NA.GE.31) THEN N = 20 NA = 31 DO 430 I = 1,N X(I) = 0.0D0 430 CONTINUE IEXT = 0 ELSE IERR = 1 END IF RETURN 440 IF (N.GE.11 .AND. NA.GE.65) THEN N = 11 NA = 65 X(1) = 1.3D0 X(2) = 6.5D-1 X(3) = 6.5D-1 X(4) = 0.7D0 X(5) = 0.6D0 X(6) = 3.0D0 X(7) = 5.0D0 X(8) = 7.0D0 X(9) = 2.0D0 X(10) = 4.5D0 X(11) = 5.5D0 Y(1) = 1.366D0 Y(2) = 1.191D0 Y(3) = 1.112D0 Y(4) = 1.013D0 Y(5) = 0.991D0 Y(6) = 0.885D0 Y(7) = 0.831D0 Y(8) = 0.847D0 Y(9) = 0.786D0 Y(10) = 0.725D0 Y(11) = 0.746D0 Y(12) = 0.679D0 Y(13) = 0.608D0 Y(14) = 0.655D0 Y(15) = 0.616D0 Y(16) = 0.606D0 Y(17) = 0.602D0 Y(18) = 0.626D0 Y(19) = 0.651D0 Y(20) = 0.724D0 Y(21) = 0.649D0 Y(22) = 0.649D0 Y(23) = 0.694D0 Y(24) = 0.644D0 Y(25) = 0.624D0 Y(26) = 0.661D0 Y(27) = 0.612D0 Y(28) = 0.558D0 Y(29) = 0.553D0 Y(30) = 0.495D0 Y(31) = 0.500D0 Y(32) = 0.423D0 Y(33) = 0.395D0 Y(34) = 0.375D0 Y(35) = 0.372D0 Y(36) = 0.391D0 Y(37) = 0.396D0 Y(38) = 0.405D0 Y(39) = 0.428D0 Y(40) = 0.429D0 Y(41) = 0.523D0 Y(42) = 0.562D0 Y(43) = 0.607D0 Y(44) = 0.653D0 Y(45) = 0.672D0 Y(46) = 0.708D0 Y(47) = 0.633D0 Y(48) = 0.668D0 Y(49) = 0.645D0 Y(50) = 0.632D0 Y(51) = 0.591D0 Y(52) = 0.559D0 Y(53) = 0.597D0 Y(54) = 0.625D0 Y(55) = 0.739D0 Y(56) = 0.710D0 Y(57) = 0.729D0 Y(58) = 0.720D0 Y(59) = 0.636D0 Y(60) = 0.581D0 Y(61) = 0.428D0 Y(62) = 0.292D0 Y(63) = 0.162D0 Y(64) = 0.098D0 Y(65) = 0.054D0 XMAX = 1.0D1 IEXT = 0 ELSE IERR = 1 END IF RETURN END * SUBROUTINE TAFU06 ALL SYSTEMS 99/12/01 C PORTABILITY : ALL SYSTEMS C 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * VALUES OF PARTIAL FUNCTIONS IN THE MINIMAX CRITERION. * * PARAMETERS : * II N NUMBER OF VARIABLES. * II KA INDEX OF THE PARTIAL FUNCTION. * RI X(N) VECTOR OF VARIABLES. * RO FA VALUE OF THE PARTIAL FUNCTION AT THE * SELECTED POINT. * II NEXT NUMBER OF THE TEST PROBLEM. * SUBROUTINE TAFU06(N,KA,X,FA,NEXT) C .. Parameters .. DOUBLE PRECISION PI PARAMETER (PI=3.14159265358979323846D0) C .. C .. Scalar Arguments .. DOUBLE PRECISION FA INTEGER KA,N,NEXT C .. C .. Array Arguments .. DOUBLE PRECISION X(N) C .. C .. Arrays in Common .. DOUBLE PRECISION Y(123) C .. C .. Local Scalars .. DOUBLE COMPLEX C1,C2,C3 DOUBLE PRECISION BETA,T,X1,X2,X3,X4,X5,X6,X7,X8 INTEGER I,J C .. C .. Local Arrays .. DOUBLE COMPLEX CA(4),CB(4) DOUBLE PRECISION XA(3),XB(3),XC(3) C .. C .. Intrinsic Functions .. INTRINSIC ABS,CDABS,CMPLX,COS,DBLE,EXP,MIN,SIN,SQRT C .. C .. Common blocks .. COMMON /EMPR06/Y C .. GO TO (10,50,60,70,140,190,240,250,260, + 270,280,290,300,310,330,340,350,380, + 390,450,550,660,680,700,720) NEXT 10 X1 = X(1)*X(1) X2 = X(2)*X(2) X3 = X(1) + X(1) X4 = X(2) + X(2) GO TO (20,30,40) KA 20 FA = X1 + X2*X2 RETURN 30 FA = 8.0D0 - 4.0D0* (X(1)+X(2)) + X1 + X2 RETURN 40 FA = 2.0D0*EXP(X(2)-X(1)) RETURN 50 X1 = 1.0D1*X(1)/ (X(1)+1.0D-1) X2 = 2.0D0*X(2)**2 IF (KA.EQ.1) THEN FA = 0.5D0* (X(1)+X1+X2) ELSE IF (KA.EQ.2) THEN FA = 0.5D0* (-X(1)+X1+X2) ELSE IF (KA.EQ.3) THEN FA = 0.5D0* (X(1)-X1+X2) END IF RETURN 60 X1 = X(1)**2 + X(2)**2 X2 = SQRT(X1) IF (KA.EQ.1) THEN FA = (X(1)-X2*COS(X2))**2 + 5.0D-3*X1 ELSE IF (KA.EQ.2) THEN FA = (X(2)-X2*SIN(X2))**2 + 5.0D-3*X1 END IF RETURN 70 GO TO (80,90,100,110,120,130) KA 80 FA = X(1)**2 + X(2)**2 + X(3)**2 - 1.0D0 RETURN 90 FA = X(1)**2 + X(2)**2 + (X(3)-2.0D0)**2 RETURN 100 FA = X(1) + X(2) + X(3) - 1.0D0 RETURN 110 FA = X(1) + X(2) - X(3) + 1.0D0 RETURN 120 FA = 2.0D0* (X(1)**3+3.0D0*X(2)**2+ (5.0D0*X(3)-X(1)+1.0D0)**2) RETURN 130 FA = X(1)**2 - 9.0D0*X(3) RETURN 140 X1 = X(1)*X(1) X2 = X(2)*X(2) X3 = X(3)*X(3) X4 = X(4)*X(4) X5 = X(1) + X(1) X6 = X(2) + X(2) X7 = X(3) + X(3) X8 = X(4) + X(4) FA = X1 + X2 + X3 + X3 + X4 - 5.0D0* (X(1)+X(2)) - 2.1D1*X(3) + + 7.0D0*X(4) 150 GO TO (320,160,170,180) KA 160 FA = FA + 1.0D1* (X1+X2+X3+X4+X(1)-X(2)+X(3)-X(4)-8.0D0) RETURN 170 FA = FA + 1.0D1* (X1+X2+X2+X3+X4+X4-X(1)-X(4)-1.0D1) RETURN 180 FA = FA + 1.0D1* (X1+X2+X3+X5-X(2)-X(4)-5.0D0) RETURN 190 X1 = X(1) - (X(4)+1.0D0)**4 X2 = X1*X1 X3 = X(2) - X2*X2 X4 = X3*X3 FA = X2 + X4 + 2.0D0*X(3)**2 + X(4)**2 - 5.0D0* (X1+X3) - + 2.1D1*X(3) + 7.0D0*X(4) GO TO (200,210,220,230) KA 200 CONTINUE RETURN 210 FA = FA + 1.0D1* (X2+X4+X(3)**2+X(4)**2+X1-X3+X(3)-X(4)-8.0D0) RETURN 220 FA = FA + 1.0D1* (X2+2.0D0*X4+X(3)**2+2.0D0*X(4)**2-X1-X(4)-1.0D1) RETURN 230 FA = FA + 1.0D1* (X2+X4+X(3)**2+2.0D0*X1-X3-X(4)-5.0D0) RETURN 240 T = Y(KA) FA = (X(3)/X(2))*EXP(-X(1)*T)*SIN(X(2)*T) - Y(KA+21) RETURN 250 FA = Y(KA) - X(1) - DBLE(KA)/ (DBLE(16-KA)*X(2)+ + DBLE(MIN(KA,16-KA))*X(3)) RETURN 260 T = Y(KA+11) FA = Y(KA) - X(1)*T* (T+X(2))/ ((T+X(3))*T+X(4)) RETURN 270 T = 0.2D0*DBLE(KA) FA = (X(1)+X(2)*T-EXP(T))**2 + (X(3)+X(4)*SIN(T)-COS(T))**2 RETURN 280 T = Y(KA) FA = X(4) - ((X(1)*T+X(2))*T+X(3))**2 - Y(KA+21) RETURN 290 T = Y(KA) FA = X(1)*EXP(X(3)*T) + X(2)*EXP(X(4)*T) - Y(KA+21) RETURN 300 T = Y(KA) FA = X(1)*ABS((T+X(2)+1.0D0/ (X(3)*T+X(4)))/ + ((T+1.0D0)*Y(61+KA)))** (T+5.0D-1) - 1.0D0 RETURN 310 T = 0.1D0*DBLE(KA-1) - 1.0D0 X1 = X(1) + T*X(2) X2 = 1.0D0/ (1.0D0+T* (X(3)+T* (X(4)+T*X(5)))) X3 = X1*X2 - EXP(T) FA = X3 320 RETURN 330 T = Y(KA) FA = (X(1)+T* (X(2)+T*X(3)))/ (1.0D0+T* (X(4)+T*X(5))) - Y(KA+30) RETURN 340 T = 0.1D0*DBLE(KA-1) FA = X(1)*EXP(-X(2)*T)*COS(X(3)*T+X(4)) + X(5)*EXP(-X(6)*T) - + Y(KA) RETURN 350 BETA = 0.5D0*PI*Y(KA) DO 360 I = 1,3 J = I + I XA(I) = X(J-1) XB(I) = X(J) 360 CONTINUE CA(4) = CMPLX(1.0D0,0.0D0) CB(4) = 1.0D1*CA(4) DO 370 J = 1,3 I = 4 - J XC(I) = BETA*XA(I) T = XC(I) X1 = COS(T) X2 = SIN(T) C1 = CMPLX(X1,0.0D0) C2 = CMPLX(0.0D0, (X2*XB(I))) C3 = CMPLX(0.0D0, (X2/XB(I))) CB(I) = C1*CB(I+1) + C2*CA(I+1) CA(I) = C3*CB(I+1) + C1*CA(I+1) 370 CONTINUE C1 = -CA(1) C2 = CB(1) - C1 C3 = 1.0D0 + 2.0D0*C1/C2 FA = CDABS(C3) RETURN 380 T = Y(41+KA) BETA = Y(82+KA) X1 = (X(1)+ (1D0+X(2))*T)**2 + ((1D0-X(2))*BETA)**2 X2 = (X(3)+ (1D0+X(4))*T)**2 + ((1D0-X(4))*BETA)**2 X3 = (X(5)+ (1D0+X(6))*T)**2 + ((1D0-X(6))*BETA)**2 X4 = (X(7)+ (1D0+X(8))*T)**2 + ((1D0-X(8))*BETA)**2 IF (X2.EQ.0D0) X2 = 1D-30 IF (X4.EQ.0D0) X4 = 1D-30 FA = X(9)*SQRT(X1/X2)*SQRT(X3/X4) - ABS(1D0-2D0*Y(KA)) RETURN 390 FA = (X(1)-1.0D1)**2 + 5.0D0* (X(2)-1.2D1)**2 + X(3)**4 + + 3.0D0* (X(4)-1.1D1)**2 + 1.0D1*X(5)**6 + 7.0D0*X(6)**2 + + X(7)**4 - 4.0D0*X(6)*X(7) - 1.0D1*X(6) - 8.0D0*X(7) 400 GO TO (320,410,420,430,440) KA 410 FA = FA + 1.0D1* (2.0D0*X(1)**2+3.0D0*X(2)**4+X(3)+4.0D0*X(4)**2+ + 5.0D0*X(5)-1.27D2) RETURN 420 FA = FA + 1.0D1* (7.0D0*X(1)+3.0D0*X(2)+1.0D1*X(3)**2+X(4)-X(5)- + 2.82D2) RETURN 430 FA = FA + 1.0D1* (2.3D1*X(1)+X(2)**2+6.0D0*X(6)**2-8.0D0*X(7)- + 1.96D2) RETURN 440 FA = FA + 1.0D1* (4.0D0*X(1)**2+X(2)**2-3.0D0*X(1)*X(2)+ + 2.0D0*X(3)**2+5.0D0*X(6)-1.1D1*X(7)) RETURN 450 FA = X(1)**2 + X(2)**2 + X(1)*X(2) - 1.4D1*X(1) - 1.6D1*X(2) + + (X(3)-1.0D1)**2 + 4.0D0* (X(4)-5.0D0)**2 + (X(5)-3.0D0)**2 + + 2.0D0* (X(6)-1.0D0)**2 + 5.0D0*X(7)**2 + + 7.0D0* (X(8)-1.1D1)**2 + 2.0D0* (X(9)-1.0D1)**2 + + (X(10)-7.0D0)**2 + 4.5D1 460 GO TO (320,470,480,490,500,510,520,530,540) KA 470 FA = FA + 1.0D1* (3.0D0* (X(1)-2.0D0)**2+4.0D0* (X(2)-3.0D0)**2+ + 2.0D0*X(3)**2-7.0D0*X(4)-1.2D2) RETURN 480 FA = FA + 1.0D1* (5.0D0*X(1)**2+8.0D0*X(2)+ (X(3)-6.0D0)**2- + 2.0D0*X(4)-4.0D1) RETURN 490 FA = FA + 1.0D1* (0.5D0* (X(1)-8.0D0)**2+2.0D0* (X(2)-4.0D0)**2+ + 3.0D0*X(5)**2-X(6)-3.0D1) RETURN 500 FA = FA + 1.0D1* (X(1)**2+2.0D0* (X(2)-2.0D0)**2-2.0D0*X(1)*X(2)+ + 1.4D1*X(5)-6.0D0*X(6)) RETURN 510 FA = FA + 1.0D1* (4.0D0*X(1)+5.0D0*X(2)-3.0D0*X(7)+9.0D0*X(8)- + 1.05D2) RETURN 520 FA = FA + 1.0D1* (1.0D1*X(1)-8.0D0*X(2)-1.7D1*X(7)+2.0D0*X(8)) RETURN 530 FA = FA + 1.0D1* (6.0D0*X(2)-3.0D0*X(1)+1.2D1* (X(9)-8.0D0)**2- + 7.0D0*X(10)) RETURN 540 FA = FA + 1.0D1* (2.0D0*X(2)-8.0D0*X(1)+5.0D0*X(9)-2.0D0*X(10)- + 1.2D1) RETURN 550 FA = X(1)**2 + X(2)**2 + X(1)*X(2) - 1.4D1*X(1) - 1.6D1*X(2) + + (X(3)-1.0D1)**2 + 4.0D0* (X(4)-5.0D0)**2 + (X(5)-3.0D0)**2 + + 2.0D0* (X(6)-1.0D0)**2 + 5.0D0*X(7)**2 + + 7.0D0* (X(8)-1.1D1)**2 + 2.0D0* (X(9)-1.0D1)**2 + + (X(10)-7.0D0)**2 + (X(11)-9.0D0)**2 + + 1.0D1* (X(12)-1.0D0)**2 + 5.0D0* (X(13)-7.0D0)**2 + + 4.0D0* (X(14)-1.4D1)**2 + 2.7D1* (X(15)-1.0D0)**2 + + X(16)**4 + (X(17)-2.0D0)**2 + 1.3D1* (X(18)-2.0D0)**2 + + (X(19)-3.D0)**2 + X(20)**2 + 9.5D1 560 GO TO (320,470,480,490,500,510,520,530,540,570,580,590, + 600,610,620,630,640,650) KA 570 FA = FA + 1.0D1* (X(1)+X(2)+4.0D0*X(11)-2.1D1*X(12)) RETURN 580 FA = FA + 1.0D1* (X(1)**2+1.5D1*X(11)-8.0D0*X(12)-2.8D1) RETURN 590 FA = FA + 1.0D1* (4.0D0*X(1)+9.0D0*X(2)+5.0D0*X(13)**2- + 9.0D0*X(14)-8.7D1) RETURN 600 FA = FA + 1.0D1* (3.0D0*X(1)+4.0D0*X(2)+3.0D0* (X(13)-6.0D0)**2- + 1.4D1*X(14)-1.0D1) RETURN 610 FA = FA + 1.0D1* (1.4D1*X(1)**2+3.5D1*X(15)-7.9D1*X(16)-9.2D1) RETURN 620 FA = FA + 1.0D1* (1.5D1*X(2)**2+1.1D1*X(15)-6.1D1*X(16)-5.4D1) RETURN 630 FA = FA + 1.0D1* (5.0D0*X(1)**2+2.0D0*X(2)+9.0D0*X(17)**4-X(18)- + 6.8D1) RETURN 640 FA = FA + 1.0D1* (X(1)**2-X(2)+1.9D1*X(19)-2.0D1*X(20)+1.9D1) RETURN 650 FA = FA + 1.0D1* (7.0D0*X(1)**2+5.0D0*X(2)**2+X(19)**2- + 3.0D1*X(20)) RETURN 660 X1 = 0.0D0 DO 670 I = 1,N X3 = 1.0D0 X4 = X(I) IF (I.EQ.1) X3 = 1.0D-8 IF (I.EQ.4) X3 = 4.0D0 IF (I.EQ.2 .AND. KA.EQ.1) X4 = X(I) + 2.0D0 IF (I.EQ.2 .AND. KA.EQ.2) X4 = X(I) - 2.0D0 X1 = X1 + X3*X4**2 670 CONTINUE FA = EXP(X1) RETURN 680 FA = 0.0D0 DO 690 I = 1,N X1 = 1.0D0*DBLE(I+KA-1) X2 = X(I) - SIN(DBLE(2*I+KA-3)) FA = FA + X1*EXP(X2**2) 690 CONTINUE RETURN 700 IF (KA.EQ.1) THEN FA = X(1) ELSE IF (KA.EQ.2) THEN FA = X(2) - X(1)**2 - 1.0D0 ELSE T = DBLE(KA-2)/2.9D1 X1 = 0.0D0 X2 = X(1) DO 710 I = 2,N X1 = X1 + DBLE(I-1)*X(I)*T** (I-2) X2 = X2 + X(I)*T** (I-1) 710 CONTINUE FA = X1 - X2**2 - 1.0D0 END IF RETURN 720 T = 1.0D-1*DBLE(KA-1) FA = Y(KA) - X(1)*EXP(-X(5)*T) - X(2)*EXP(-X(6)* (T-X(9))**2) - + X(3)*EXP(-X(7)* (T-X(10))**2) - X(4)*EXP(-X(8)* (T-X(11))**2) RETURN END * SUBROUTINE TAGU06 ALL SYSTEMS 99/12/01 C PORTABILITY : ALL SYSTEMS C 90/12/01 LU : ORIGINAL VERSION * * PURPOSE : * GRADIENTS OF PARTIAL FUNCTIONS IN THE MINIMAX CRITERION. * * PARAMETERS : * II N NUMBER OF VARIABLES. * II KA INDEX OF THE PARTIAL FUNCTION. * RI X(N) VECTOR OF VARIABLES. * RO GA(N) GRADIENT OF THE PARTIAL FUNCTION AT THE * SELECTED POINT. * II NEXT NUMBER OF THE TEST PROBLEM. * SUBROUTINE TAGU06(N,KA,X,GA,NEXT) C .. Parameters .. DOUBLE PRECISION PI PARAMETER (PI=3.14159265358979323846D0) C .. C .. Scalar Arguments .. INTEGER KA,N,NEXT C .. C .. Array Arguments .. DOUBLE PRECISION GA(N),X(N) C .. C .. Arrays in Common .. DOUBLE PRECISION Y(123) C .. C .. Local Scalars .. DOUBLE COMPLEX C1,C2,C3 DOUBLE PRECISION BETA,FA,T,X1,X2,X3,X4,X5,X6,X7,X8 INTEGER I,J C .. C .. Local Arrays .. DOUBLE COMPLEX CA(4),CB(4),CC(6) DOUBLE PRECISION XA(3),XB(3),XC(3) C .. C .. Intrinsic Functions .. INTRINSIC ABS,CDABS,CMPLX,CONJG,COS,DBLE,EXP,MIN,SIN,SQRT C .. C .. Common blocks .. COMMON /EMPR06/Y C .. GO TO (10,50,60,70,140,190,240,250,260, + 270,280,290,300,310,330,340,350,400, + 410,470,570,680,710,730,770) NEXT 10 X1 = X(1)*X(1) X2 = X(2)*X(2) X3 = X(1) + X(1) X4 = X(2) + X(2) GO TO (20,30,40) KA 20 GA(1) = X3 GA(2) = (X2+X2)*X4 RETURN 30 GA(1) = -4.0D0 + X3 GA(2) = -4.0D0 + X4 RETURN 40 FA = 2.0D0*EXP(X(2)-X(1)) GA(1) = -FA GA(2) = +FA RETURN 50 X1 = 1.0D0/ (X(1)+1.0D-1)**2 GA(2) = 2.0D0*X(2) IF (KA.EQ.1) THEN GA(1) = 0.5D0* (1.0D0+X1) ELSE IF (KA.EQ.2) THEN GA(1) = 0.5D0* (-1.0D0+X1) ELSE IF (KA.EQ.3) THEN GA(1) = 0.5D0* (1.0D0-X1) END IF RETURN 60 X1 = X(1)**2 + X(2)**2 X2 = SQRT(X1) X3 = COS(X2) X4 = SIN(X2) IF (KA.EQ.1) THEN X5 = 2.0D0* (X(1)-X2*X3) X6 = - (X3/X2-X4) GA(1) = X5* (X(1)*X6+1.0D0) + 1.0D-2*X(1) GA(2) = X5*X(2)*X6 + 1.0D-2*X(2) ELSE IF (KA.EQ.2) THEN X5 = 2.0D0* (X(2)-X2*X4) X6 = - (X4/X2+X3) GA(1) = X5*X(1)*X6 + 1.0D-2*X(1) GA(2) = X5* (X(2)*X6+1.0D0) + 1.0D-2*X(2) END IF RETURN 70 GO TO (80,90,100,110,120,130) KA 80 GA(1) = 2.0D0*X(1) GA(2) = 2.0D0*X(2) GA(3) = 2.0D0*X(3) RETURN 90 GA(1) = 2.0D0*X(1) GA(2) = 2.0D0*X(2) GA(3) = 2.0D0* (X(3)-2.0D0) RETURN 100 GA(1) = 1.0D0 GA(2) = 1.0D0 GA(3) = 1.0D0 RETURN 110 GA(1) = 1.0D0 GA(2) = 1.0D0 GA(3) = -1.0D0 RETURN 120 GA(1) = 6.0D0*X(1)**2 - 4.0D0* (5.0D0*X(3)-X(1)+1.0D0) GA(2) = 1.2D1*X(2) GA(3) = 2.0D1* (5.0D0*X(3)-X(1)+1.0D0) RETURN 130 GA(1) = 2.0D0*X(1) GA(2) = 0.0D0 GA(3) = -9.0D0 RETURN 140 X1 = X(1)*X(1) X2 = X(2)*X(2) X3 = X(3)*X(3) X4 = X(4)*X(4) X5 = X(1) + X(1) X6 = X(2) + X(2) X7 = X(3) + X(3) X8 = X(4) + X(4) GA(1) = X5 - 5.0D0 GA(2) = X6 - 5.0D0 GA(3) = X7 + X7 - 2.1D1 GA(4) = X8 + 7.0D0 150 GO TO (320,160,170,180) KA 160 GA(1) = GA(1) + 1.0D1* (X5+1.0D0) GA(2) = GA(2) + 1.0D1* (X6-1.0D0) GA(3) = GA(3) + 1.0D1* (X7+1.0D0) GA(4) = GA(4) + 1.0D1* (X8-1.0D0) RETURN 170 GA(1) = GA(1) + 1.0D1* (X5-1.0D0) GA(2) = GA(2) + 1.0D1* (X6+X6) GA(3) = GA(3) + 1.0D1*X7 GA(4) = GA(4) + 1.0D1* (X8+X8-1.0D0) RETURN 180 GA(1) = GA(1) + 1.0D1* (X5+2.0D0) GA(2) = GA(2) + 1.0D1* (X6-1.0D0) GA(3) = GA(3) + 1.0D1*X7 GA(4) = GA(4) - 1.0D1 RETURN 190 X1 = X(1) - (X(4)+1.0D0)**4 X2 = X1*X1 X3 = X(2) - X2*X2 X4 = X1*X3 X5 = -4.0D0* (X(4)+1.0D0)**3 GA(1) = 2.0D0*X1 - 8.0D0*X4 - 5.0D0* (1.0D0-4.0D0*X1) GA(2) = 2.0D0*X3 - 5.0D0 GA(3) = 4.0D0*X(3) - 2.1D1 GA(4) = 2.0D0*X1*X5 - 8.0D0*X4*X5 + 2.0D0*X(4) - + 5.0D0* (X5-4.0D0*X1*X5) + 7.0D0 GO TO (200,210,220,230) KA 200 CONTINUE RETURN 210 GA(1) = GA(1) + 1.0D1* (2.0D0*X1-8.0D0*X4+1.0D0+4.0D0*X1) GA(2) = GA(2) + 1.0D1* (2.0D0*X3-1.0D0) GA(3) = GA(3) + 1.0D1* (2.0D0*X(3)+1.0D0) GA(4) = GA(4) + 1.0D1* (2.0D0*X1*X5-8.0D0*X4*X5+2.0D0*X(4)+X5+ + 4.0D0*X1*X5-1.0D0) RETURN 220 GA(1) = GA(1) + 1.0D1* (2.0D0*X1-1.6D1*X4-1.0D0) GA(2) = GA(2) + 1.0D1* (4.0D0*X3) GA(3) = GA(3) + 1.0D1* (2.0D0*X(3)) GA(4) = GA(4) + 1.0D1* (2.0D0*X1*X5-1.6D1*X4*X5+4.0D0*X(4)-X5- + 1.0D0) RETURN 230 GA(1) = GA(1) + 1.0D1* (2.0D0*X1-8.0D0*X4+2.0D0+4.0D0*X1) GA(2) = GA(2) + 1.0D1* (2.0D0*X3-1.0D0) GA(3) = GA(3) + 1.0D1* (2.0D0*X(3)) GA(4) = GA(4) + 1.0D1* (2.0D0*X1*X5-8.0D0*X4*X5+2.0D0*X5+ + 4.0D0*X1*X5-1.0D0) RETURN 240 T = Y(KA) X1 = EXP(-X(1)*T)/X(2) X2 = SIN(X(2)*T) X3 = COS(X(2)*T) GA(1) = -T*X(3)*X1*X2 GA(2) = X(3)*X1* (T*X3-X2/X(2)) GA(3) = X1*X2 RETURN 250 C1 = DBLE(16-KA) C2 = DBLE(MIN(KA,16-KA)) C3 = DBLE(KA)/ (C1*X(2)+C2*X(3))**2 GA(1) = -1.0D0 GA(2) = C1*C3 GA(3) = C2*C3 RETURN 260 T = Y(KA+11) X1 = X(1)*T* (T+X(2)) X2 = ((T+X(3))*T+X(4)) X3 = X1/X2**2 GA(1) = -T* (T+X(2))/X2 GA(2) = -T*X(1)/X2 GA(3) = T*X3 GA(4) = X3 RETURN 270 T = 0.2D0*DBLE(KA) GA(1) = 2.0D0* (X(1)+X(2)*T-EXP(T)) GA(2) = 2.0D0* (X(1)+X(2)*T-EXP(T))*T GA(3) = 2.0D0* (X(3)+X(4)*SIN(T)-COS(T)) GA(4) = 2.0D0* (X(3)+X(4)*SIN(T)-COS(T))*SIN(T) RETURN 280 T = Y(KA) X1 = -2.0D0* ((X(1)*T+X(2))*T+X(3)) GA(1) = X1*T**2 GA(2) = X1*T GA(3) = X1 GA(4) = 1.0D0 RETURN 290 T = Y(KA) X1 = EXP(X(3)*T) X2 = EXP(X(4)*T) GA(1) = X1 GA(2) = X2 GA(3) = X(1)*T*X1 GA(4) = X(2)*T*X2 RETURN 300 T = Y(KA) X1 = T + X(2) + 1.0D0/ (X(3)*T+X(4)) IF (X1.EQ.0D0) X1 = 1D-30 X2 = X1/ ((T+1.0D0)*Y(61+KA)) GA(1) = ABS(X2)** (T+5.0D-1) GA(2) = X(1)*GA(1)* (T+5.0D-1)/X1 GA(4) = -GA(2)/ (X(3)*T+X(4))**2 GA(3) = GA(4)*T RETURN 310 T = 0.1D0*DBLE(KA-1) - 1.0D0 X1 = X(1) + T*X(2) X2 = 1.0D0/ (1.0D0+T* (X(3)+T* (X(4)+T*X(5)))) X3 = X1*X2 - EXP(T) GA(1) = X2 GA(2) = X2*T GA(3) = -X1*X2*X2*T GA(4) = GA(3)*T GA(5) = GA(4)*T 320 RETURN 330 T = Y(KA) X1 = 1.0D0/ (1.0D0+T* (X(4)+T*X(5))) X2 = X(1) + T* (X(2)+T*X(3)) GA(1) = X1 GA(2) = X1*T GA(3) = X1*T*T GA(4) = -X2*X1**2*T GA(5) = -X2*X1**2*T*T RETURN 340 T = 0.1D0*DBLE(KA-1) X1 = EXP(-X(2)*T) X2 = COS(X(3)*T+X(4)) X3 = SIN(X(3)*T+X(4)) X4 = EXP(-X(6)*T) GA(1) = X1*X2 GA(2) = -X1*X2*X(1)*T GA(3) = -X1*X3*X(1)*T GA(4) = -X1*X3*X(1) GA(5) = X4 GA(6) = -X4*X(5)*T RETURN 350 BETA = 0.5D0*PI*Y(KA) DO 360 I = 1,3 J = I + I XA(I) = X(J-1) XB(I) = X(J) 360 CONTINUE CA(4) = CMPLX(1.0D0,0.0D0) CB(4) = 1.0D1*CA(4) DO 370 J = 1,3 I = 4 - J XC(I) = BETA*XA(I) T = XC(I) X1 = COS(T) X2 = SIN(T) C1 = CMPLX(X1,0.0D0) C2 = CMPLX(0.0D0, (X2*XB(I))) C3 = CMPLX(0.0D0, (X2/XB(I))) CB(I) = C1*CB(I+1) + C2*CA(I+1) CA(I) = C3*CB(I+1) + C1*CA(I+1) 370 CONTINUE C1 = -CA(1) C2 = CB(1) - C1 C3 = 1.0D0 + 2.0D0*C1/C2 FA = CDABS(C3) C3 = CONJG(C3) C1 = 2.0D0/C2 DO 380 I = 1,3 T = XC(I) J = I + I CC(J) = (CB(I)*CA(I)-CB(I+1)*CA(I+1))/ (C2*XB(I)) CC(J-1) = BETA* (CB(I)*CA(I+1)-CB(I+1)*CA(I))/ (C2*SIN(T)) 380 CONTINUE DO 390 I = 1,6 GA(I) = DBLE(C1*C3*CC(I))/FA 390 CONTINUE RETURN 400 T = Y(41+KA) BETA = Y(82+KA) X1 = (X(1)+ (1D0+X(2))*T)**2 + ((1D0-X(2))*BETA)**2 X2 = (X(3)+ (1D0+X(4))*T)**2 + ((1D0-X(4))*BETA)**2 X3 = (X(5)+ (1D0+X(6))*T)**2 + ((1D0-X(6))*BETA)**2 X4 = (X(7)+ (1D0+X(8))*T)**2 + ((1D0-X(8))*BETA)**2 IF (X1.EQ.0D0) X1 = 1D-30 IF (X2.EQ.0D0) X2 = 1D-30 IF (X3.EQ.0D0) X3 = 1D-30 IF (X4.EQ.0D0) X4 = 1D-30 FA = SQRT(X1/X2)*SQRT(X3/X4) GA(9) = FA FA = X(9)*FA GA(1) = FA/X1* (X(1)+T* (1D0+X(2))) GA(2) = FA/X1* (X(2)+2D0*T*T-1D0+X(1)*T) GA(3) = -FA/X2* (X(3)+T* (1D0+X(4))) GA(4) = -FA/X2* (X(4)+2D0*T*T-1D0+X(3)*T) GA(5) = FA/X3* (X(5)+T* (1D0+X(6))) GA(6) = FA/X3* (X(6)+2D0*T*T-1D0+X(5)*T) GA(7) = -FA/X4* (X(7)+T* (1D0+X(8))) GA(8) = -FA/X4* (X(8)+2D0*T*T-1D0+X(7)*T) RETURN 410 GA(1) = 2.0D0* (X(1)-1.0D1) GA(2) = 1.0D1* (X(2)-1.2D1) GA(3) = 4.0D0*X(3)**3 GA(4) = 6.0D0* (X(4)-1.1D1) GA(5) = 6.0D1*X(5)**5 GA(6) = 1.4D1*X(6) - 4.0D0*X(7) - 1.0D1 GA(7) = 4.0D0*X(7)**3 - 4.0D0*X(6) - 8.0D0 420 GO TO (320,430,440,450,460) KA 430 GA(1) = GA(1) + 4.0D1*X(1) GA(2) = GA(2) + 1.2D2*X(2)**3 GA(3) = GA(3) + 1.0D1 GA(4) = GA(4) + 8.0D1*X(4) GA(5) = GA(5) + 5.0D1 RETURN 440 GA(1) = GA(1) + 7.0D1 GA(2) = GA(2) + 3.0D1 GA(3) = GA(3) + 2.0D2*X(3) GA(4) = GA(4) + 1.0D1 GA(5) = GA(5) - 1.0D1 RETURN 450 GA(1) = GA(1) + 2.3D2 GA(2) = GA(2) + 2.0D1*X(2) GA(6) = GA(6) + 1.2D2*X(6) GA(7) = GA(7) - 8.0D1 RETURN 460 GA(1) = GA(1) + 8.0D1*X(1) - 3.0D1*X(2) GA(2) = GA(2) + 2.0D1*X(2) - 3.0D1*X(1) GA(3) = GA(3) + 4.0D1*X(3) GA(6) = GA(6) + 5.0D1 GA(7) = GA(7) - 1.1D2 RETURN 470 GA(1) = 2.0D0*X(1) + X(2) - 1.4D1 GA(2) = 2.0D0*X(2) + X(1) - 1.6D1 GA(3) = 2.0D0* (X(3)-1.0D1) GA(4) = 8.0D0* (X(4)-5.0D0) GA(5) = 2.0D0* (X(5)-3.0D0) GA(6) = 4.0D0* (X(6)-1.0D0) GA(7) = 1.0D1*X(7) GA(8) = 1.4D1* (X(8)-1.1D1) GA(9) = 4.0D0* (X(9)-1.0D1) GA(10) = 2.0D0* (X(10)-7.0D0) 480 GO TO (320,490,500,510,520,530,540,550,560) KA 490 GA(1) = GA(1) + 6.0D1* (X(1)-2.0D0) GA(2) = GA(2) + 8.0D1* (X(2)-3.0D0) GA(3) = GA(3) + 4.0D1*X(3) GA(4) = GA(4) - 7.0D1 RETURN 500 GA(1) = GA(1) + 1.0D2*X(1) GA(2) = GA(2) + 8.0D1 GA(3) = GA(3) + 2.0D1* (X(3)-6.0D0) GA(4) = GA(4) - 2.0D1 RETURN 510 GA(1) = GA(1) + 1.0D1* (X(1)-8.0D0) GA(2) = GA(2) + 4.0D1* (X(2)-4.0D0) GA(5) = GA(5) + 6.0D1*X(5) GA(6) = GA(6) - 1.0D1 RETURN 520 GA(1) = GA(1) + 2.0D1*X(1) - 2.0D1*X(2) GA(2) = GA(2) + 4.0D1* (X(2)-2.0D0) - 2.0D1*X(1) GA(5) = GA(5) + 1.4D2 GA(6) = GA(6) - 6.0D1 RETURN 530 GA(1) = GA(1) + 4.0D1 GA(2) = GA(2) + 5.0D1 GA(7) = GA(7) - 3.0D1 GA(8) = GA(8) + 9.0D1 RETURN 540 GA(1) = GA(1) + 1.0D2 GA(2) = GA(2) - 8.0D1 GA(7) = GA(7) - 1.7D2 GA(8) = GA(8) + 2.0D1 RETURN 550 GA(1) = GA(1) - 3.0D1 GA(2) = GA(2) + 6.0D1 GA(9) = GA(9) + 2.4D2* (X(9)-8.0D0) GA(10) = GA(10) - 7.0D1 RETURN 560 GA(1) = GA(1) - 8.0D1 GA(2) = GA(2) + 2.0D1 GA(9) = GA(9) + 5.0D1 GA(10) = GA(10) - 2.0D1 RETURN 570 GA(1) = 2.0D0*X(1) + X(2) - 1.4D1 GA(2) = 2.0D0*X(2) + X(1) - 1.6D1 GA(3) = 2.0D0* (X(3)-1.0D1) GA(4) = 8.0D0* (X(4)-5.0D0) GA(5) = 2.0D0* (X(5)-3.0D0) GA(6) = 4.0D0* (X(6)-1.0D0) GA(7) = 1.0D1*X(7) GA(8) = 1.4D1* (X(8)-1.1D1) GA(9) = 4.0D0* (X(9)-1.0D1) GA(10) = 2.0D0* (X(10)-7.0D0) GA(11) = 2.0D0* (X(11)-9.0D0) GA(12) = 2.0D1* (X(12)-1.0D0) GA(13) = 1.0D1* (X(13)-7.0D0) GA(14) = 8.0D0* (X(14)-1.4D1) GA(15) = 5.4D1* (X(15)-1.0D0) GA(16) = 4.0D0*X(16)**3 GA(17) = 2.0D0* (X(17)-2.0D0) GA(18) = 2.6D1* (X(18)-2.0D0) GA(19) = 2.0D0* (X(19)-3.0D0) GA(20) = 2.0D0*X(20) 580 GO TO (320,490,500,510,520,530,540,550,560,590,600,610, + 620,630,640,650,660,670) KA 590 GA(1) = GA(1) + 1.0D1 GA(2) = GA(2) + 1.0D1 GA(11) = GA(11) + 4.0D1 GA(12) = GA(12) - 2.1D2 RETURN 600 GA(1) = GA(1) + 2.0D1*X(1) GA(11) = GA(11) + 1.5D2 GA(12) = GA(12) - 8.0D1 RETURN 610 GA(1) = GA(1) + 4.0D1 GA(2) = GA(2) + 9.0D1 GA(13) = GA(13) + 1.0D2*X(13) GA(14) = GA(14) - 9.0D1 RETURN 620 GA(1) = GA(1) + 3.0D1 GA(2) = GA(2) + 4.0D1 GA(13) = GA(13) + 6.0D1* (X(13)-6.0D0) GA(14) = GA(14) - 1.4D2 RETURN 630 GA(1) = GA(1) + 2.8D2*X(1) GA(15) = GA(15) + 3.5D2 GA(16) = GA(16) - 7.9D2 RETURN 640 GA(2) = GA(2) + 3.0D2*X(2) GA(15) = GA(15) + 1.1D2 GA(16) = GA(16) - 6.1D2 RETURN 650 GA(1) = GA(1) + 1.0D2*X(1) GA(2) = GA(2) + 2.0D1 GA(17) = GA(17) + 3.6D2*X(17)**3 GA(18) = GA(18) - 1.0D1 RETURN 660 GA(1) = GA(1) + 2.0D1*X(1) GA(2) = GA(2) - 1.0D1 GA(19) = GA(19) + 1.9D2 GA(20) = GA(20) - 2.0D2 RETURN 670 GA(1) = GA(1) + 1.4D2*X(1) GA(2) = GA(2) + 1.0D2*X(2) GA(19) = GA(19) + 2.0D1*X(19) GA(20) = GA(20) - 3.0D2 RETURN 680 X1 = 0.0D0 DO 690 I = 1,N X3 = 1.0D0 X4 = X(I) IF (I.EQ.1) X3 = 1.0D-8 IF (I.EQ.4) X3 = 4.0D0 IF (I.EQ.2 .AND. KA.EQ.1) X4 = X(I) + 2.0D0 IF (I.EQ.2 .AND. KA.EQ.2) X4 = X(I) - 2.0D0 X1 = X1 + X3*X4**2 690 CONTINUE X2 = EXP(X1) DO 700 I = 1,N X3 = 2.0D0 X4 = X(I) IF (I.EQ.1) X3 = 2.0D-8 IF (I.EQ.4) X3 = 8.0D0 IF (I.EQ.2 .AND. KA.EQ.1) X4 = X(I) + 2.0D0 IF (I.EQ.2 .AND. KA.EQ.2) X4 = X(I) - 2.0D0 GA(I) = X2*X3*X4 700 CONTINUE RETURN 710 DO 720 I = 1,N X1 = 1.0D0*DBLE(I+KA-1) X2 = X(I) - SIN(DBLE(2*I+KA-3)) GA(I) = 2.0D0*X1*X2*EXP(X2**2) 720 CONTINUE RETURN 730 IF (KA.LE.2) THEN DO 740 I = 2,N GA(I) = 0.0D0 740 CONTINUE IF (KA.EQ.1) THEN GA(1) = 1.0D0 ELSE IF (KA.EQ.2) THEN GA(1) = -2.0D0*X(1) GA(2) = 1.0D0 END IF ELSE GA(1) = 0.0D0 T = DBLE(KA-2)/2.9D1 X2 = X(1) DO 750 I = 2,N X2 = X2 + X(I)*T** (I-1) 750 CONTINUE DO 760 I = 1,N IF (I.GT.1) GA(I) = DBLE(I-1)*T** (I-2) GA(I) = GA(I) - 2.0D0*X2*T** (I-1) 760 CONTINUE END IF RETURN 770 T = 1.0D-1*DBLE(KA-1) X1 = EXP(-X(5)*T) X2 = EXP(-X(6)* (T-X(9))**2) X3 = EXP(-X(7)* (T-X(10))**2) X4 = EXP(-X(8)* (T-X(11))**2) GA(1) = -X1 GA(2) = -X2 GA(3) = -X3 GA(4) = -X4 GA(5) = X1*X(1)*T GA(6) = X2*X(2)* (T-X(9))**2 GA(7) = X3*X(3)* (T-X(10))**2 GA(8) = X4*X(4)* (T-X(11))**2 GA(9) = -2.0D0*X2*X(2)*X(6)* (T-X(9)) GA(10) = -2.0D0*X3*X(3)*X(7)* (T-X(10)) GA(11) = -2.0D0*X4*X(4)*X(8)* (T-X(11)) RETURN END * SUBROUTINE TAHD06 ALL SYSTEMS 99/12/01 C PORTABILITY : ALL SYSTEMS C 95/12/01 LU : ORIGINAL VERSION * * PURPOSE : * HESSIAN MATRICES OF PARTIAL FUNCTIONS IN THE MINIMAX CRITERION. * DENSE VERSION. * * PARAMETERS : * II N NUMBER OF VARIABLES. * II KA INDEX OF THE PARTIAL FUNCTION. * RI X(N) VECTOR OF VARIABLES. * RO HA(N*(N+1)/2) HESSIAN MATRIX OF THE PARTIAL FUNCTION * AT THE SELECTED POINT. * II NEXT NUMBER OF THE TEST PROBLEM. * SUBROUTINE TAHD06(N,KA,X,HA,NEXT) C .. Parameters .. DOUBLE PRECISION PI PARAMETER (PI=3.14159265358979323846D0) C .. C .. Scalar Arguments .. INTEGER KA,N,NEXT C .. C .. Array Arguments .. DOUBLE PRECISION HA(N* (N+1)/2),X(N) C .. C .. Arrays in Common .. DOUBLE PRECISION Y(123) C .. C .. Local Scalars .. DOUBLE COMPLEX C1,C2,C3,CI,S1,S2,S3,S4 DOUBLE PRECISION BETA,FA,T,X1,X2,X3,X4,X5,X6,X7,X8 INTEGER I,J,L C .. C .. Local Arrays .. DOUBLE COMPLEX CA(4),CB(4),CC(6),DD(6) DOUBLE PRECISION CT(3),GA(8),ST(3),XA(3),XB(3),XC(3) C .. C .. Intrinsic Functions .. INTRINSIC ABS,CDABS,CMPLX,CONJG,COS,DBLE,EXP,MIN,SIN,SQRT C .. C .. Common blocks .. COMMON /EMPR06/Y C .. GO TO (10,20,30,40,100,150,200,210,230, + 240,250,270,290,300,310,330,350,430, + 470,540,620,720,760,790,830) NEXT 10 HA(1) = 2.0D0 HA(2) = 0.0D0 HA(3) = 2.0D0 IF (KA.EQ.1) HA(3) = 12.0D0*X(2)*X(2) IF (KA.EQ.3) THEN HA(1) = 2.0D0*EXP(X(2)-X(1)) HA(2) = -HA(1) HA(3) = HA(1) END IF RETURN 20 CONTINUE HA(2) = 0.0D0 HA(3) = 2.0D0 X1 = 1.0D0/ (X(1)+1.0D-1)**3 IF (KA.EQ.3) THEN HA(1) = X1 ELSE HA(1) = -X1 END IF RETURN 30 X1 = X(1)**2 + X(2)**2 X2 = SQRT(X1) X3 = COS(X2) X4 = SIN(X2) IF (KA.EQ.1) THEN X5 = X(1) - X2*X3 X6 = - (X3/X2-X4) X7 = X2 + 1.0D0/X2 X7 = (X7*X3+X4)/X2**2 X1 = 1.0D0 + X6*X(1) X2 = X6*X(2) HA(1) = 2.0D0* (X1**2+X5* (X6+X7*X(1)**2)) + 1.0D-2 HA(2) = 2.0D0*X(2)* (X6*X1+X5*X7*X(1)) HA(3) = 2.0D0* (X2**2+X5* (X6+X7*X(2)**2)) + 1.0D-2 ELSE IF (KA.EQ.2) THEN X5 = X(2) - X2*X4 X6 = - (X4/X2+X3) X7 = X2 + 1.0D0/X2 X7 = (X7*X4-X3)/X2**2 X1 = X6*X(1) X2 = 1.0D0 + X6*X(2) HA(1) = 2.0D0* (X1**2+X5* (X6+X7*X(1)**2)) + 1.0D-2 HA(2) = 2.0D0*X(1)* (X6*X2+X5*X7*X(2)) HA(3) = 2.0D0* (X2**2+X5* (X6+X7*X(2)**2)) + 1.0D-2 END IF RETURN 40 DO 50 I = 1,N* (N+1)/2 HA(I) = 0.0D0 50 CONTINUE GO TO (60,60,70,70,80,90) KA 60 HA(1) = 2.0D0 HA(3) = 2.0D0 HA(6) = 2.0D0 RETURN 70 RETURN 80 HA(1) = 1.6D0 HA(3) = 1.2D1 HA(4) = -2.0D1 HA(6) = 1.0D2 RETURN 90 HA(1) = 2.0D0 RETURN 100 DO 110 I = 1,N* (N+1)/2 HA(I) = 0.0D0 110 CONTINUE HA(1) = 2.0D0 HA(3) = 2.0D0 HA(6) = 4.0D0 HA(10) = 2.0D0 IF (KA.GT.1) THEN HA(1) = HA(1) + 2.0D1 HA(3) = HA(3) + 2.0D1 HA(6) = HA(6) + 2.0D1 HA(10) = HA(10) + 2.0D1 GO TO (140,120,130) KA - 1 120 HA(3) = HA(3) + 2.0D1 HA(10) = HA(10) + 2.0D1 GO TO 140 130 HA(10) = HA(10) - 2.0D1 140 CONTINUE END IF RETURN 150 X1 = X(1) - (X(4)+1.0D0)**4 X2 = X1*X1 X3 = X(2) - X2*X2 X4 = X3*X3 X5 = -4.0D0* (X(4)+1.0D0)**3 X6 = -1.2D1* (X(4)+1.0D0)**2 X7 = X1*X6 + X5*X5 X8 = X3 - 4.0D0*X1*X1 HA(1) = 2.0D0 - 8.0D0*X8 + 2.0D1 HA(2) = -8.0D0*X1 HA(3) = 2.0D0 HA(4) = 0.0D0 HA(5) = 0.0D0 HA(6) = 4.0D0 HA(7) = 2.0D0*X5 - 8.0D0*X5*X8 + 2.0D1*X5 HA(8) = -8.0D0*X1*X5 HA(9) = 0.0D0 HA(10) = 2.0D0*X7 - 8.0D0* (X5*X5*X8+X1*X3*X6) - + 5.0D0* (X6-4.0D0*X7) + 2.0D0 GO TO (160,170,180,190) KA 160 CONTINUE RETURN 170 CONTINUE HA(1) = HA(1) + 1.0D1* (2.0D0-8.0D0*X8+4.0D0) HA(2) = HA(2) - 8.0D1*X1 HA(3) = HA(3) + 2.0D1 HA(6) = HA(6) + 2.0D1 HA(7) = HA(7) + 1.0D1* (2.0D0*X5-8.0D0*X5*X8+4.0D0*X5) HA(8) = HA(8) - 8.0D1*X1*X5 HA(10) = HA(10) + 1.0D1* (2.0D0*X7-8.0D0* (X5*X5*X8+X1*X3*X6)+X6+ + 4.0D0*X7+2.0D0) RETURN 180 CONTINUE HA(1) = HA(1) + 1.0D1* (2.0D0-1.6D1*X8) HA(2) = HA(2) - 1.6D2*X1 HA(3) = HA(3) + 4.0D1 HA(6) = HA(6) + 2.0D1 HA(7) = HA(7) + 1.0D1* (2.0D0*X5-1.6D1*X5*X8) HA(8) = HA(8) - 1.6D2*X1*X5 HA(10) = HA(10) + 1.0D1* (2.0D0*X7-1.6D1* (X5*X5*X8+X1*X3*X6)-X6+ + 4.0D0) RETURN 190 CONTINUE HA(1) = HA(1) + 1.0D1* (2.0D0-8.0D0*X8+4.0D0) HA(2) = HA(2) - 8.0D1*X1 HA(3) = HA(3) + 2.0D1 HA(6) = HA(6) + 2.0D1 HA(7) = HA(7) + 1.0D1* (2.0D0*X5-8.0D0*X5*X8+4.0D0*X5) HA(8) = HA(8) - 8.0D1*X1*X5 HA(10) = HA(10) + 1.0D1* (2.0D0*X7-8.0D0* (X5*X5*X8+X1*X3*X6)+ + 2.0D0*X6+4.0D0*X7) RETURN 200 T = Y(KA) X1 = EXP(-X(1)*T)/X(2) X2 = SIN(X(2)*T) X3 = COS(X(2)*T) X4 = T*X3 - X2/X(2) HA(1) = X(3)*X1*X2*T**2 HA(2) = -X(3)*X1*X4*T HA(3) = -X(3)*X1* (T**2*X2+2.0D0*T*X3/X(2)-2.0D0*X2/X(2)**2) HA(4) = -X1*X2*T HA(5) = X1*X4*T HA(6) = 0.0D0 RETURN 210 DO 220 I = 1,N* (N+1)/2 HA(I) = 0.0D0 220 CONTINUE C1 = DBLE(16-KA) C2 = DBLE(MIN(KA,16-KA)) C3 = -2.0D0*DBLE(KA)/ (C1*X(2)+C2*X(3))**3 HA(3) = C1*C1*C3 HA(5) = C1*C2*C3 HA(6) = C2*C2*C3 RETURN 230 T = Y(KA+11) X1 = X(1)*T* (T+X(2)) X2 = ((T+X(3))*T+X(4)) X3 = 1.0D0/X2**2 X4 = T* (T+X(2))*X3 X5 = -2.0D0*X1*X3/X2 HA(1) = 0.0D0 HA(2) = -T/X2 HA(3) = 0.0D0 HA(7) = X4 HA(4) = T*X4 HA(8) = T*X(1)*X3 HA(5) = T*HA(8) HA(10) = X5 HA(9) = T*X5 HA(6) = T*HA(9) RETURN 240 T = 0.2D0*DBLE(KA) HA(1) = 2.0D0 HA(2) = 2.0D0*T HA(3) = 2.0D0*T*T HA(4) = 0.0D0 HA(5) = 0.0D0 HA(6) = 2.0D0 HA(7) = 0.0D0 HA(8) = 0.0D0 HA(9) = 2.0D0*SIN(T) HA(10) = 2.0D0*SIN(T)**2 RETURN 250 T = Y(KA) DO 260 I = 7,10 HA(I) = 0.0D0 260 CONTINUE HA(6) = -2.0D0 HA(5) = HA(6)*T HA(4) = HA(5)*T HA(3) = HA(4) HA(2) = HA(3)*T HA(1) = HA(2)*T RETURN 270 T = Y(KA) DO 280 I = 1,10 HA(I) = 0.0D0 280 CONTINUE X1 = EXP(X(3)*T) X2 = EXP(X(4)*T) HA(4) = X1*T HA(8) = X2*T HA(6) = X(1)*X1*T**2 HA(10) = X(2)*X2*T**2 RETURN 290 T = Y(KA) X1 = T + X(2) + 1.0D0/ (X(3)*T+X(4)) IF (X1.EQ.0D0) X1 = 1D-30 X2 = X1/ ((T+1.0D0)*Y(61+KA)) X3 = X(3)*T + X(4) IF (X3.EQ.0D0) X3 = 1D-30 HA(1) = 0.0D0 HA(2) = ABS(X2)** (T+5.0D-1)* (T+5.0D-1)/X1 BETA = X(1)*HA(2)/X1 HA(3) = BETA* (T-5.0D-1) HA(7) = -HA(2)/ (X3*X3) HA(4) = HA(7)*T HA(8) = -HA(3)/ (X3*X3) HA(5) = HA(8)*T HA(10) = BETA* (T+1.5D0+ (X3+X3)* (T+X(2)))/X3**4 HA(6) = HA(10)*T*T HA(9) = HA(10)*T RETURN 300 T = 0.1D0*DBLE(KA-1) - 1.0D0 HA(1) = 0.0D0 HA(2) = 0.0D0 HA(3) = 0.0D0 X1 = X(1) + T*X(2) X2 = 1.0D0/ (1.0D0+T* (X(3)+T* (X(4)+T*X(5)))) X3 = -T*X2*X2 X4 = -2.0D0*T*X1*X2*X3 HA(4) = X3 HA(5) = HA(4)*T HA(7) = HA(5) HA(8) = HA(7)*T HA(11) = HA(8) HA(12) = HA(11)*T HA(6) = X4 HA(9) = HA(6)*T HA(10) = HA(9)*T HA(13) = HA(10) HA(14) = HA(13)*T HA(15) = HA(14)*T RETURN 310 T = Y(KA) DO 320 I = 1,6 HA(I) = 0.0D0 320 CONTINUE X1 = 1.0D0/ (1.0D0-T* (X(4)-T*X(5))) X2 = X(1) + T* (X(2)+T*X(3)) X3 = X1*X1 HA(7) = -T*X3 HA(8) = HA(7)*T HA(9) = HA(8)*T HA(10) = 2.0D0*T*T*X1*X2*X3 HA(11) = HA(8) HA(12) = HA(11)*T HA(13) = HA(12)*T HA(14) = HA(10)*T HA(15) = HA(14)*T RETURN 330 T = 0.1D0*DBLE(KA-1) DO 340 I = 1,N* (N+1)/2 HA(I) = 0.0D0 340 CONTINUE X1 = EXP(-X(2)*T) X2 = COS(X(3)*T+X(4)) X3 = SIN(X(3)*T+X(4)) X4 = EXP(-X(6)*T) HA(2) = -X1*X2*T HA(10) = -X1*X2*X(1) HA(9) = HA(10)*T HA(3) = -HA(9)*T HA(7) = -X1*X3 HA(4) = HA(7)*T HA(8) = X1*X3*X(1)*T HA(5) = HA(8)*T HA(6) = -HA(3) HA(20) = -X4*T HA(21) = -HA(20)*X(5)*T RETURN 350 BETA = 0.5D0*PI*Y(KA) DO 360 I = 1,3 J = I + I XA(I) = X(J-1) XB(I) = X(J) 360 CONTINUE CA(4) = CMPLX(1.0D0,0.0D0) CB(4) = 1.0D1*CA(4) DO 370 J = 1,3 I = 4 - J XC(I) = BETA*XA(I) T = XC(I) X1 = COS(T) X2 = SIN(T) C1 = CMPLX(X1,0.0D0) C2 = CMPLX(0.0D0, (X2*XB(I))) C3 = CMPLX(0.0D0, (X2/XB(I))) CB(I) = C1*CB(I+1) + C2*CA(I+1) CA(I) = C3*CB(I+1) + C1*CA(I+1) 370 CONTINUE C1 = -CA(1) C2 = CB(1) - C1 C3 = 1.0D0 + 2.0D0*C1/C2 FA = CDABS(C3) C3 = CONJG(C3) C1 = 2.0D0/ (C2*C2) T = BETA DO 380 I = 1,3 ST(I) = SIN(XC(I)) CT(I) = COS(XC(I)) CC(I+I) = (CB(I)*CA(I)-CB(I+1)*CA(I+1))/XB(I) CC(I+I-1) = (CB(I)*CA(I+1)-CB(I+1)*CA(I))*T/ST(I) 380 CONTINUE DO 390 I = 1,6 GA(I) = DBLE(C3*C1*CC(I))/FA 390 CONTINUE CI = CMPLX(0D0,1D0) X2 = X(2) X4 = X(4) X3 = X(6) C2 = - (C1+C1)/C2 S1 = CMPLX(-ST(1)*X2,CT(1)) S2 = CMPLX(ST(1)/X2,-CT(1)) S3 = S1*CT(2) - CI*S2*ST(2)*X4 S4 = S2*CT(2) - CI*S1*ST(2)/X4 DD(1) = C2* (T*CI* (CB(1)/X2+CA(1)*X2)) DD(2) = C2* (-ST(1)*CI* (CB(2)/ (X2*X2)-CA(2))) DD(3) = C2* (T* (CB(2)*S1/X4-CA(2)*S2*X4)) DD(4) = C2* (-ST(2)* (CB(3)*S1/ (X4*X4)+CA(3)*S2)) DD(5) = C2* (T* (CB(3)*S3/X3-CA(3)*S4*X3)) DD(6) = C2* (-ST(3)* (1D1*S3/ (X3*X3)+S4)) L = 0 DO 410 I = 1,6 L = L + I - 1 DO 400 J = 1,I HA(L+J) = (DBLE(CC(I)* (C3*DD(J)+C1*CONJG(C1*CC(J))))- + GA(I)*GA(J))/FA 400 CONTINUE 410 CONTINUE DO 420 I = 1,3 J = I* (I+I+1) HA(J-1) = HA(J-1) + DBLE(C3*C1*CI*T* + (CA(I)*CA(I)+ (CB(I)/XB(I))**2))/FA HA(J) = HA(J) + DBLE(C3*C1/XB(I)* + (CI*ST(I)* (CA(I)*CA(I+1)-CB(I)*CB(I+ + 1)/ (XB(I)*XB(I)))-CC(I+I)))/FA 420 CONTINUE RETURN 430 T = Y(41+KA) BETA = Y(82+KA) X1 = (X(1)+ (1.0D0+X(2))*T)**2 + ((1.0D0-X(2))*BETA)**2 X2 = (X(3)+ (1.0D0+X(4))*T)**2 + ((1.0D0-X(4))*BETA)**2 X3 = (X(5)+ (1.0D0+X(6))*T)**2 + ((1.0D0-X(6))*BETA)**2 X4 = (X(7)+ (1.0D0+X(8))*T)**2 + ((1.0D0-X(8))*BETA)**2 IF (X1.EQ.0.0D0) X1 = 1.0D-30 IF (X2.EQ.0.0D0) X2 = 1.0D-30 IF (X3.EQ.0.0D0) X3 = 1.0D-30 IF (X4.EQ.0.0D0) X4 = 1.0D-30 FA = SQRT(X1/X2)*SQRT(X3/X4) HA(37) = FA/X1* (X(1)+T* (1.0D0+X(2))) HA(38) = FA/X1* (X(2)+2.0D0*T*T-1.0D0+X(1)*T) HA(39) = -FA/X2* (X(3)+T* (1.0D0+X(4))) HA(40) = -FA/X2* (X(4)+2.0D0*T*T-1.0D0+X(3)*T) HA(41) = FA/X3* (X(5)+T* (1.0D0+X(6))) HA(42) = FA/X3* (X(6)+2.0D0*T*T-1.0D0+X(5)*T) HA(43) = -FA/X4* (X(7)+T* (1.0D0+X(8))) HA(44) = -FA/X4* (X(8)+2.0D0*T*T-1.0D0+X(7)*T) HA(45) = 0.0D0 FA = X(9)*FA DO 440 I = 1,8 GA(I) = HA(36+I)*X(9) 440 CONTINUE DO 460 J = 1,8 DO 450 I = 1,J HA((J-1)*J/2+I) = GA(I)*GA(J)/FA 450 CONTINUE 460 CONTINUE HA(1) = FA/X1 - HA(1) HA(2) = FA*T/X1 - HA(2) HA(3) = FA/X1 - HA(3) HA(6) = 3.0D0*HA(6) - FA/X2 HA(9) = 3.0D0*HA(9) - FA*T/X2 HA(10) = 3.0D0*HA(10) - FA/X2 HA(15) = FA/X3 - HA(15) HA(20) = FA*T/X3 - HA(20) HA(21) = FA/X3 - HA(21) HA(28) = 3.0D0*HA(28) - FA/X4 HA(35) = 3.0D0*HA(35) - FA*T/X4 HA(36) = 3.0D0*HA(36) - FA/X4 RETURN 470 DO 480 I = 1,N* (N+1)/2 HA(I) = 0.0D0 480 CONTINUE HA(1) = 2.0D0 HA(3) = 1.0D1 HA(6) = 1.2D1*X(3)**2 HA(10) = 6.0D0 HA(15) = 3.0D2*X(5)**4 HA(21) = 1.4D1 HA(27) = -4.0D0 HA(28) = 1.2D1*X(7)**2 GO TO (530,490,500,510,520) KA 490 HA(1) = HA(1) + 4.0D1 HA(3) = HA(3) + 3.6D2*X(2)**2 HA(10) = HA(10) + 8.0D1 RETURN 500 HA(6) = HA(6) + 2.0D2 RETURN 510 HA(3) = HA(3) + 2.0D1 HA(21) = HA(21) + 1.2D2 RETURN 520 HA(1) = HA(1) + 8.0D1 HA(2) = HA(2) - 3.0D1 HA(3) = HA(3) + 2.0D1 HA(6) = HA(6) + 4.0D1 530 RETURN 540 DO 550 I = 1,N* (N+1)/2 HA(I) = 0.0D0 550 CONTINUE HA(1) = 2.0D0 HA(2) = 1.0D0 HA(3) = 2.0D0 HA(6) = 2.0D0 HA(10) = 8.0D0 HA(15) = 2.0D0 HA(21) = 4.0D0 HA(28) = 1.0D1 HA(36) = 1.4D1 HA(45) = 4.0D0 HA(55) = 2.0D0 GO TO (610,560,570,580,590,610,610,600,610) KA 560 HA(1) = HA(1) + 6.0D1 HA(3) = HA(3) + 8.0D1 HA(6) = HA(6) + 4.0D1 RETURN 570 HA(1) = HA(1) + 1.0D2 HA(6) = HA(6) + 2.0D1 RETURN 580 HA(1) = HA(1) + 1.0D1 HA(3) = HA(3) + 4.0D1 HA(15) = HA(15) + 6.0D1 RETURN 590 HA(1) = HA(1) + 1.0D1 HA(2) = HA(2) - 2.0D1 HA(3) = HA(3) + 4.0D1 RETURN 600 HA(45) = HA(45) + 2.4D2 610 RETURN 620 DO 630 I = 1,N* (N+1)/2 HA(I) = 0.0D0 630 CONTINUE HA(1) = 2.0D0 HA(2) = 1.0D0 HA(3) = 2.0D0 HA(6) = 2.0D0 HA(10) = 8.0D0 HA(15) = 2.0D0 HA(21) = 4.0D0 HA(28) = 1.0D1 HA(36) = 1.4D1 HA(45) = 4.0D0 HA(55) = 2.0D0 HA(66) = 2.0D0 HA(78) = 2.0D1 HA(91) = 1.0D1 HA(105) = 8.0D0 HA(120) = 5.4D1 HA(136) = 1.2D1*X(16)**2 HA(153) = 2.0D0 HA(171) = 2.6D1 HA(190) = 2.0D0 HA(210) = 2.0D0 GO TO (610,560,570,580,590,610,610,600,610,610,640,650,660, + 670,680,690,700,710) KA 640 HA(1) = HA(1) + 2.0D1 RETURN 650 HA(91) = HA(91) + 1.0D2 RETURN 660 HA(91) = HA(91) + 6.0D1 RETURN 670 HA(1) = HA(1) + 2.8D2 RETURN 680 HA(3) = HA(3) + 3.0D2 RETURN 690 HA(1) = HA(1) + 1.0D2 HA(153) = HA(153) + 10.8D2*X(17)**2 RETURN 700 HA(1) = HA(1) + 2.0D1 RETURN 710 HA(1) = HA(1) + 1.4D2 HA(3) = HA(3) + 1.0D2 HA(190) = HA(190) + 2.0D1 RETURN 720 X1 = 0.0D0 DO 730 I = 1,N X3 = 1.0D0 X4 = X(I) IF (I.EQ.1) X3 = 1.0D-8 IF (I.EQ.4) X3 = 4.0D0 IF (I.EQ.2 .AND. KA.EQ.1) X4 = X(I) + 2.0D0 IF (I.EQ.2 .AND. KA.EQ.2) X4 = X(I) - 2.0D0 X1 = X1 + X3*X4**2 730 CONTINUE X2 = EXP(X1) L = 0 DO 750 I = 1,N X3 = 2.0D0 X4 = X(I) IF (I.EQ.1) X3 = 2.0D-8 IF (I.EQ.4) X3 = 8.0D0 IF (I.EQ.2 .AND. KA.EQ.1) X4 = X(I) + 2.0D0 IF (I.EQ.2 .AND. KA.EQ.2) X4 = X(I) - 2.0D0 DO 740 J = 1,I L = L + 1 X5 = 2.0D0 X6 = X(J) IF (J.EQ.1) X5 = 2.0D-8 IF (J.EQ.4) X5 = 8.0D0 IF (J.EQ.2 .AND. KA.EQ.1) X6 = X(J) + 2.0D0 IF (J.EQ.2 .AND. KA.EQ.2) X6 = X(J) - 2.0D0 HA(L) = X2*X3*X4*X5*X6 740 CONTINUE HA(L) = HA(L) + X2*X3 750 CONTINUE RETURN 760 DO 770 I = 1,N* (N+1)/2 HA(I) = 0.0D0 770 CONTINUE L = 0 DO 780 I = 1,N L = L + I X1 = 1.0D0*DBLE(I+KA-1) X2 = (X(I)-SIN(DBLE(2*I+KA-3)))**2 HA(L) = 2.0D0*X1*EXP(X2)* (1.0D0+2.0D0*X2) 780 CONTINUE RETURN 790 IF (KA.LE.2) THEN DO 800 I = 1,N* (N+1)/2 HA(I) = 0.0D0 800 CONTINUE IF (KA.EQ.1) THEN ELSE IF (KA.EQ.2) THEN HA(1) = -2.0D0 END IF ELSE T = DBLE(KA-2)/2.9D1 L = 0 DO 820 I = 1,N DO 810 J = 1,I L = L + 1 HA(L) = -2.0D0*T** (I+J-2) 810 CONTINUE 820 CONTINUE END IF RETURN 830 T = 1.0D-1*DBLE(KA-1) DO 840 I = 1,N* (N+1)/2 HA(I) = 0.0D0 840 CONTINUE X1 = EXP(-X(5)*T) X2 = EXP(-X(6)* (T-X(9))**2) X3 = EXP(-X(7)* (T-X(10))**2) X4 = EXP(-X(8)* (T-X(11))**2) HA(11) = X1*T HA(15) = -X1*X(1)*T**2 HA(17) = X2* (T-X(9))**2 HA(21) = -HA(17)*X(2)* (T-X(9))**2 HA(24) = X3* (T-X(10))**2 HA(28) = -HA(24)*X(3)* (T-X(10))**2 HA(32) = X4* (T-X(11))**2 HA(36) = -HA(32)*X(4)* (T-X(11))**2 HA(38) = -2.0D0*X2*X(6)* (T-X(9)) HA(42) = -2.0D0*X2*X(2)* (T-X(9)) + + 2.0D0*X2*X(2)*X(6)* (T-X(9))**3 HA(45) = 2.0D0*X2*X(2)*X(6) - 4.0D0*X2*X(2)* (X(6)* (T-X(9)))**2 HA(48) = -2.0D0*X3*X(7)* (T-X(10)) HA(52) = -2.0D0*X3*X(3)* (T-X(10)) + + 2.0D0*X3*X(3)*X(7)* (T-X(10))**3 HA(55) = 2.0D0*X3*X(3)*X(7) - 4.0D0*X3*X(3)* (X(7)* (T-X(10)))**2 HA(59) = -2.0D0*X4*X(8)* (T-X(11)) HA(63) = -2.0D0*X4*X(4)* (T-X(11)) + + 2.0D0*X4*X(4)*X(8)* (T-X(11))**3 HA(66) = 2.0D0*X4*X(4)*X(8) - 4.0D0*X4*X(4)* (X(8)* (T-X(11)))**2 RETURN END * SUBROUTINE TIUD19 ALL SYSTEMS 99/12/01 C PORTABILITY : ALL SYSTEMS C 94/12/01 VL : ORIGINAL VERSION * * PURPOSE : * INITIATION OF VARIABLES FOR NONSMOOTH OPTIMIZATION. * UNCONSTRAINED DENSE VERSION. * * PARAMETERS : * II N NUMBER OF VARIABLES. * RO X(N) VECTOR OF VARIABLES. * RO FMIN LOWER BOUND FOR VALUE OF THE OBJECTIVE FUNCTION. * RO XMAX MAXIMUM STEPSIZE. * II NEXT NUMBER OF THE TEST PROBLEM. * IO IERR ERROR INDICATOR. * SUBROUTINE TIUD19(N,X,FMIN,XMAX,NEXT,IERR) C .. Parameters .. DOUBLE PRECISION ETA9 PARAMETER (ETA9=1.0D60) C .. C .. Scalar Arguments .. DOUBLE PRECISION FMIN,XMAX INTEGER IERR,N,NEXT C .. C .. Array Arguments .. DOUBLE PRECISION X(N) C .. C .. Arrays in Common .. DOUBLE PRECISION Y(2700) C .. C .. Local Scalars .. DOUBLE PRECISION AI,AJ,AK INTEGER I,J,K,KK,L C .. C .. Local Arrays .. INTEGER AA(59),CC(95),PP(23) C .. C .. Intrinsic Functions .. INTRINSIC ABS,COS,DBLE,EXP,SIN C .. C .. Common blocks .. COMMON /EMPR19/Y C .. C .. Data statements .. DATA AA/5*0,2,3*1,3,1,2,1,1,2,1,4,1,2,2,3,2,1,0,1,0,2,1,0,7*1,0,1, + 2,1,0,0,2,1,0,1,1,2,0,0,1,5,10,2,4,3,3*6/ DATA PP/0,2,3,4,5,6,2,3,-1,4*2,1,1,5,4*1,2,3,2/ DATA CC/-16,4*0,2,2*-1,2*1,2,-2,0,-2,-9,0,-1,-2,2,1,2*0,2,0,-2,-4, + -1,-3,3,1,1,4,0,-4,1,0,-1,-2,4,1,0,2,0,-1,2*0,2*-1,5,1,-40, + -2,0,2*-4,-1,-40,-60,5,1,30,-20,-10,32,-10,-20,39,-6,-31,32, + -10,-6,10,-6,-10,32,-31,-6,39,-20,-10,32,-10,-20,30,4,8,10,6, + 2,-15,-27,-36,-18,-12/ C .. FMIN = 0.0D0 XMAX = 1.0D3 IERR = 0 IF (N.LT.2) GO TO 450 DO 10 I = 1,N X(I) = 0D0 10 CONTINUE GO TO (20,30,40,50,60,100,110,130,140, + 150,160,170,190,220,230,240,300,320, + 350,350,370,400,420,420,430) NEXT 20 N = 2 X(1) = -1.2D0 X(2) = 1.0D0 RETURN 30 N = 2 X(1) = -1.5D0 X(2) = 2.0D0 RETURN 40 N = 2 X(1) = 1.0D0 X(2) = -0.1D0 RETURN 50 N = 2 X(1) = 2.0D0 X(2) = 2.0D0 RETURN 60 N = 2 70 FMIN = -ETA9 80 DO 90 I = 1,N X(I) = 1.0D0 90 CONTINUE RETURN 100 N = 2 X(1) = -1.0D0 X(2) = 5.0D0 RETURN 110 N = 2 X(1) = -0.5D0 X(2) = -0.5D0 120 FMIN = -ETA9 RETURN 130 N = 2 X(1) = 0.8D0 X(2) = 0.6D0 GO TO 120 140 N = 2 X(1) = -1.0D0 X(2) = -1.0D0 GO TO 120 150 N = 2 X(1) = 3.0D0 X(2) = 2.0D0 GO TO 120 160 IF (N.LT.4) GO TO 450 N = 4 GO TO 120 170 IF (N.LT.5) GO TO 450 N = 5 X(5) = 1.0D0 DO 180 I = 1,59 Y(I) = AA(I) 180 CONTINUE Y(57) = 1.7D0 Y(58) = 2.5D0 Y(60) = 3.5D0 RETURN 190 IF (N.LT.5) GO TO 450 N = 5 X(5) = 1.0D0 FMIN = -ETA9 200 DO 210 I = 1,95 Y(I) = CC(I) 210 CONTINUE Y(3) = -3.5D0 Y(45) = -2.8D0 Y(53) = -.25D0 RETURN 220 IF (N.LT.5) GO TO 450 N = 5 X(1) = -2.0D0 X(2) = 1.5D0 X(3) = 2.0D0 X(4) = -1.0D0 X(5) = -1.0D0 FMIN = -ETA9 XMAX = 1.0D0 RETURN 230 IF (N.LT.6) GO TO 450 N = 6 XMAX = 2D0 X(1) = 2.0D0 X(2) = 2.0D0 X(3) = 7.0D0 X(5) = -2.0D0 X(6) = 1.0D0 RETURN 240 IF (N.LT.10) GO TO 450 N = 10 KK = 0 DO 290 K = 1,5 AK = DBLE(K) DO 260 I = 1,N AI = DBLE(I) DO 250 J = I,N AJ = DBLE(J) Y(KK+ (I-1)*N+J) = EXP(AI/AJ)*COS(AI*AJ)*SIN(AK) Y(KK+ (J-1)*N+I) = Y(KK+ (I-1)*N+J) 250 CONTINUE 260 CONTINUE DO 280 I = 1,N AI = DBLE(I) Y(100+KK+I) = EXP(AI/AK)*SIN(AI*AK) L = KK + (I-1)*N + I Y(L) = ABS(SIN(AK))*AI/DBLE(N) DO 270 J = 1,N IF (J.NE.I) Y(L) = Y(L) + ABS(Y(KK+ (I-1)*N+J)) 270 CONTINUE 280 CONTINUE KK = KK + 110 290 CONTINUE GO TO 70 300 IF (N.LT.10) GO TO 450 N = 10 XMAX = 1.0D1 DO 310 I = 1,N X(I) = -0.1D0 310 CONTINUE RETURN 320 IF (N.LT.12) GO TO 450 N = 12 DO 330 I = 1,23 Y(I) = PP(I) 330 CONTINUE Y(10) = -0.5D0 X(1) = 2.0D0/3.0D0 X(7) = 5.0D0/3.0D0 DO 340 I = 2,5 X(I) = (X(I-1)+Y(I)+Y(I+1))/3.0D0 X(I+6) = (X(I+5)+Y(I+6)+Y(I+7))/3.0D0 340 CONTINUE X(6) = (X(5)+11.5D0)/3.0D0 X(12) = (X(11)+1.0D0)/3.0D0 RETURN 350 IF (N.LT.20) GO TO 450 N = 20 IF (NEXT.EQ.19) XMAX = 5.0D0 IF (NEXT.EQ.20) XMAX = 1.0D1 DO 360 I = 1,10 X(I) = DBLE(I) X(I+10) = DBLE(-I-10) 360 CONTINUE RETURN 370 IF (N.LT.48) GO TO 450 N = 48 OPEN (5,FILE='test19.dat') READ (5,FMT=*) ((Y(N* (I-2)+J),J=I,N),I=2,N), (Y(N*N+I),I=1,N), + (Y(N*N+N+I),I=1,N) DO 390 I = 1,N Y(N* (I-1)+I) = 1.0D5 DO 380 J = 1,I - 1 Y(N* (I-1)+J) = Y(N* (J-1)+I) 380 CONTINUE 390 CONTINUE CLOSE (5) GO TO 120 400 IF (N.LT.50) GO TO 450 N = 50 XMAX = 1.0D1 DO 410 I = 1,N X(I) = DBLE(I) - 25.5D0 410 CONTINUE RETURN 420 IF (N.LT.30) GO TO 450 IF (N.GE.50) N = 50 IF (N.LT.50) N = 30 IF (NEXT.EQ.23) XMAX = 5.0D0 GO TO 80 430 IF (N.LT.15) GO TO 450 N = 15 DO 440 I = 1,N X(I) = 1.0D-4 440 CONTINUE X(12) = 6.0D1 GO TO 200 450 IERR = 1 RETURN END * SUBROUTINE TFFU19 ALL SYSTEMS 99/12/01 C PORTABILITY : ALL SYSTEMS C 94/12/01 RA : ORIGINAL VERSION * * PURPOSE : * VALUE OF THE NONSMOOTH OBJECTIVE FUNCTION. * * PARAMETERS : * II N NUMBER OF VARIABLES. * RI X(N) VECTOR OF VARIABLES. * RO F VALUE OF THE OBJECTIVE FUNCTION. * II NEXT NUMBER OF THE TEST PROBLEM. * SUBROUTINE TFFU19(N,X,F,NEXT) C .. Parameters .. DOUBLE PRECISION ETA9 PARAMETER (ETA9=1.0D60) C .. C .. Scalar Arguments .. DOUBLE PRECISION F INTEGER N,NEXT C .. C .. Array Arguments .. DOUBLE PRECISION X(N) C .. C .. Arrays in Common .. DOUBLE PRECISION Y(2700) C .. C .. Local Scalars .. DOUBLE PRECISION AI,AJ,F1,F2,F3,F4,T,Z INTEGER I,J,K,KK,LL C .. C .. Intrinsic Functions .. INTRINSIC ABS,COS,DBLE,EXP,MAX,SIN,SQRT C .. C .. Common blocks .. COMMON /EMPR19/Y C .. F = 0.0D0 GO TO (10,20,30,40,50,60,70,80,90, + 100,110,120,160,210,220,240,300,370, + 400,420,440,480,500,540,570) NEXT 10 F = 100.0D0* (X(2)-X(1)**2)**2 + (1.0D0-X(1))**2 RETURN 20 T = X(1)**2 + (X(2)-1.0D0)**2 - 1.0D0 F = X(2) + ABS(T) RETURN 30 F1 = X(1)**2 + X(2)**4 F2 = (2.0D0-X(1))**2 + (2.0D0-X(2))**2 F3 = 2.0D0*EXP(-X(1)+X(2)) F = MAX(F1,F2,F3) RETURN 40 F1 = X(1)**4 + X(2)**2 F2 = (2.0D0-X(1))**2 + (2.0D0-X(2))**2 F3 = 2.0D0*EXP(-X(1)+X(2)) F = MAX(F1,F2,F3) RETURN 50 F1 = 5.0D0*X(1) + X(2) F2 = -5.0D0*X(1) + X(2) F3 = X(1)**2 + X(2)**2 + 4.0D0*X(2) F = MAX(F1,F2,F3) RETURN 60 F1 = X(1)**2 + X(2)**2 F2 = F1 + 10.0D0* (-4.0D0*X(1)-X(2)+4.0D0) F3 = F1 + 10.0D0* (-X(1)-2.0D0*X(2)+6.0D0) F = MAX(F1,F2,F3) RETURN 70 F1 = -X(1) - X(2) F2 = F1 + (X(1)**2+X(2)**2-1.0D0) F = MAX(F1,F2) RETURN 80 F1 = X(1)**2 + X(2)**2 - 1.0D0 F2 = 0.0D0 F = MAX(F1,F2) F = 20.0D0*F - X(1) RETURN 90 F1 = X(1)**2 + X(2)**2 - 1.0D0 IF (F1.LT.0.0D0) F1 = -F1 F = -X(1) + 2.0D0* (X(1)**2+X(2)**2-1.0D0) + 1.75D0*F1 RETURN 100 IF (X(1).GT.ABS(X(2))) THEN F = 5.0D0*SQRT(9.0D0*X(1)**2+16.0D0*X(2)**2) ELSE IF ((X(1).GT.0.0D0) .AND. (X(1).LE.ABS(X(2)))) THEN F = 9.0D0*X(1) + 16.0D0*ABS(X(2)) ELSE IF (X(1).LE.0.0D0) THEN F = 9.0D0*X(1) + 16.0D0*ABS(X(2)) - X(1)**9 END IF RETURN 110 F = X(1)**2 + X(2)**2 + X(3)**2 F1 = F + X(3)**2 + X(4)**2 - 5.0D0* (X(1)+X(2)) - 21.0D0*X(3) + + 7.0D0*X(4) F2 = F + X(4)**2 + X(1) - X(2) + X(3) - X(4) - 8.0D0 F3 = F + X(2)**2 + 2.0D0*X(4)**2 - X(1) - X(4) - 10.0D0 F4 = F + 2.0D0*X(1) - X(2) - X(4) - 5.0D0 F = F1 + 10.0D0*MAX(0.0D0,F2,F3,F4) RETURN 120 F = 0.0D0 DO 130 J = 1,5 F = F + (X(J)-Y(J))**2 130 CONTINUE F = F*Y(50+1) DO 150 I = 2,10 F1 = 0.0D0 DO 140 J = 1,5 F1 = F1 + (X(J)-Y(5* (I-1)+J))**2 140 CONTINUE F1 = F1*Y(50+I) F = MAX(F,F1) 150 CONTINUE RETURN 160 F = 0.0D0 DO 180 I = 1,10 T = Y(50+I) DO 170 J = 1,5 T = T - Y(I+J*10-10)*X(J) 170 CONTINUE F = MAX(F,T) 180 CONTINUE F = F*5D1 DO 200 J = 1,5 T = 0D0 DO 190 I = 1,5 T = T + Y(55+I+J*5)*X(I) 190 CONTINUE F = F + Y(85+J)*X(J)**3 + Y(90+J)*X(J) + T*X(J) 200 CONTINUE RETURN 210 F1 = X(1)*X(2)*X(3)*X(4)*X(5) F2 = ABS(X(1)**2+X(2)**2+X(3)**2+X(4)**2+X(5)**2-1.0D1) F2 = F2 + ABS(X(2)*X(3)-5.0D0*X(4)*X(5)) F2 = F2 + ABS(X(1)**3+X(2)**3+1.0D0) F = F1 + 1.0D1*F2 RETURN 220 F = 0.0D0 DO 230 I = 1,51 T = DBLE(I-1)/10.0D0 Z = 0.5D0*EXP(-T) - EXP(-T*2.0D0) + 0.5D0*EXP(-T*3.0D0) + + 1.5D0*EXP(-T*1.5D0)*SIN(7.0D0*T) + + EXP(-T*2.5D0)*SIN(5.0D0*T) F1 = EXP(-X(2)*T) F2 = EXP(-X(6)*T) F3 = COS(X(3)*T+X(4)) F = F + ABS(X(1)*F1*F3+X(5)*F2-Z) 230 CONTINUE RETURN 240 F = 0.0D0 K = 1 DO 260 I = 1,N F = F - Y(100+I)*X(I) DO 250 J = 1,N F = F + Y((I-1)*N+J)*X(I)*X(J) 250 CONTINUE 260 CONTINUE KK = 110 DO 290 K = 2,5 F1 = 0.0D0 DO 280 I = 1,N F1 = F1 - Y(KK+100+I)*X(I) DO 270 J = 1,N F1 = F1 + Y(KK+ (I-1)*N+J)*X(I)*X(J) 270 CONTINUE 280 CONTINUE F = MAX(F,F1) KK = KK + 110 290 CONTINUE RETURN 300 F1 = 0.0D0 DO 310 I = 1,10 F1 = F1 + X(I)**2 310 CONTINUE F4 = F1 - 0.25D0 F1 = 1.0D-3*F4*F4 DO 320 I = 1,10 F1 = F1 + (X(I)-1.0D0)**2 320 CONTINUE F2 = 0.0D0 DO 350 I = 2,30 AI = DBLE(I-1)/29D0 F = 0.0D0 DO 330 J = 1,10 F = F + X(J)*AI** (J-1) 330 CONTINUE F = -F*F - 1.0D0 DO 340 J = 2,10 AJ = DBLE(J-1) F = F + X(J)*AJ*AI** (J-2) 340 CONTINUE F2 = F2 + F*F 350 CONTINUE F2 = F2 + X(1)**2 + (X(2)-X(1)**2-1.0D0)**2 F3 = 0.0D0 DO 360 I = 2,10 F3 = F3 + 100.0D0* (X(I)-X(I-1)**2)**2 + (1.0D0-X(I))**2 360 CONTINUE F = MAX(F1,F2,F3) RETURN 370 F = SQRT(X(1)**2+X(7)**2) + SQRT((5.5D0-X(6))**2+ + (1.0D0+X(12))**2) DO 380 J = 1,6 F = F + Y(12+J)*SQRT((Y(J)-X(J))**2+ (Y(6+J)-X(6+J))**2) 380 CONTINUE DO 390 J = 1,5 F = F + Y(18+J)*SQRT((X(J)-X(J+1))**2+ (X(J+6)-X(J+7))**2) 390 CONTINUE RETURN 400 F = X(1)**2 DO 410 I = 2,20 F1 = X(I)**2 F = MAX(F,F1) 410 CONTINUE RETURN 420 F = ABS(X(1)) DO 430 I = 2,20 F1 = ABS(X(I)) F = MAX(F,F1) 430 CONTINUE RETURN 440 N = 48 F = 0.0D0 KK = N*N LL = N*N + N DO 450 I = 1,N F = F + Y(LL+I)*X(I) 450 CONTINUE DO 470 J = 1,N Z = ETA9 DO 460 I = 1,N T = Y((I-1)*N+J) - X(I) IF (T.GE.Z) GO TO 460 Z = T K = I 460 CONTINUE F = F + Y(KK+J)*Z 470 CONTINUE F = -F RETURN 480 F1 = 0.0D0 F = -ETA9 DO 490 I = 1,50 F2 = X(I) F1 = F1 + F2 F = MAX(F,F2) 490 CONTINUE F = 5.0D1*F - F1 RETURN 500 F = 0.0D0 DO 510 J = 1,N F = F + X(J)/DBLE(1+J-1) 510 CONTINUE F = ABS(F) DO 530 I = 2,N F1 = 0.0D0 DO 520 J = 1,N F1 = F1 + X(J)/DBLE(I+J-1) 520 CONTINUE F1 = ABS(F1) F = MAX(F1,F) 530 CONTINUE RETURN 540 F = 0.0D0 DO 560 J = 1,N F1 = 0.0D0 DO 550 I = 1,N F1 = F1 + X(I)/DBLE(I+J-1) 550 CONTINUE F1 = ABS(F1) F = F + F1 560 CONTINUE RETURN 570 F1 = 0.0D0 DO 580 J = 1,5 F1 = F1 + Y(85+J)*X(J)**3 580 CONTINUE F = ABS(F1+F1) DO 600 J = 1,5 T = 0.0D0 DO 590 I = 1,5 T = T + Y(55+I+J*5)*X(I) 590 CONTINUE F = F + T*X(J) 600 CONTINUE DO 610 J = 6,15 F = F - Y(45+J)*X(J) 610 CONTINUE DO 630 J = 1,5 T = -3.0D0*Y(85+J)*X(J)*X(J) - Y(90+J) DO 620 I = 1,15 IF (I.LE.5) T = T - 2.0D0*Y(55+I+J*5)*X(I) IF (I.GT.5) T = T + Y(I+J*10-15)*X(I) 620 CONTINUE IF (T.GT.0.0D0) F = F + 1.0D2*T 630 CONTINUE DO 640 I = 1,15 IF (X(I).LT.0.0D0) F = F - 1.0D2*X(I) 640 CONTINUE RETURN END * SUBROUTINE TFGU19 ALL SYSTEMS 99/12/01 C PORTABILITY : ALL SYSTEMS C 94/12/01 VL : ORIGINAL VERSION * * PURPOSE : * GRADIENT OF THE NONSMOOTH OBJECTIVE FUNCTION. * * PARAMETERS : * II N NUMBER OF VARIABLES. * RI X(N) VECTOR OF VARIABLES. * RO G(N) GRADIENT OF THE OBJECTIVE FUNCTION. * II NEXT NUMBER OF THE TEST PROBLEM. * SUBROUTINE TFGU19(N,X,G,NEXT) C .. Parameters .. DOUBLE PRECISION ETA9 PARAMETER (ETA9=1.0D60) C .. C .. Scalar Arguments .. INTEGER N,NEXT C .. C .. Array Arguments .. DOUBLE PRECISION G(N),X(N) C .. C .. Arrays in Common .. DOUBLE PRECISION Y(2700) C .. C .. Local Scalars .. DOUBLE PRECISION AI,AJ,F,F1,F2,F3,F4,T INTEGER I,J,K,KK,L C .. C .. Intrinsic Functions .. INTRINSIC ABS,COS,DBLE,EXP,MAX,SIGN,SIN,SQRT C .. C .. Common blocks .. COMMON /EMPR19/Y C .. DO 10 I = 1,N G(I) = 0.0D0 10 CONTINUE GO TO (20,30,40,40,50,60,70,80,90, + 100,110,170,210,260,280,300,360,490, + 520,540,560,600,620,660,700) NEXT 20 G(2) = 200.0D0* (X(2)-X(1)**2) G(1) = 2.0D0*X(1)* (1.0D0-G(2)) - 2.0D0 RETURN 30 T = X(1)**2 + (X(2)-1.0D0)**2 - 1.0D0 F = SIGN(2.0D0,T) G(1) = F*X(1) G(2) = F* (X(2)-1.0D0) + 1.0D0 RETURN 40 I = NEXT - 2 J = 5 - NEXT F1 = X(I)**2 + X(J)**4 F2 = (2.0D0-X(1))**2 + (2.0D0-X(2))**2 F3 = 2.0D0*EXP(-X(1)+X(2)) IF ((F1.GE.F2) .AND. (F1.GE.F3)) THEN G(I) = 2.0D0*X(I) G(J) = 4.0D0*X(J)**3 ELSE IF ((F2.GE.F1) .AND. (F2.GE.F3)) THEN G(1) = -2.0D0* (2.0D0-X(1)) G(2) = -2.0D0* (2.0D0-X(2)) ELSE G(2) = 2.0D0*EXP(-X(1)+X(2)) G(1) = -G(2) END IF RETURN 50 F1 = 5.0D0*X(1) + X(2) F2 = -5.0D0*X(1) + X(2) F3 = X(1)**2 + X(2)**2 + 4.0D0*X(2) G(2) = 1.0D0 IF ((F1.GE.F2) .AND. (F1.GE.F3)) THEN G(1) = 5.0D0 ELSE IF ((F2.GE.F1) .AND. (F2.GE.F3)) THEN G(1) = -5.0D0 ELSE G(1) = 2.0D0*X(1) G(2) = 2.0D0*X(2) + 4.0D0 END IF RETURN 60 F1 = X(1)**2 + X(2)**2 F2 = F1 + 10.0D0* (-4.0D0*X(1)-X(2)+4.0D0) F3 = F1 + 10.0D0* (-X(1)-2.0D0*X(2)+6.0D0) G(1) = 2.0D0*X(1) G(2) = 2.0D0*X(2) IF ((F1.GE.F2) .AND. (F1.GE.F3)) THEN ELSE IF ((F2.GE.F1) .AND. (F2.GE.F3)) THEN G(1) = G(1) - 40.0D0 G(2) = G(2) - 10.0D0 ELSE G(1) = G(1) - 10.0D0 G(2) = G(2) - 20.0D0 END IF RETURN 70 F1 = -X(1) - X(2) F2 = F1 + (X(1)**2+X(2)**2-1.0D0) IF (F1.GE.F2) THEN G(1) = -1.0D0 G(2) = -1.0D0 ELSE G(1) = -1.0D0 + 2.0D0*X(1) G(2) = -1.0D0 + 2.0D0*X(2) END IF RETURN 80 F1 = X(1)**2 + X(2)**2 - 1.0D0 G(1) = -1.0D0 IF (F1.GE.0.0D0) THEN G(1) = 40.0D0*X(1) - 1.0D0 G(2) = 40.0D0*X(2) END IF RETURN 90 F1 = SIGN(3.5D0,X(1)**2+X(2)**2-1.0D0) + 4.0D0 G(1) = F1*X(1) - 1.0D0 G(2) = F1*X(2) RETURN 100 IF (X(1).GT.ABS(X(2))) THEN G(1) = 45.0D0*X(1)/SQRT(9.0D0*X(1)**2+16.0D0*X(2)**2) G(2) = 80.0D0*X(2)/SQRT(9.0D0*X(1)**2+16.0D0*X(2)**2) ELSE G(1) = 9.0D0 IF (X(1).LT.0.0D0) G(1) = 9.0D0 - 9.0D0*X(1)**8 G(2) = SIGN(16.0D0,X(2)) END IF RETURN 110 F = X(1)**2 + X(2)**2 + X(3)**2 F2 = F + X(4)**2 + X(1) - X(2) + X(3) - X(4) - 8.0D0 F3 = F + X(2)**2 + 2.0D0*X(4)**2 - X(1) - X(4) - 10.0D0 F4 = F + 2.0D0*X(1) - X(2) - X(4) - 5.0D0 L = 1 IF (F2.GT.0.0D0) L = 2 IF (F3.GT.MAX(F2,0.0D0)) L = 3 IF (F4.GT.MAX(F2,F3,0.0D0)) L = 4 GO TO (120,130,140,150) L 120 G(1) = 2.0D0*X(1) - 5.0D0 G(2) = 2.0D0*X(2) - 5.0D0 G(3) = 4.0D0*X(3) - 21.0D0 G(4) = 2.0D0*X(4) + 7.0D0 RETURN 130 G(1) = 22.0D0*X(1) + 5.0D0 G(2) = 22.0D0*X(2) - 15.0D0 G(3) = 24.0D0*X(3) - 11.0D0 G(4) = 22.0D0*X(4) - 3.0D0 RETURN 140 G(1) = 22.0D0*X(1) - 15.0D0 G(2) = 42.0D0*X(2) - 5.0D0 G(4) = 42.0D0*X(4) - 3.0D0 GO TO 160 150 G(1) = 22.0D0*X(1) + 15.0D0 G(2) = 22.0D0*X(2) - 15.0D0 G(4) = 2.0D0*X(4) - 3.0D0 160 G(3) = 24.0D0*X(3) - 21.0D0 RETURN 170 F = -ETA9 DO 190 I = 1,10 F1 = 0.0D0 DO 180 J = 1,5 F1 = F1 + (X(J)-Y(5* (I-1)+J))**2 180 CONTINUE F1 = F1*Y(50+I) IF (F.LT.F1) K = I F = MAX(F,F1) 190 CONTINUE DO 200 J = 1,5 G(J) = 2.0D0*Y(50+K)* (X(J)-Y(5* (K-1)+J)) 200 CONTINUE RETURN 210 F1 = 0.0D0 DO 230 I = 1,10 T = Y(50+I) DO 220 J = 1,5 T = T - Y(I+J*10-10)*X(J) 220 CONTINUE IF (T.GT.F1) K = I F1 = MAX(F1,T) 230 CONTINUE DO 250 J = 1,5 T = 0.0D0 DO 240 I = 1,5 T = T + Y(55+I+J*5)*X(I) 240 CONTINUE G(J) = 3.0D0*Y(85+J)*X(J)*X(J) + T + T + Y(90+J) IF (F1.GT.0.0D0) G(J) = G(J) - 5.0D1*Y(K+J*10-10) 250 CONTINUE RETURN 260 G(1) = X(2)*X(3)*X(4)*X(5) G(2) = X(1)*X(3)*X(4)*X(5) G(3) = X(1)*X(2)*X(4)*X(5) G(4) = X(1)*X(2)*X(3)*X(5) G(5) = X(1)*X(2)*X(3)*X(4) F1 = X(1)**2 + X(2)**2 + X(3)**2 + X(4)**2 + X(5)**2 - 1.0D1 F4 = 1.0D0 IF (F1.LT.0.0D0) F4 = -F4 DO 270 I = 1,5 G(I) = G(I) + 2.0D1*F4*X(I) 270 CONTINUE F2 = X(2)*X(3) - 5.0D0*X(4)*X(5) F4 = 1.0D0 IF (F2.LT.0.0D0) F4 = -F4 G(2) = G(2) + 1.0D1*F4*X(3) G(3) = G(3) + 1.0D1*F4*X(2) G(4) = G(4) - 5.0D1*F4*X(5) G(5) = G(5) - 5.0D1*F4*X(4) F3 = X(1)**3 + X(2)**3 + 1.0D0 F4 = 1.0D0 IF (F3.LT.0.0D0) F4 = -F4 G(1) = G(1) + 3.0D1*F4*X(1)**2 G(2) = G(2) + 3.0D1*F4*X(2)**2 RETURN 280 DO 290 I = 1,51 T = DBLE(I-1)/10.0D0 F = 0.5D0*EXP(-T) - EXP(-T*2.0D0) + 0.5D0*EXP(-T*3.0D0) + + 1.5D0*EXP(-T*1.5D0)*SIN(7.0D0*T) + + EXP(-T*2.5D0)*SIN(5.0D0*T) F1 = EXP(-X(2)*T) F2 = EXP(-X(6)*T) F3 = COS(X(3)*T+X(4)) F4 = SIN(X(3)*T+X(4)) AI = SIGN(1.0D0,X(1)*F1*F3+X(5)*F2-F) G(1) = G(1) + AI*F1*F3 G(2) = G(2) - AI*F1*F3*X(1)*T G(3) = G(3) - AI*F1*F4*X(1)*T G(4) = G(4) - AI*F1*F4*X(1) G(5) = G(5) + AI*F2 G(6) = G(6) - AI*F2*X(5)*T 290 CONTINUE RETURN 300 F = -ETA9 L = 1 KK = 0 DO 330 K = 1,5 F1 = 0.0D0 DO 320 I = 1,N F1 = F1 - Y(KK+100+I)*X(I) DO 310 J = 1,N F1 = F1 + Y(KK+ (I-1)*N+J)*X(I)*X(J) 310 CONTINUE 320 CONTINUE IF (F.LT.F1) L = K F = MAX(F,F1) KK = KK + 110 330 CONTINUE DO 350 I = 1,N G(I) = -Y((L-1)*110+100+I) DO 340 J = 1,N G(I) = G(I) + 2.0D0*Y((L-1)*110+ (I-1)*N+J)*X(J) 340 CONTINUE 350 CONTINUE RETURN 360 F1 = 0.0D0 DO 370 I = 1,10 F1 = F1 + X(I)**2 370 CONTINUE F4 = F1 - 0.25D0 F1 = 1.0D-3*F4*F4 DO 380 I = 1,10 F1 = F1 + (X(I)-1.0D0)**2 380 CONTINUE F2 = 0.0D0 DO 410 I = 2,30 AI = DBLE(I-1)/29D0 F = 0.0D0 DO 390 J = 1,10 F = F + X(J)*AI** (J-1) 390 CONTINUE F = -F*F - 1.0D0 DO 400 J = 2,10 AJ = DBLE(J-1) F = F + X(J)*AJ*AI** (J-2) 400 CONTINUE F2 = F2 + F*F 410 CONTINUE F2 = F2 + X(1)**2 + (X(2)-X(1)**2-1.0D0)**2 F3 = 0.0D0 DO 420 I = 2,10 F3 = F3 + 100.0D0* (X(I)-X(I-1)**2)**2 + (1.0D0-X(I))**2 420 CONTINUE IF ((F1.GE.F2) .AND. (F1.GE.F3)) THEN DO 430 I = 1,10 G(I) = 2.0D0*X(I) - 2.0D0 + 4.0D-3*X(I)*F4 430 CONTINUE ELSE IF ((F2.GE.F1) .AND. (F2.GE.F3)) THEN DO 470 J = 1,10 DO 460 I = 2,30 AI = DBLE(I-1)/29D0 F = 0.0D0 DO 440 K = 1,10 F = F - X(K)*AI** (K-1) 440 CONTINUE T = 2.0D0*F*AI** (J-1) IF (J.GE.2) T = T + (J-1)*AI** (J-2) F = -F*F - 1.0D0 DO 450 K = 2,10 F = F + X(K)* (K-1)*AI** (K-2) 450 CONTINUE G(J) = G(J) + 2.0D0*F*T 460 CONTINUE 470 CONTINUE G(1) = G(1) + 2.0D0*X(1) - 4.0D0*X(1)* (X(2)-X(1)**2-1.0D0) G(2) = G(2) + 2.0D0* (X(2)-X(1)**2-1.0D0) ELSE DO 480 I = 1,10 G(I) = 0.0D0 IF (I.GE.2) G(I) = G(I) + 2.0D2* (X(I)-X(I-1)**2) - + 2.0D0* (1.0D0-X(I)) IF (I.LE.9) G(I) = G(I) - 4.0D2*X(I)* (X(I+1)-X(I)**2) 480 CONTINUE END IF RETURN 490 G(1) = X(1)/SQRT(X(1)**2+X(7)**2) G(7) = X(7)/SQRT(X(1)**2+X(7)**2) T = SQRT((5.5D0-X(6))**2+ (1.0D0+X(12))**2) G(6) = - (5.5D0-X(6))/T G(12) = (1.0D0+X(12))/T DO 500 J = 1,6 T = SQRT((Y(J)-X(J))**2+ (Y(6+J)-X(6+J))**2) G(J) = G(J) - Y(12+J)* (Y(J)-X(J))/T G(6+J) = G(6+J) - Y(12+J)* (Y(J+6)-X(J+6))/T 500 CONTINUE DO 510 J = 1,5 T = SQRT((X(J)-X(J+1))**2+ (X(J+6)-X(J+7))**2) G(J) = G(J) + Y(18+J)* (X(J)-X(J+1))/T G(J+1) = G(J+1) - Y(18+J)* (X(J)-X(J+1))/T G(J+6) = G(J+6) + Y(18+J)* (X(J+6)-X(J+7))/T G(J+7) = G(J+7) - Y(18+J)* (X(J+6)-X(J+7))/T 510 CONTINUE RETURN 520 F = X(1)**2 K = 1 DO 530 I = 2,20 F1 = X(I)**2 IF (F.LT.F1) K = I F = MAX(F,F1) 530 CONTINUE G(K) = 2.0D0*X(K) RETURN 540 F = ABS(X(1)) K = 1 DO 550 I = 2,20 F1 = ABS(X(I)) IF (F.LT.F1) K = I F = MAX(F,F1) 550 CONTINUE G(K) = SIGN(1.0D0,X(K)) RETURN 560 KK = N*N DO 570 I = 1,N G(I) = -Y(KK+N+I) 570 CONTINUE DO 590 J = 1,N F = ETA9 DO 580 I = 1,N T = Y((I-1)*N+J) - X(I) IF (T.GE.F) GO TO 580 F = T K = I 580 CONTINUE G(K) = G(K) + Y(KK+J) 590 CONTINUE RETURN 600 F = -ETA9 DO 610 I = 1,50 F2 = X(I) IF (F.LT.F2) K = I F = MAX(F,F2) G(I) = -1.0D0 610 CONTINUE G(K) = G(K) + 5D1 RETURN 620 F1 = -ETA9 DO 640 I = 1,N F = 0.0D0 DO 630 J = 1,N F = F + X(J)/DBLE(I+J-1) 630 CONTINUE IF (F1.GE.ABS(F)) GO TO 640 K = I AI = SIGN(1D0,F) F1 = ABS(F) 640 CONTINUE DO 650 J = 1,N G(J) = AI/DBLE(K+J-1) 650 CONTINUE RETURN 660 DO 690 J = 1,N F1 = 0.0D0 DO 670 I = 1,N F1 = F1 + X(I)/DBLE(I+J-1) 670 CONTINUE AJ = SIGN(1.0D0,F1) DO 680 I = 1,N G(I) = G(I) + AJ/DBLE(I+J-1) 680 CONTINUE 690 CONTINUE RETURN 700 F1 = 0.0D0 DO 710 J = 1,5 F1 = F1 + Y(85+J)*X(J)**3 710 CONTINUE DO 730 J = 1,5 T = 0.0D0 DO 720 I = 1,5 T = T + Y(55+I+J*5)*X(I) 720 CONTINUE G(J) = SIGN(6D0,F1)*Y(85+J)*X(J)*X(J) + T + T 730 CONTINUE DO 740 J = 6,15 G(J) = -Y(45+J) 740 CONTINUE DO 770 J = 1,5 T = -3.0D0*Y(85+J)*X(J)*X(J) - Y(90+J) DO 750 I = 1,15 IF (I.LE.5) T = T - 2.0D0*Y(55+I+J*5)*X(I) IF (I.GT.5) T = T + Y(I+J*10-15)*X(I) 750 CONTINUE IF (T.LE.0.0D0) GO TO 770 G(J) = G(J) - 6.0D2*Y(85+J)*X(J) DO 760 I = 1,15 IF (I.LE.5) G(I) = G(I) - 2.0D2*Y(55+I+J*5) IF (I.GT.5) G(I) = G(I) + 1.0D2*Y(I+J*10-15) 760 CONTINUE 770 CONTINUE DO 780 I = 1,15 IF (X(I).LT.0.0D0) G(I) = G(I) - 1.0D2 780 CONTINUE RETURN END * SUBROUTINE TFHD19 ALL SYSTEMS 99/12/01 C PORTABILITY : ALL SYSTEMS C 95/12/01 VL : ORIGINAL VERSION * * PURPOSE : * HESSIAN MATRIX OF THE NONSMOOTH OBJECTIVE FUNCTION. * DENSE VERSION. * * PARAMETERS : * II N NUMBER OF VARIABLES. * RI X(N) VECTOR OF VARIABLES. * RO H(N*(N+1)/2) HESSIAN MATRIX OF THE OBJECTIVE FUNCTION. * II NEXT NUMBER OF THE TEST PROBLEM. * SUBROUTINE TFHD19(N,X,H,NEXT) C .. Parameters .. DOUBLE PRECISION ETA9 PARAMETER (ETA9=1.0D60) C .. C .. Scalar Arguments .. INTEGER N,NEXT C .. C .. Array Arguments .. DOUBLE PRECISION H(N* (N+1)/2),X(N) C .. C .. Arrays in Common .. DOUBLE PRECISION Y(2700) C .. C .. Local Scalars .. DOUBLE PRECISION AI,AJ,F,F1,F2,F3,F4,T INTEGER I,J,K,KK,L C .. C .. Intrinsic Functions .. INTRINSIC ABS,COS,DBLE,EXP,MAX,SIGN,SIN C .. C .. Common blocks .. COMMON /EMPR19/Y C .. C .. Statement Functions .. INTEGER IN C .. C .. Statement Function definitions .. IN(I,J) = (J-1)*J/2 + I C .. DO 10 I = 1,N* (N+1)/2 H(I) = 0.0D0 10 CONTINUE GO TO (20,30,40,40,50,60,70,80,90, + 100,110,180,220,260,280,300,360,510, + 540,560,570,580,590,600,610) NEXT 20 H(1) = 1200D0*X(1)**2 - 400D0*X(2) + 2.0D0 H(2) = -400D0*X(1) H(3) = 200D0 RETURN 30 T = X(1)**2 + (X(2)-1.0D0)**2 - 1.0D0 F = SIGN(2.0D0,T) H(1) = F H(3) = F RETURN 40 I = NEXT - 2 J = 5 - NEXT F1 = X(I)**2 + X(J)**4 F2 = (2.0D0-X(1))**2 + (2.0D0-X(2))**2 F3 = 2.0D0*EXP(-X(1)+X(2)) IF ((F1.GE.F2) .AND. (F1.GE.F3)) THEN H(NEXT*2-5) = 2.0D0 H(9-NEXT*2) = 12.0D0*X(J)**2 ELSE IF ((F2.GE.F1) .AND. (F2.GE.F3)) THEN H(1) = 2.0D0 H(3) = 2.0D0 ELSE H(1) = 2.0D0*EXP(X(2)-X(1)) H(2) = -H(1) H(3) = H(1) END IF RETURN 50 F1 = 5.0D0*X(1) + X(2) F2 = -5.0D0*X(1) + X(2) F3 = X(1)**2 + X(2)**2 + 4.0D0*X(2) IF ((F1.GE.F2) .AND. (F1.GE.F3)) THEN ELSE IF ((F2.GE.F1) .AND. (F2.GE.F3)) THEN ELSE H(1) = 2.0D0 H(3) = 2.0D0 END IF RETURN 60 H(1) = 2.0D0 H(3) = 2.0D0 RETURN 70 F1 = -X(1) - X(2) F2 = F1 + (X(1)**2+X(2)**2-1.0D0) IF (F1.LT.F2) THEN H(1) = 2.0D0 H(3) = 2.0D0 END IF RETURN 80 F1 = X(1)**2 + X(2)**2 - 1.0D0 IF (F1.GE.0.0D0) THEN H(1) = 40.0D0 H(3) = 40.0D0 END IF RETURN 90 F1 = SIGN(3.5D0,X(1)**2+X(2)**2-1.0D0) + 4.0D0 H(1) = F1 H(3) = F1 RETURN 100 IF (X(1).GT.ABS(X(2))) THEN F1 = 720D0* (9.0D0*X(1)**2+16.0D0*X(2)**2)** (-1.5D0) H(1) = F1*X(2)**2 H(2) = -F1*X(1)*X(2) H(3) = F1*X(1)**2 ELSE IF (X(1).LT.0.0D0) H(1) = -72.0D0*X(1)**8 END IF RETURN 110 F = X(1)**2 + X(2)**2 + X(3)**2 F2 = F + X(4)**2 + X(1) - X(2) + X(3) - X(4) - 8.0D0 F3 = F + X(2)**2 + 2.0D0*X(4)**2 - X(1) - X(4) - 10.0D0 F4 = F + 2.0D0*X(1) - X(2) - X(4) - 5.0D0 L = 1 IF (F2.GT.0.0D0) L = 2 IF (F3.GT.MAX(F2,0.0D0)) L = 3 IF (F4.GT.MAX(F2,F3,0.0D0)) L = 4 GO TO (120,130,140,150) L 120 H(1) = 2.0D0 H(3) = 2.0D0 H(6) = 4.0D0 H(10) = 2.0D0 RETURN 130 H(10) = 22.0D0 GO TO 160 140 H(3) = 42.0D0 H(10) = 42.0D0 GO TO 170 150 H(10) = 2.0D0 160 H(3) = 22.0D0 170 H(1) = 22.0D0 H(6) = 24.0D0 RETURN 180 F = -ETA9 DO 200 I = 1,10 F1 = 0.0D0 DO 190 J = 1,5 F1 = F1 + (X(J)-Y(5* (I-1)+J))**2 190 CONTINUE F1 = F1*Y(50+I) IF (F.LT.F1) K = I F = MAX(F,F1) 200 CONTINUE DO 210 J = 1,5 H(J* (J+1)/2) = 2.0D0*Y(50+K) 210 CONTINUE RETURN 220 DO 230 J = 1,5 H(J* (J+1)/2) = 6.0D0*Y(85+J)*X(J) 230 CONTINUE K = 1 DO 250 I = 1,N DO 240 J = 1,I H(K) = H(K) + 2.0D0*Y(55+I+J*5) K = K + 1 240 CONTINUE 250 CONTINUE RETURN 260 H(1) = 0.0D0 H(2) = X(3)*X(4)*X(5) H(3) = 0.0D0 H(4) = X(2)*X(4)*X(5) H(5) = X(1)*X(4)*X(5) H(6) = 0.0D0 H(7) = X(2)*X(3)*X(5) H(8) = X(1)*X(3)*X(5) H(9) = X(1)*X(2)*X(5) H(10) = 0.0D0 H(11) = X(2)*X(3)*X(4) H(12) = X(1)*X(3)*X(4) H(13) = X(1)*X(2)*X(4) H(14) = X(1)*X(2)*X(3) H(15) = 0.0D0 F1 = X(1)**2 + X(2)**2 + X(3)**2 + X(4)**2 + X(5)**2 - 1.0D1 F4 = 1.0D0 IF (F1.LT.0.0D0) F4 = -F4 L = 0 DO 270 I = 1,5 L = L + I H(L) = H(L) + 2.0D1*F4 270 CONTINUE F2 = X(2)*X(3) - 5.0D0*X(4)*X(5) F4 = 1.0D0 IF (F2.LT.0.0D0) F4 = -F4 H(5) = H(5) + 1.0D1*F4 H(14) = H(14) - 5.0D1*F4 F3 = X(1)**3 + X(2)**3 + 1.0D0 F4 = 1.0D0 IF (F3.LT.0.0D0) F4 = -F4 H(1) = H(1) + 6.0D1*F4*X(1) H(3) = H(3) + 6.0D1*F4*X(2) RETURN 280 DO 290 I = 1,51 T = DBLE(I-1)/10.0D0 F = 0.5D0*EXP(-T) - EXP(-T*2.0D0) + 0.5D0*EXP(-T*3.0D0) + + 1.5D0*EXP(-T*1.5D0)*SIN(7.0D0*T) + + EXP(-T*2.5D0)*SIN(5.0D0*T) F1 = EXP(-X(2)*T) F2 = EXP(-X(6)*T) F3 = COS(X(3)*T+X(4)) F4 = SIN(X(3)*T+X(4)) AI = SIGN(1.0D0,X(1)*F1*F3+X(5)*F2-F) H(2) = H(2) - AI*F1*F3*T H(3) = H(3) + AI*F1*F3*T*T*X(1) H(4) = H(4) - AI*F1*F4*T H(5) = H(5) + AI*F1*F4*T*T*X(1) H(6) = H(6) - AI*F1*F3*T*T*X(1) H(7) = H(7) - AI*F1*F4 H(8) = H(8) + AI*F1*F4*T*X(1) H(9) = H(9) - AI*F1*F3*T*X(1) H(10) = H(10) - AI*F1*F3*X(1) H(15) = H(15) - AI*F2*T H(20) = H(20) - AI*F2*T H(21) = H(21) + AI*F2*T*T*X(5) 290 CONTINUE RETURN 300 F = -ETA9 L = 1 KK = 0 DO 330 K = 1,5 F1 = 0.0D0 DO 320 I = 1,N F1 = F1 - Y(KK+100+I)*X(I) DO 310 J = 1,N F1 = F1 + Y(KK+ (I-1)*N+J)*X(I)*X(J) 310 CONTINUE 320 CONTINUE IF (F.LT.F1) L = K F = MAX(F,F1) KK = KK + 110 330 CONTINUE K = 1 DO 350 I = 1,N DO 340 J = 1,I H(K) = 2.0D0*Y((L-1)*110+ (I-1)*N+J) K = K + 1 340 CONTINUE 350 CONTINUE RETURN 360 F1 = 0.0D0 DO 370 I = 1,10 F1 = F1 + X(I)**2 370 CONTINUE F4 = F1 - 0.25D0 F1 = 1.0D-3*F4*F4 DO 380 I = 1,10 F1 = F1 + (X(I)-1.0D0)**2 380 CONTINUE F2 = 0.0D0 DO 410 I = 2,30 AI = DBLE(I-1)/29D0 F = 0.0D0 DO 390 J = 1,10 F = F + X(J)*AI** (J-1) 390 CONTINUE F = -F*F - 1.0D0 DO 400 J = 2,10 AJ = DBLE(J-1) F = F + X(J)*AJ*AI** (J-2) 400 CONTINUE F2 = F2 + F*F 410 CONTINUE F2 = F2 + X(1)**2 + (X(2)-X(1)**2-1.0D0)**2 F3 = 0.0D0 DO 420 I = 2,10 F3 = F3 + 100.0D0* (X(I)-X(I-1)**2)**2 + (1.0D0-X(I))**2 420 CONTINUE IF ((F1.GE.F2) .AND. (F1.GE.F3)) THEN L = 1 DO 440 I = 1,N DO 430 J = 1,I H(L) = 8.0D-3*X(I)*X(J) IF (J.EQ.I) H(L) = H(L) + 2.0D0 + 4.0D-3*F4 L = L + 1 430 CONTINUE 440 CONTINUE ELSE IF ((F2.GE.F1) .AND. (F2.GE.F3)) THEN KK = 1 DO 490 J = 1,N DO 480 L = 1,J DO 470 I = 2,30 AI = DBLE(I-1)/29.0D0 F = 0.0D0 DO 450 K = 1,10 F = F - X(K)*AI** (K-1) 450 CONTINUE T = 2.0D0*F*AI** (J-1) IF (J.GE.2) T = T + (J-1)*AI** (J-2) F4 = 2.0D0*F*AI** (L-1) IF (L.GE.2) F4 = F4 + (L-1)*AI** (L-2) F = -F*F - 1.0D0 DO 460 K = 2,10 F = F + X(K)* (K-1)*AI** (K-2) 460 CONTINUE H(KK) = H(KK) + 2.0D0* (T*F4-2.0D0*F*AI** (J+L-2)) 470 CONTINUE KK = KK + 1 480 CONTINUE 490 CONTINUE H(1) = H(1) + 12.0D0*X(1)**2 - 4.0D0*X(2) + 6.0D0 H(2) = H(2) - 4.0D0*X(1) H(3) = H(3) + 2.0D0 ELSE DO 500 I = 1,10 J = I* (I+1)/2 IF (I.GE.2) H(J) = 202.0D0 IF (I.LE.9) H(J) = H(J) + 4.0D2* (3.0D0*X(I)**2-X(I+1)) IF (I.LE.9) H(J+I) = -4.0D2*X(I) 500 CONTINUE END IF RETURN 510 T = (X(1)**2+X(7)**2)**1.5D0 H(1) = X(7)**2/T H(22) = -X(1)*X(7)/T H(28) = X(1)**2/T T = ((5.5D0-X(6))**2+ (1.0D0+X(12))**2)**1.5D0 H(21) = (1.0D0+X(12))**2/T H(72) = (5.5D0-X(6))* (1.0D0+X(12))/T H(78) = (5.5D0-X(6))**2/T DO 520 J = 1,6 T = Y(12+J)/ ((Y(J)-X(J))**2+ (Y(6+J)-X(6+J))**2)**1.5D0 H(IN(J,J)) = H(IN(J,J)) + (Y(J+6)-X(J+6))**2*T H(IN(J,J+6)) = H(IN(J,J+6)) - (Y(J+6)-X(J+6))* (Y(J)-X(J))*T H(IN(J+6,J+6)) = H(IN(J+6,J+6)) + (Y(J)-X(J))**2*T 520 CONTINUE DO 530 J = 1,6 IF (J.LT.6) THEN F1 = X(J) - X(J+1) F2 = X(J+6) - X(J+7) T = Y(18+J)/ (F1*F1+F2*F2)**1.5D0 H(IN(J,J)) = H(IN(J,J)) + F2*F2*T H(IN(J,J+1)) = H(IN(J,J+1)) - F2*F2*T H(IN(J,J+6)) = H(IN(J,J+6)) - F1*F2*T H(IN(J,J+7)) = H(IN(J,J+7)) + F1*F2*T H(IN(J+6,J+6)) = H(IN(J+6,J+6)) + F1*F1*T H(IN(J+6,J+7)) = H(IN(J+6,J+7)) - F1*F1*T END IF IF (J.GT.1) THEN F1 = X(J) - X(J-1) F2 = X(J+6) - X(J+5) T = Y(17+J)/ (F1*F1+F2*F2)**1.5D0 H(IN(J,J)) = H(IN(J,J)) + F2*F2*T H(IN(J,J+5)) = H(IN(J,J+5)) + F1*F2*T H(IN(J,J+6)) = H(IN(J,J+6)) - F1*F2*T H(IN(J+6,J+6)) = H(IN(J+6,J+6)) + F1*F1*T END IF 530 CONTINUE RETURN 540 F = X(1)**2 K = 1 DO 550 I = 2,20 F1 = X(I)**2 IF (F.LT.F1) K = I F = MAX(F,F1) 550 CONTINUE H(K* (K+1)/2) = 2.0D0 RETURN 560 RETURN 570 RETURN 580 RETURN 590 RETURN 600 RETURN 610 F1 = 0D0 DO 620 J = 1,5 F1 = F1 + Y(85+J)*X(J)**3 620 CONTINUE DO 630 J = 1,5 H(J* (J+1)/2) = SIGN(12.0D0,F1)*Y(85+J)*X(J) 630 CONTINUE K = 1 DO 650 I = 1,5 DO 640 J = 1,I H(K) = H(K) + 2.0D0*Y(55+I+J*5) K = K + 1 640 CONTINUE 650 CONTINUE DO 670 J = 1,5 T = -3.0D0*Y(85+J)*X(J)*X(J) - Y(90+J) DO 660 I = 1,15 IF (I.LE.5) T = T - 2.0D0*Y(55+I+J*5)*X(I) IF (I.GT.5) T = T + Y(I+J*10-15)*X(I) 660 CONTINUE IF (T.LE.0.0D0) GO TO 670 I = J* (J+1)/2 H(I) = H(I) - 6.0D2*Y(85+J) 670 CONTINUE RETURN END * SUBROUTINE TILD22 ALL SYSTEMS 99/12/01 C PORTABILITY : ALL SYSTEMS C 94/12/01 LU : ORIGINAL VERSION * * PURPOSE : * INITIATION OF VARIABLES FOR NONLINEAR MINIMAX APPROXIMATION. * LINEARLY CONSTRAINED DENSE VERSION. * * PARAMETERS : * IO N NUMBER OF VARIABLES. * IO NA NUMBER OF PARTIAL FUNCTIONS. * IO NB NUMBER OF BOX CONSTRAINTS. * IO NC NUMBER OF GENERAL LINEAR CONSTRAINTS. * RO X(N) VECTOR OF VARIABLES. * IO IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. * RO XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RO XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * IO IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * RO CL(NC) VECTOR CONTAINING LOWER BOUNDS FOR CONSTRAINT FUNCTIONS. * RO CU(NC) VECTOR CONTAINING UPPER BOUNDS FOR CONSTRAINT FUNCTIONS. * RO CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RO FMIN LOWER BOUND FOR VALUE OF THE OBJECTIVE FUNCTION. * RO XMAX MAXIMUM STEPSIZE. * IO NEXT NUMBER OF THE TEST PROBLEM. * IO IEXT TYPE OF OBJECTIVE FUNCTION. IEXT<0-MAXIMUM OF VALUES. * IEXT=0-MAXIMUM OF ABSOLUTE VALUES. * IO IERR ERROR INDICATOR. * SUBROUTINE TILD22(N,NA,NB,NC,X,IX,XL,XU,IC,CL,CU,CG,FMIN,XMAX, + NEXT,IEXT,IERR) C .. Parameters .. DOUBLE PRECISION PI PARAMETER (PI=3.14159265358979323846D0) C .. C .. Scalar Arguments .. DOUBLE PRECISION FMIN,XMAX INTEGER IERR,IEXT,N,NA,NB,NC,NEXT C .. C .. Array Arguments .. DOUBLE PRECISION CG(N*NC),CL(NC),CU(NC),X(N),XL(N),XU(N) INTEGER IC(NC),IX(N) C .. C .. Arrays in Common .. DOUBLE PRECISION Y(163) C .. C .. Local Scalars .. DOUBLE PRECISION A INTEGER I,J,K,L C .. C .. Intrinsic Functions .. INTRINSIC COS,DBLE,SIN C .. C .. Common blocks .. COMMON /EMPR22/Y C .. FMIN = -1.0D60 XMAX = 1.0D3 IEXT = -1 IERR = 0 NB = 0 GO TO (10,20,30,40,50,100,160,200,220, + 240,260,310,340,380,420) NEXT 10 IF (N.GE.2 .AND. NA.GE.3) THEN N = 2 NA = 3 NC = 1 X(1) = 1.0D0 X(2) = 2.0D0 IC(1) = 1 CL(1) = 0.5D0 CG(1) = 1.0D0 CG(2) = 1.0D0 ELSE IERR = 1 END IF RETURN 20 IF (N.GE.2 .AND. NA.GE.3) THEN N = 2 NA = 3 NC = 1 X(1) = -2.0D0 X(2) = -1.0D0 IC(1) = 2 CU(1) = -2.5D0 CG(1) = 3.0D0 CG(2) = 1.0D0 ELSE IERR = 1 END IF RETURN 30 IF (N.GE.2 .AND. NA.GE.3) THEN N = 2 NA = 3 NB = N NC = 1 X(1) = -1.0D0 X(2) = 1.0D-2 IX(1) = 0 IX(2) = 1 XL(2) = 1.0D-2 IC(1) = 1 CL(1) = -5.0D-1 CG(1) = 5.0D-2 CG(2) = -1.0D0 ELSE IERR = 1 END IF RETURN 40 IF (N.GE.2 .AND. NA.GE.3) THEN N = 2 NA = 3 NB = N NC = 1 X(1) = -1.0D0 X(2) = 3.0D0 IX(1) = 0 IX(2) = 1 XL(2) = 1.0D-2 IC(1) = 1 CL(1) = 1.0D0 CG(1) = -9.0D-1 CG(2) = 1.0D0 ELSE IERR = 1 END IF RETURN 50 IF (N.GE.6 .AND. NA.GE.3) THEN N = 6 NA = 3 X(1) = -1.0D0 X(2) = 0.0D0 X(3) = 0.0D0 X(4) = -1.0D0 X(5) = 1.0D0 X(6) = 1.0D0 NC = 5*NA DO 60 I = 1,NC CU(I) = 1.0D0 IC(I) = 2 60 CONTINUE DO 70 I = 1,N*NC CG(I) = 0.0D0 70 CONTINUE K = 1 DO 90 I = 1,NA L = 2* (I-1) DO 80 J = 1,5 CG(K+L) = SIN(2.0D0*PI*DBLE(J-1)/5.0D0) CG(K+L+1) = COS(2.0D0*PI*DBLE(J-1)/5.0D0) K = K + N 80 CONTINUE 90 CONTINUE ELSE IERR = 1 END IF RETURN 100 IF (N.GE.7 .AND. NA.GE.163) THEN N = 7 NA = 163 NB = N DO 110 I = 1,N X(I) = DBLE(I)*0.5D0 IX(I) = 0 110 CONTINUE XL(1) = 0.4D0 IX(1) = 1 IX(7) = 5 DO 120 I = 1,NA Y(I) = 2.0D0*PI*SIN(PI* (8.5D0+DBLE(I)*0.5D0)/180.0D0) 120 CONTINUE NC = 7 DO 130 I = 1,6 CL(I) = 0.4D0 IC(I) = 1 130 CONTINUE CL(7) = 1.0D0 CU(7) = 1.0D0 IC(7) = 5 DO 140 I = 1,N*NC CG(I) = 0.0D0 140 CONTINUE K = 0 DO 150 I = 1,6 CG(K+I) = -1.0D0 CG(K+I+1) = 1.0D0 K = K + N 150 CONTINUE CG(46) = -1.0D0 CG(48) = 1.0D0 IEXT = 0 FMIN = 0.0D0 ELSE IERR = 1 END IF RETURN 160 IF (N.GE.8 .AND. NA.GE.8) THEN N = 8 NA = 8 NB = N DO 170 I = 1,N X(I) = 0.125D0 XL(I) = 1.0D-8 IX(I) = 1 170 CONTINUE DO 180 I = 1,40 Y(I) = 1.0D0 Y(I+40) = 0.1D0 180 CONTINUE Y(9) = 2.0D0 Y(10) = 0.8D0 Y(12) = 0.5D0 Y(18) = 1.2D0 Y(19) = 0.8D0 Y(20) = 1.2D0 Y(21) = 1.6D0 Y(22) = 2.0D0 Y(23) = 0.6D0 Y(24) = 0.1D0 Y(25) = 2.0D0 Y(26) = 0.1D0 Y(27) = 0.6D0 Y(28) = 2.0D0 Y(32) = 2.0D0 Y(33) = 1.2D0 Y(34) = 1.2D0 Y(35) = 0.8D0 Y(37) = 1.2D0 Y(38) = 0.1D0 Y(39) = 3.0D0 Y(40) = 4.0D0 Y(41) = 3.0D0 Y(42) = 1.0D0 Y(45) = 5.0D0 Y(48) = 6.0D0 Y(50) = 1.0D1 Y(53) = 5.0D0 Y(58) = 9.0D0 Y(59) = 1.0D1 Y(61) = 4.0D0 Y(63) = 7.0D0 Y(68) = 1.0D1 Y(70) = 3.0D0 Y(80) = 1.1D1 Y(81) = 0.5D0 Y(82) = 1.2D0 Y(83) = 0.8D0 Y(84) = 2.0D0 Y(85) = 1.5D0 NC = 1 CL(1) = 1.0D0 CU(1) = 1.0D0 IC(1) = 5 DO 190 I = 1,N CG(I) = 1.0D0 190 CONTINUE ELSE IERR = 1 END IF RETURN 200 IF (N.GE.10 .AND. NA.GE.6) THEN N = 10 NA = 6 X(1) = 2.0D0 X(2) = 3.0D0 X(3) = 5.0D0 X(4) = 5.0D0 X(5) = 1.0D0 X(6) = 2.0D0 X(7) = 7.0D0 X(8) = 3.0D0 X(9) = 6.0D0 X(10) = 1.0D1 NC = 3 CU(1) = 1.05D2 CU(2) = 0.00D0 CU(3) = 1.20D1 IC(1) = 2 IC(2) = 2 IC(3) = 2 DO 210 I = 1,N*NC CG(I) = 0.0D0 210 CONTINUE CG(1) = 4.0D0 CG(2) = 5.0D0 CG(7) = -3.0D0 CG(8) = 9.0D0 CG(11) = 1.0D1 CG(12) = -8.0D0 CG(17) = -1.7D1 CG(18) = 2.0D0 CG(21) = -8.0D0 CG(22) = 2.0D0 CG(29) = 5.0D0 CG(30) = -2.0D0 ELSE IERR = 1 END IF RETURN 220 IF (N.GE.20 .AND. NA.GE.14) THEN N = 20 NA = 14 X(1) = 2.0D0 X(2) = 3.0D0 X(3) = 5.0D0 X(4) = 5.0D0 X(5) = 1.0D0 X(6) = 2.0D0 X(7) = 7.0D0 X(8) = 3.0D0 X(9) = 6.0D0 X(10) = 1.0D1 X(11) = 2.0D0 X(12) = 2.0D0 X(13) = 6.0D0 X(14) = 1.5D1 X(15) = 1.0D0 X(16) = 2.0D0 X(17) = 1.0D0 X(18) = 2.0D0 X(19) = 1.0D0 X(20) = 3.0D0 NC = 4 CU(1) = 1.05D2 CU(2) = 0.00D0 CU(3) = 1.20D1 CU(4) = 0.00D0 IC(1) = 2 IC(2) = 2 IC(3) = 2 IC(4) = 2 DO 230 I = 1,N*NC CG(I) = 0.0D0 230 CONTINUE CG(1) = 4.0D0 CG(2) = 5.0D0 CG(7) = -3.0D0 CG(8) = 9.0D0 CG(21) = 1.0D1 CG(22) = -8.0D0 CG(27) = -1.7D1 CG(28) = 2.0D0 CG(41) = -8.0D0 CG(42) = 2.0D0 CG(49) = 5.0D0 CG(50) = -2.0D0 CG(61) = 1.0D0 CG(62) = 1.0D0 CG(71) = 4.0D0 CG(72) = -2.1D1 ELSE IERR = 1 END IF RETURN 240 IF (N.GE.20 .AND. NA.GE.38) THEN N = 20 NA = 38 NB = N DO 250 I = 1,N X(I) = 1.0D2 IX(I) = 0 IF (I.LE.10) IX(I) = 1 XL(I) = 0.5D0 250 CONTINUE NC = 0 IEXT = 0 FMIN = 0.0D0 ELSE IERR = 1 END IF RETURN 260 IF (N.GE.9 .AND. NA.GE.124) THEN N = 9 NA = 124 NB = N K = (N-1)/2 C X(1)=1.8D-2 C X(2)=1.9D-2 C X(3)=2.0D-2 C X(4)=2.1D-2 C X(5)=0.8D 0 C X(6)=0.9D 0 C X(7)=1.0D 0 C X(8)=1.1D 0 C X(9)=-1.4D 1 X(1) = 0.398D-1 X(2) = 0.968D-4 X(3) = 0.103D-3 X(4) = 0.389D-1 X(5) = 0.101D1 X(6) = 0.968D0 X(7) = 0.103D1 X(8) = 0.988D0 X(9) = -0.116D2 DO 270 I = 1,N - 1 XL(I) = 0.0D0 IX(I) = 1 270 CONTINUE IX(N) = 0 L = (NA-2)/2 A = (1.012577D0-0.987423D0)/DBLE(L-1) Y(1) = 0.967320D0 DO 280 I = 2,L + 1 Y(I) = 0.987423D0 + DBLE(I-2)*A Y(I+L) = Y(I) 280 CONTINUE Y(NA) = 1.032680D0 NC = K DO 290 I = 1,N*NC CG(I) = 0.0D0 290 CONTINUE L = 0 DO 300 I = 1,NC CG(L+I) = 1.0D4 CG(L+I+K) = -1.0D0 CL(I) = 0.0D0 IC(I) = 1 L = L + N 300 CONTINUE IEXT = 0 FMIN = 0.0D0 ELSE IERR = 1 END IF RETURN 310 IF (N.GE.10 .AND. NA.GE.9) THEN N = 10 NA = 9 NB = N X(1) = 1745.0D0 X(2) = 1200.0D1 X(3) = 1100.0D-1 X(4) = 3048.0D0 X(5) = 1974.0D0 X(6) = 8920.0D-2 X(7) = 9280.0D-2 X(8) = 8000.0D-3 X(9) = 3600.0D-3 X(10) = 145.0D0 XL(1) = 1.0D-5 XL(2) = 1.0D-5 XL(3) = 1.0D-5 XL(4) = 1.0D-5 XL(5) = 1.0D-5 XL(6) = 8.5D1 XL(7) = 9.0D1 XL(8) = 3.0D0 XL(9) = 1.2D0 XL(10) = 1.4D2 XU(1) = 2.0D3 XU(2) = 1.6D4 XU(3) = 1.2D2 XU(4) = 5.0D3 XU(5) = 2.0D3 XU(6) = 9.3D1 XU(7) = 9.5D1 XU(8) = 1.2D1 XU(9) = 4.0D0 XU(10) = 1.6D2 DO 320 I = 1,N IX(I) = 3 320 CONTINUE NC = 5 CU(1) = 35.82D0 CL(2) = 35.82D0 CL(3) = 133.0D0 CU(4) = 133.0D0 CL(5) = 0.0D0 CU(5) = 0.0D0 IC(1) = 2 IC(2) = 1 IC(3) = 1 IC(4) = 2 IC(5) = 5 DO 330 I = 1,N*NC CG(I) = 0.0D0 330 CONTINUE CG(9) = 0.90D0 CG(10) = 2.22D-1 CG(19) = 1.00D0/0.90D0 CG(20) = 2.22D-1 CG(27) = 3.00D0 CG(30) = -0.99D0 CG(37) = 3.00D0 CG(40) = -1.00D0/0.99D0 CG(41) = -1.00D0 CG(44) = 1.22D0 CG(45) = -1.00D0 ELSE IERR = 1 END IF RETURN 340 IF (N.GE.7 .AND. NA.GE.15) THEN N = 7 NA = 13 NB = N X(1) = 17.45D2 X(2) = 1.10D2 X(3) = 30.48D2 X(4) = 8.90D1 X(5) = 9.20D1 X(6) = 8.00D0 X(7) = 14.50D1 XL(1) = 1.00D0 XL(2) = 1.00D0 XL(3) = 1.00D0 XL(4) = 8.50D1 XL(5) = 9.00D1 XL(6) = 3.00D0 XL(7) = 1.45D2 XU(1) = 2.00D3 XU(2) = 1.20D2 XU(3) = 5.00D3 XU(4) = 9.30D1 XU(5) = 9.50D1 XU(6) = 1.20D1 XU(7) = 1.62D2 DO 350 I = 1,N IX(I) = 3 350 CONTINUE Y(1) = 1.71500000D0 Y(2) = 0.03500000D0 Y(3) = 4.05650000D0 Y(4) = 10.0000000D0 Y(5) = 3000.00000D0 Y(6) = -0.06300000D0 Y(7) = 0.59553571D-2 Y(8) = 0.88392857D0 Y(9) = -0.11756250D0 Y(10) = 1.10880000D0 Y(11) = 0.13035330D0 Y(12) = -0.00660330D0 Y(13) = 0.66173269D-3 Y(14) = 0.17239878D-1 Y(15) = -0.56595559D-2 Y(16) = -0.19120592D-1 Y(17) = 0.56850750D2 Y(18) = 1.08702000D0 Y(19) = 0.32175000D0 Y(20) = -0.03762000D0 Y(21) = 0.00619800D0 Y(22) = 0.24623121D4 Y(23) = -0.25125634D2 Y(24) = 0.16118996D3 Y(25) = 5000.00000D0 Y(26) = -0.48951000D6 Y(27) = 0.44333333D2 Y(28) = 0.33000000D0 Y(29) = 0.02255600D0 Y(30) = -0.00759500D0 Y(31) = 0.00061000D0 Y(32) = -0.00050000D0 Y(33) = 0.81967200D0 Y(34) = 0.81967200D0 Y(35) = 24500.0000D0 Y(36) = -250.000000D0 Y(37) = 0.10204082D-1 Y(38) = 0.12244898D-4 Y(39) = 0.00006250D0 Y(40) = 0.00006250D0 Y(41) = -0.00007625D0 Y(42) = 1.22000000D0 Y(43) = 1.00000000D0 Y(44) = -1.00000000D0 NC = 2 L = 0 DO 370 I = 1,NC CU(I) = 1.0D0 IC(I) = 2 DO 360 J = 1,N CG(L+J) = 0.0D0 360 CONTINUE L = L + N 370 CONTINUE CG(5) = Y(29) CG(7) = Y(30) CG(8) = Y(32) CG(10) = Y(31) ELSE IERR = 1 END IF RETURN 380 IF (N.GE.8 .AND. NA.GE.7) THEN N = 8 NA = 4 NB = N X(1) = 5.00D3 X(2) = 5.00D3 X(3) = 5.00D3 X(4) = 2.00D2 X(5) = 3.50D2 X(6) = 1.50D2 X(7) = 2.25D2 X(8) = 4.25D2 DO 390 I = 1,N XL(I) = 1.0D1 XU(I) = 1.0D3 IX(I) = 3 390 CONTINUE XL(1) = 1.0D2 XL(2) = 1.0D3 XL(3) = 1.0D3 XU(1) = 1.0D4 XU(2) = 1.0D4 XU(3) = 1.0D4 NC = 3 L = 0 DO 410 I = 1,NC CU(I) = 1.0D0 IC(I) = 2 DO 400 J = 1,N CG(L+J) = 0.0D0 400 CONTINUE L = L + N 410 CONTINUE CG(4) = 2.5D-3 CG(6) = 2.5D-3 CG(12) = -2.5D-3 CG(13) = 2.5D-3 CG(15) = 2.5D-3 CG(21) = -1.0D-2 CG(24) = 1.0D-2 ELSE IERR = 1 END IF RETURN 420 IF (N.GE.16 .AND. NA.GE.20) THEN N = 16 NA = 19 NB = N X(1) = 0.80D0 X(2) = 0.83D0 X(3) = 0.85D0 X(4) = 0.87D0 X(5) = 0.90D0 X(6) = 0.10D0 X(7) = 0.12D0 X(8) = 0.19D0 X(9) = 0.25D0 X(10) = 0.29D0 X(11) = 5.12D2 X(12) = 1.31D1 X(13) = 7.18D1 X(14) = 6.40D2 X(15) = 6.50D2 X(16) = 5.70D0 XL(1) = 1.0D-1 XL(2) = 1.0D-1 XL(3) = 1.0D-1 XL(4) = 1.0D-1 XL(5) = 9.0D-1 XL(6) = 1.0D-4 XL(7) = 1.0D-1 XL(8) = 1.0D-1 XL(9) = 1.0D-1 XL(10) = 1.0D-1 XL(11) = 1.0D0 XL(12) = 1.0D-6 XL(13) = 1.0D0 XL(14) = 5.0D2 XL(15) = 5.0D2 XL(16) = 1.0D-6 XU(1) = 9.0D-1 XU(2) = 9.0D-1 XU(3) = 9.0D-1 XU(4) = 9.0D-1 XU(5) = 1.0D0 XU(6) = 1.0D-1 XU(7) = 9.0D-1 XU(8) = 9.0D-1 XU(9) = 9.0D-1 XU(10) = 9.0D-1 XU(11) = 1.0D4 XU(12) = 5.0D3 XU(13) = 5.0D3 XU(14) = 1.0D4 XU(15) = 1.0D4 XU(16) = 5.0D3 DO 430 I = 1,N IX(I) = 3 430 CONTINUE NC = 1 CU(1) = 1.0D0 IC(1) = 2 DO 440 I = 1,N CG(I) = 0.0D0 440 CONTINUE CG(11) = 2.0D-3 CG(12) = -2.0D-3 ELSE IERR = 1 END IF RETURN END * SUBROUTINE TAFU22 ALL SYSTEMS 99/12/01 C PORTABILITY : ALL SYSTEMS C 94/12/01 LU : ORIGINAL VERSION * * PURPOSE : * VALUES OF PARTIAL FUNCTIONS IN THE MINIMAX CRITERION. * * PARAMETERS : * II N NUMBER OF VARIABLES. * II KA INDEX OF THE PARTIAL FUNCTION. * RI X(N) VECTOR OF VARIABLES. * RO FA VALUE OF THE PARTIAL FUNCTION AT THE * SELECTED POINT. * II NEXT NUMBER OF THE TEST PROBLEM. * SUBROUTINE TAFU22(N,KA,X,FA,NEXT) C .. Scalar Arguments .. DOUBLE PRECISION FA INTEGER KA,N,NEXT C .. C .. Array Arguments .. DOUBLE PRECISION X(N) C .. C .. Arrays in Common .. DOUBLE PRECISION Y(163) C .. C .. Local Scalars .. DOUBLE PRECISION A,B,P,S INTEGER I,J,K C .. C .. Intrinsic Functions .. INTRINSIC COS,EXP,LOG,MOD,SIN,SINH,SQRT C .. C .. Common blocks .. COMMON /EMPR22/Y C .. GO TO (10,10,50,50,90,130,150,180,250, + 340,360,380,480,620,670) NEXT 10 GO TO (20,30,40) KA 20 FA = X(1)**2 + X(2)**2 + X(1)*X(2) - 1.0D0 RETURN 30 FA = SIN(X(1)) RETURN 40 FA = -COS(X(2)) RETURN 50 GO TO (60,70,80) KA 60 FA = -EXP(X(1)-X(2)) RETURN 70 FA = SINH(X(1)-1.0D0) - 1.0D0 RETURN 80 FA = -LOG(X(2)) - 1.0D0 RETURN 90 GO TO (100,110,120) KA 100 FA = -SQRT((X(1)-X(3))**2+ (X(2)-X(4))**2) RETURN 110 FA = -SQRT((X(3)-X(5))**2+ (X(4)-X(6))**2) RETURN 120 FA = -SQRT((X(5)-X(1))**2+ (X(6)-X(2))**2) RETURN 130 A = 0.0D0 DO 140 I = 1,N A = A + COS(Y(KA)*X(I)) 140 CONTINUE FA = (1.0D0+2.0D0*A)/1.5D1 RETURN 150 FA = 0.0D0 K = 0 DO 170 I = 1,5 A = 0.0D0 P = 0.0D0 DO 160 J = 1,N A = A + Y(K+J)*X(J)** (1.0D0-Y(I+80)) P = P + Y(K+J+40)*X(J) 160 CONTINUE FA = FA + Y(K+KA)*P/ (X(KA)**Y(I+80)*A) - Y(K+KA+40) K = K + N 170 CONTINUE RETURN 180 FA = X(1)**2 + X(2)**2 + X(1)*X(2) - 1.4D1*X(1) - 1.6D1*X(2) + + (X(3)-1.0D1)**2 + 4.0D0* (X(4)-5.0D0)**2 + (X(5)-3.0D0)**2 + + 2.0D0* (X(6)-1.0D0)**2 + 5.0D0*X(7)**2 + + 7.0D0* (X(8)-1.1D1)**2 + 2.0D0* (X(9)-1.0D1)**2 + + (X(10)-7.0D0)**2 + 4.5D1 GO TO (190,200,210,220,230,240) KA 190 CONTINUE RETURN 200 FA = FA + 1.0D1* (3.0D0* (X(1)-2.0D0)**2+4.0D0* (X(2)-3.0D0)**2+ + 2.0D0*X(3)**2-7.0D0*X(4)-1.2D2) RETURN 210 FA = FA + 1.0D1* (5.0D0*X(1)**2+8.0D0*X(2)+ (X(3)-6.0D0)**2- + 2.0D0*X(4)-4.0D1) RETURN 220 FA = FA + 1.0D1* (0.5D0* (X(1)-8.0D0)**2+2.0D0* (X(2)-4.0D0)**2+ + 3.0D0*X(5)**2-X(6)-3.0D1) RETURN 230 FA = FA + 1.0D1* (X(1)**2+2.0D0* (X(2)-2.0D0)**2-2.0D0*X(1)*X(2)+ + 1.4D1*X(5)-6.0D0*X(6)) RETURN 240 FA = FA + 1.0D1* (6.0D0*X(2)-3.0D0*X(1)+1.2D1* (X(9)-8.0D0)**2- + 7.0D0*X(10)) RETURN 250 FA = X(1)**2 + X(2)**2 + X(1)*X(2) - 1.4D1*X(1) - 1.6D1*X(2) + + (X(3)-1.0D1)**2 + 4.0D0* (X(4)-5.0D0)**2 + (X(5)-3.0D0)**2 + + 2.0D0* (X(6)-1.0D0)**2 + 5.0D0*X(7)**2 + + 7.0D0* (X(8)-1.1D1)**2 + 2.0D0* (X(9)-1.0D1)**2 + + (X(10)-7.0D0)**2 + (X(11)-9.0D0)**2 + + 1.0D1* (X(12)-1.0D0)**2 + 5.0D0* (X(13)-7.0D0)**2 + + 4.0D0* (X(14)-1.4D1)**2 + 2.7D1* (X(15)-1.0D0)**2 + + X(16)**4 + (X(17)-2.0D0)**2 + 1.3D1* (X(18)-2.0D0)**2 + + (X(19)-3.D0)**2 + X(20)**2 + 9.5D1 GO TO (190,200,210,220,230,240,260,270,280,290,300, + 310,320,330) KA 260 FA = FA + 1.0D1* (X(1)**2+1.5D1*X(11)-8.0D0*X(12)-2.8D1) RETURN 270 FA = FA + 1.0D1* (4.0D0*X(1)+9.0D0*X(2)+5.0D0*X(13)**2- + 9.0D0*X(14)-8.7D1) RETURN 280 FA = FA + 1.0D1* (3.0D0*X(1)+4.0D0*X(2)+3.0D0* (X(13)-6.0D0)**2- + 1.4D1*X(14)-1.0D1) RETURN 290 FA = FA + 1.0D1* (1.4D1*X(1)**2+3.5D1*X(15)-7.9D1*X(16)-9.2D1) RETURN 300 FA = FA + 1.0D1* (1.5D1*X(2)**2+1.1D1*X(15)-6.1D1*X(16)-5.4D1) RETURN 310 FA = FA + 1.0D1* (5.0D0*X(1)**2+2.0D0*X(2)+9.0D0*X(17)**4-X(18)- + 6.8D1) RETURN 320 FA = FA + 1.0D1* (X(1)**2-X(2)+1.9D1*X(19)-2.0D1*X(20)+1.9D1) RETURN 330 FA = FA + 1.0D1* (7.0D0*X(1)**2+5.0D0*X(2)**2+X(19)**2- + 3.0D1*X(20)) RETURN 340 FA = -1.0D0 DO 350 I = 1,N FA = FA + X(I) 350 CONTINUE IF (MOD(KA,2).EQ.0) THEN I = (KA+2)/2 FA = FA + X(I)* (X(I)-1.0D0) ELSE I = (KA+1)/2 FA = FA + X(I)* (2.0D0*X(I)-1.0D0) END IF RETURN 360 K = (N-1)/2 A = Y(KA) S = 1.0D0 IF (KA.GT.62 .AND. KA.LT.124) S = -S P = -8.0D0*LOG(A) A = A*A DO 370 I = 1,K B = X(I+K)**2 - A P = P + LOG(B*B+A*X(I)**2) 370 CONTINUE FA = (0.5D0*P-X(N))*S IF (KA.EQ.1 .OR. KA.EQ.124) FA = FA + 3.0164D0 RETURN 380 P = 5.0D2 A = 0.99D0 FA = 5.04D0*X(1) + 0.35D-1*X(2) + 1.00D1*X(3) + 3.36D0*X(5) - + 0.63D-1*X(4)*X(7) GO TO (390,400,410,420,430,440,450,460,470) KA 390 CONTINUE RETURN 400 FA = FA + P* (1.12D0*X(1)+X(1)*X(8)* (1.3167D-1-6.67D-3*X(8))- + X(4)/A) RETURN 410 FA = FA - P* (1.12D0*X(1)+X(1)*X(8)* (1.3167D-1-6.67D-3*X(8))- + X(4)*A) RETURN 420 FA = FA + P* (57.425D0+X(8)* (1.098D0-0.038D0*X(8))+0.325D0*X(6)- + X(7)/A) RETURN 430 FA = FA - P* (57.425D0+X(8)* (1.098D0-0.038D0*X(8))+0.325D0*X(6)- + X(7)*A) RETURN 440 FA = FA + P* (9.8D4*X(3)/ (X(4)*X(9)+1.0D3*X(3))-X(6)) RETURN 450 FA = FA - P* (9.8D4*X(3)/ (X(4)*X(9)+1.0D3*X(3))-X(6)) RETURN 460 FA = FA + P* ((X(2)+X(5))/X(1)-X(8)) RETURN 470 FA = FA - P* ((X(2)+X(5))/X(1)-X(8)) RETURN 480 P = 1.0D5 FA = Y(1)*X(1) + Y(2)*X(1)*X(6) + Y(3)*X(3) + Y(4)*X(2) + Y(5) + + Y(6)*X(3)*X(5) GO TO (490,500,510,520,530,540,550,560,570, + 580,590,600,610) KA 490 CONTINUE RETURN 500 FA = FA + P* (Y(7)*X(6)**2+Y(8)*X(3)/X(1)+Y(9)*X(6)-1.0D0) RETURN 510 FA = FA + P* ((Y(10)+Y(11)*X(6)+Y(12)*X(6)**2)*X(1)/X(3)-1.0D0) RETURN 520 FA = FA + P* (Y(13)*X(6)**2+Y(14)*X(5)+Y(15)*X(4)+Y(16)*X(6)- + 1.0D0) RETURN 530 FA = FA + P* ((Y(17)+Y(18)*X(6)+Y(19)*X(4)+Y(20)*X(6)**2)/X(5)- + 1.0D0) RETURN 540 FA = FA + P* (Y(21)*X(7)+ (Y(22)/X(4)+Y(23))*X(2)/X(3)-1.0D0) RETURN 550 FA = FA + P* ((Y(24)+ (Y(25)+Y(26)/X(4))*X(2)/X(3))/X(7)-1.0D0) RETURN 560 FA = FA + P* ((Y(27)+Y(28)*X(7))/X(5)-1.0D0) RETURN 570 FA = FA + P* ((Y(33)*X(1)+Y(34))/X(3)-1.0D0) RETURN 580 FA = FA + P* ((Y(35)/X(4)+Y(36))*X(2)/X(3)-1.0D0) RETURN 590 FA = FA + P* ((Y(37)+Y(38)*X(3)/X(2))*X(4)-1.0D0) RETURN 600 FA = FA + P* (Y(39)*X(1)*X(6)+Y(40)*X(1)+Y(41)*X(3)-1.0D0) RETURN 610 FA = FA + P* ((Y(42)*X(3)+Y(43))/X(1)+Y(44)*X(6)-1.0D0) RETURN 620 P = 1.0D5 FA = X(1) + X(2) + X(3) GO TO (630,640,650,660) KA 630 CONTINUE RETURN 640 FA = FA + P* ((833.33252D0*X(4)/X(1)+1.0D2-83333.333D0/X(1))/X(6)- + 1.0D0) RETURN 650 FA = FA + P* ((1.25D3* (X(5)-X(4))/X(2)+X(4))/X(7)-1.0D0) RETURN 660 FA = FA + P* (((1.25D6-2.5D3*X(5))/X(3)+X(5))/X(8)-1.0D0) RETURN 670 P = 2.0D3 FA = 1.262626D0* (X(12)+X(13)+X(14)+X(15)+X(16)) - + 1.231060D0* (X(1)*X(12)+X(2)*X(13)+X(3)*X(14)+X(4)*X(15)+ + X(5)*X(16)) GO TO (680,690,700,710,720,730,740,750,760, + 770,780,790,800,810,820,830,840,850, + 860) KA 680 CONTINUE RETURN 690 FA = FA + P* (X(1)* (9.75D-1+ (3.475D-2-9.75D-3*X(1))/X(6))-1.0D0) RETURN 700 FA = FA + P* (X(2)* (9.75D-1+ (3.475D-2-9.75D-3*X(2))/X(7))-1.0D0) RETURN 710 FA = FA + P* (X(3)* (9.75D-1+ (3.475D-2-9.75D-3*X(3))/X(8))-1.0D0) RETURN 720 FA = FA + P* (X(4)* (9.75D-1+ (3.475D-2-9.75D-3*X(4))/X(9))-1.0D0) RETURN 730 FA = FA + P* (X(5)* (9.75D-1+ (3.475D-2-9.75D-3*X(5))/X(10))- + 1.0D0) RETURN 740 FA = FA + P* ((X(6)+ (X(1)-X(6))*X(12)/X(11))/X(7)-1.0D0) RETURN 750 FA = FA + P* (((X(7)+2.0D-3* (X(7)-X(1))*X(12))/X(8)+ + 2.0D-3*X(13)* (X(2)/X(8)-1.0D0))-1.0D0) RETURN 760 FA = FA + P* (X(8)+X(9)+2.0D-3*X(13)* (X(8)-X(2))+ + 2.0D-3*X(14)* (X(3)-X(9))-1.0D0) RETURN 770 FA = FA + P* ((X(9)+ ((X(4)-X(8))*X(15)+5.0D2* (X(10)- + X(9)))/X(14))/X(3)-1.0D0) RETURN 780 FA = FA + P* ((X(10)/X(4)+ (X(5)/X(4)-1.0D0)*X(16)/X(15)+ + 5.0D2* (1.0D0-X(10)/X(4))/X(15))-1.0D0) RETURN 790 FA = FA + P* (9.0D-1/X(4)+2.0D-3*X(16)* (1.0D0-X(5)/X(4))-1.0D0) RETURN 800 FA = FA + P* (X(12)/X(11)-1.0D0) RETURN 810 FA = FA + P* (X(4)/X(5)-1.0D0) RETURN 820 FA = FA + P* (X(3)/X(4)-1.0D0) RETURN 830 FA = FA + P* (X(2)/X(3)-1.0D0) RETURN 840 FA = FA + P* (X(1)/X(2)-1.0D0) RETURN 850 FA = FA + P* (X(9)/X(10)-1.0D0) RETURN 860 FA = FA + P*X(8)/X(9) - P RETURN END * SUBROUTINE TAGU22 ALL SYSTEMS 99/12/01 C PORTABILITY : ALL SYSTEMS C 94/12/01 LU : ORIGINAL VERSION * * PURPOSE : * GRADIENTS OF PARTIAL FUNCTIONS IN THE MINIMAX CRITERION. * * PARAMETERS : * II N NUMBER OF VARIABLES. * II KA INDEX OF THE PARTIAL FUNCTION. * RI X(N) VECTOR OF VARIABLES. * RO GA(N) GRADIENT OF THE PARTIAL FUNCTION AT THE * SELECTED POINT. * II NEXT NUMBER OF THE TEST PROBLEM. * SUBROUTINE TAGU22(N,KA,X,GA,NEXT) C .. Scalar Arguments .. INTEGER KA,N,NEXT C .. C .. Array Arguments .. DOUBLE PRECISION GA(N),X(N) C .. C .. Arrays in Common .. DOUBLE PRECISION Y(163) C .. C .. Local Scalars .. DOUBLE PRECISION A,B,C,P,S INTEGER I,J,K C .. C .. Intrinsic Functions .. INTRINSIC COS,COSH,EXP,MOD,SIN,SQRT C .. C .. Common blocks .. COMMON /EMPR22/Y C .. GO TO (10,10,50,50,90,130,150,200,270, + 360,380,400,500,640,690) NEXT 10 GO TO (20,30,40) KA 20 GA(1) = 2.0D0*X(1) + X(2) GA(2) = 2.0D0*X(2) + X(1) RETURN 30 GA(1) = COS(X(1)) GA(2) = 0.0D0 RETURN 40 GA(1) = 0.0D0 GA(2) = SIN(X(2)) RETURN 50 GO TO (60,70,80) KA 60 GA(1) = -EXP(X(1)-X(2)) GA(2) = EXP(X(1)-X(2)) RETURN 70 GA(1) = COSH(X(1)-1.0D0) GA(2) = 0.0D0 RETURN 80 GA(1) = 0.0D0 GA(2) = -1.0D0/X(2) RETURN 90 GO TO (100,110,120) KA 100 A = SQRT((X(1)-X(3))**2+ (X(2)-X(4))**2) GA(1) = - (X(1)-X(3))/A GA(2) = - (X(2)-X(4))/A GA(3) = -GA(1) GA(4) = -GA(2) GA(5) = 0.0D0 GA(6) = 0.0D0 RETURN 110 A = SQRT((X(3)-X(5))**2+ (X(4)-X(6))**2) GA(1) = 0.0D0 GA(2) = 0.0D0 GA(3) = - (X(3)-X(5))/A GA(4) = - (X(4)-X(6))/A GA(5) = -GA(3) GA(6) = -GA(4) RETURN 120 A = SQRT((X(5)-X(1))**2+ (X(6)-X(2))**2) GA(1) = (X(5)-X(1))/A GA(2) = (X(6)-X(2))/A GA(3) = 0.0D0 GA(4) = 0.0D0 GA(5) = -GA(1) GA(6) = -GA(2) RETURN 130 DO 140 I = 1,N GA(I) = -2.0D0*Y(KA)*SIN(Y(KA)*X(I))/1.5D1 140 CONTINUE RETURN 150 DO 160 I = 1,N GA(I) = 0.0D0 160 CONTINUE K = 0 DO 190 I = 1,5 A = 0.0D0 P = 0.0D0 DO 170 J = 1,N A = A + Y(K+J)*X(J)** (1.0D0-Y(I+80)) P = P + Y(K+J+40)*X(J) 170 CONTINUE B = Y(K+KA)/ (X(KA)**Y(I+80)*A) DO 180 J = 1,N C = Y(K+J)* (1.0D0-Y(I+80))/ (X(J)**Y(I+80)*A) GA(J) = GA(J) + B* (Y(K+J+40)-C*P) 180 CONTINUE GA(KA) = GA(KA) - B*Y(I+80)*P/X(KA) K = K + N 190 CONTINUE RETURN 200 GA(1) = 2.0D0*X(1) + X(2) - 1.4D1 GA(2) = 2.0D0*X(2) + X(1) - 1.6D1 GA(3) = 2.0D0* (X(3)-1.0D1) GA(4) = 8.0D0* (X(4)-5.0D0) GA(5) = 2.0D0* (X(5)-3.0D0) GA(6) = 4.0D0* (X(6)-1.0D0) GA(7) = 1.0D1*X(7) GA(8) = 1.4D1* (X(8)-1.1D1) GA(9) = 4.0D0* (X(9)-1.0D1) GA(10) = 2.0D0* (X(10)-7.0D0) GO TO (210,220,230,240,250,260) KA 210 CONTINUE RETURN 220 GA(1) = GA(1) + 6.0D1* (X(1)-2.0D0) GA(2) = GA(2) + 8.0D1* (X(2)-3.0D0) GA(3) = GA(3) + 4.0D1*X(3) GA(4) = GA(4) - 7.0D1 RETURN 230 GA(1) = GA(1) + 1.0D2*X(1) GA(2) = GA(2) + 8.0D1 GA(3) = GA(3) + 2.0D1* (X(3)-6.0D0) GA(4) = GA(4) - 2.0D1 RETURN 240 GA(1) = GA(1) + 1.0D1* (X(1)-8.0D0) GA(2) = GA(2) + 4.0D1* (X(2)-4.0D0) GA(5) = GA(5) + 6.0D1*X(5) GA(6) = GA(6) - 1.0D1 RETURN 250 GA(1) = GA(1) + 2.0D1*X(1) - 2.0D1*X(2) GA(2) = GA(2) + 4.0D1* (X(2)-2.0D0) - 2.0D1*X(1) GA(5) = GA(5) + 1.4D2 GA(6) = GA(6) - 6.0D1 RETURN 260 GA(1) = GA(1) - 3.0D1 GA(2) = GA(2) + 6.0D1 GA(9) = GA(9) + 2.4D2* (X(9)-8.0D0) GA(10) = GA(10) - 7.0D1 RETURN 270 GA(1) = 2.0D0*X(1) + X(2) - 1.4D1 GA(2) = 2.0D0*X(2) + X(1) - 1.6D1 GA(3) = 2.0D0* (X(3)-1.0D1) GA(4) = 8.0D0* (X(4)-5.0D0) GA(5) = 2.0D0* (X(5)-3.0D0) GA(6) = 4.0D0* (X(6)-1.0D0) GA(7) = 1.0D1*X(7) GA(8) = 1.4D1* (X(8)-1.1D1) GA(9) = 4.0D0* (X(9)-1.0D1) GA(10) = 2.0D0* (X(10)-7.0D0) GA(11) = 2.0D0* (X(11)-9.0D0) GA(12) = 2.0D1* (X(12)-1.0D0) GA(13) = 1.0D1* (X(13)-7.0D0) GA(14) = 8.0D0* (X(14)-1.4D1) GA(15) = 5.4D1* (X(15)-1.0D0) GA(16) = 4.0D0*X(16)**3 GA(17) = 2.0D0* (X(17)-2.0D0) GA(18) = 2.6D1* (X(18)-2.0D0) GA(19) = 2.0D0* (X(19)-3.0D0) GA(20) = 2.0D0*X(20) GO TO (210,220,230,240,250,260,280,290,300,310,320, + 330,340,350) KA 280 GA(1) = GA(1) + 2.0D1*X(1) GA(11) = GA(11) + 1.5D2 GA(12) = GA(12) - 8.0D1 RETURN 290 GA(1) = GA(1) + 4.0D1 GA(2) = GA(2) + 9.0D1 GA(13) = GA(13) + 1.0D2*X(13) GA(14) = GA(14) - 9.0D1 RETURN 300 GA(1) = GA(1) + 3.0D1 GA(2) = GA(2) + 4.0D1 GA(13) = GA(13) + 6.0D1* (X(13)-6.0D0) GA(14) = GA(14) - 1.4D2 RETURN 310 GA(1) = GA(1) + 2.8D2*X(1) GA(15) = GA(15) + 3.5D2 GA(16) = GA(16) - 7.9D2 RETURN 320 GA(2) = GA(2) + 3.0D2*X(2) GA(15) = GA(15) + 1.1D2 GA(16) = GA(16) - 6.1D2 RETURN 330 GA(1) = GA(1) + 1.0D2*X(1) GA(2) = GA(2) + 2.0D1 GA(17) = GA(17) + 3.6D2*X(17)**3 GA(18) = GA(18) - 1.0D1 RETURN 340 GA(1) = GA(1) + 2.0D1*X(1) GA(2) = GA(2) - 1.0D1 GA(19) = GA(19) + 1.9D2 GA(20) = GA(20) - 2.0D2 RETURN 350 GA(1) = GA(1) + 1.4D2*X(1) GA(2) = GA(2) + 1.0D2*X(2) GA(19) = GA(19) + 2.0D1*X(19) GA(20) = GA(20) - 3.0D2 RETURN 360 DO 370 I = 1,N GA(I) = 1.0D0 370 CONTINUE IF (MOD(KA,2).EQ.0) THEN I = (KA+2)/2 GA(I) = GA(I) + 2.0D0*X(I) - 1.0D0 ELSE I = (KA+1)/2 GA(I) = GA(I) + 4.0D0*X(I) - 1.0D0 END IF RETURN 380 K = (N-1)/2 A = Y(KA)**2 S = 1.0D0 IF (KA.GT.62 .AND. KA.LT.124) S = -S DO 390 I = 1,K B = X(I+K)**2 - A P = S* (B*B+A*X(I)**2) GA(I) = A*X(I)/P GA(I+K) = 2.0D0*X(I+K)*B/P 390 CONTINUE GA(N) = -S RETURN 400 P = 5.0D2 A = 0.99D0 GA(1) = 5.04D0 GA(2) = 0.35D-1 GA(3) = 1.00D1 GA(4) = -0.63D-1*X(7) GA(5) = 3.36D0 GA(6) = 0.00D0 GA(7) = -0.63D-1*X(4) GA(8) = 0.00D0 GA(9) = 0.00D0 GA(10) = 0.00D0 GO TO (410,420,430,440,450,460,470,480,490) KA 410 CONTINUE RETURN 420 GA(1) = GA(1) + P* (1.12D0+X(8)* (1.3167D-1-6.67D-3*X(8))) GA(4) = GA(4) - P/A GA(8) = GA(8) + P*X(1)* (1.3167D-1-1.334D-2*X(8)) RETURN 430 GA(1) = GA(1) - P* (1.12D0+X(8)* (1.3167D-1-6.67D-3*X(8))) GA(4) = GA(4) + P*A GA(8) = GA(8) - P*X(1)* (1.3167D-1-1.334D-2*X(8)) RETURN 440 GA(6) = GA(6) + P*0.325D0 GA(7) = GA(7) - P/A GA(8) = GA(8) + P* (1.098D0-0.076D0*X(8)) RETURN 450 GA(6) = GA(6) - P*0.325D0 GA(7) = GA(7) + P*A GA(8) = GA(8) - P* (1.098D0-0.076D0*X(8)) RETURN 460 C = (X(4)*X(9)+1.0D3*X(3))**2 GA(3) = GA(3) + 9.8D4*P*X(4)*X(9)/C GA(4) = GA(4) - 9.8D4*P*X(3)*X(9)/C GA(6) = GA(6) - P GA(9) = GA(9) - 9.8D4*P*X(3)*X(4)/C RETURN 470 C = (X(4)*X(9)+1.0D3*X(3))**2 GA(3) = GA(3) - 9.8D4*P*X(4)*X(9)/C GA(4) = GA(4) + 9.8D4*P*X(3)*X(9)/C GA(6) = GA(6) + P GA(9) = GA(9) + 9.8D4*P*X(3)*X(4)/C RETURN 480 GA(1) = GA(1) - P* (X(2)+X(5))/X(1)**2 GA(2) = GA(2) + P/X(1) GA(5) = GA(5) + P/X(1) GA(8) = GA(8) - P RETURN 490 GA(1) = GA(1) + P* (X(2)+X(5))/X(1)**2 GA(2) = GA(2) - P/X(1) GA(5) = GA(5) - P/X(1) GA(8) = GA(8) + P RETURN 500 P = 1.0D5 GA(1) = Y(1) + Y(2)*X(6) GA(2) = Y(4) GA(3) = Y(3) + Y(6)*X(5) GA(4) = 0.0D0 GA(5) = Y(6)*X(3) GA(6) = Y(2)*X(1) GA(7) = 0.0D0 GO TO (510,520,530,540,550,560,570,580,590, + 600,610,620,630) KA 510 CONTINUE RETURN 520 GA(1) = GA(1) - P*Y(8)*X(3)/X(1)**2 GA(3) = GA(3) + P*Y(8)/X(1) GA(6) = GA(6) + P* (2.0D0*Y(7)*X(6)+Y(9)) RETURN 530 GA(1) = GA(1) + P* (Y(10)+Y(11)*X(6)+Y(12)*X(6)**2)/X(3) GA(3) = GA(3) - P* (Y(10)+Y(11)*X(6)+Y(12)*X(6)**2)*X(1)/X(3)**2 GA(6) = GA(6) + P* (Y(11)+2.0D0*Y(12)*X(6))*X(1)/X(3) RETURN 540 GA(4) = GA(4) + P*Y(15) GA(5) = GA(5) + P*Y(14) GA(6) = GA(6) + P* (2.0D0*Y(13)*X(6)+Y(16)) RETURN 550 GA(4) = GA(4) + P*Y(19)/X(5) GA(5) = GA(5) - P* (Y(17)+Y(18)*X(6)+Y(19)*X(4)+Y(20)*X(6)**2)/ + X(5)**2 GA(6) = GA(6) + P* (Y(18)+2.0D0*Y(20)*X(6))/X(5) RETURN 560 GA(2) = GA(2) + P* (Y(22)/X(4)+Y(23))/X(3) GA(3) = GA(3) - P* (Y(22)/X(4)+Y(23))*X(2)/X(3)**2 GA(4) = GA(4) - P*Y(22)*X(2)/ (X(3)*X(4)**2) GA(7) = GA(7) + P*Y(21) RETURN 570 GA(2) = GA(2) + P* (Y(25)+Y(26)/X(4))/ (X(3)*X(7)) GA(3) = GA(3) - P* (Y(25)+Y(26)/X(4))*X(2)/ (X(3)**2*X(7)) GA(4) = GA(4) - P*Y(26)*X(2)/ (X(3)*X(4)**2*X(7)) GA(7) = GA(7) - P* (Y(24)+ (Y(25)+Y(26)/X(4))*X(2)/X(3))/X(7)**2 RETURN 580 GA(5) = GA(5) - P* (Y(27)+Y(28)*X(7))/X(5)**2 GA(7) = GA(7) + P*Y(28)/X(5) RETURN 590 GA(1) = GA(1) + P*Y(33)/X(3) GA(3) = GA(3) - P* (Y(33)*X(1)+Y(34))/X(3)**2 RETURN 600 GA(2) = GA(2) + P* (Y(35)/X(4)+Y(36))/X(3) GA(3) = GA(3) - P* (Y(35)/X(4)+Y(36))*X(2)/X(3)**2 GA(4) = GA(4) - P*Y(35)*X(2)/ (X(3)*X(4)**2) RETURN 610 GA(2) = GA(2) - P*Y(38)*X(3)*X(4)/X(2)**2 GA(3) = GA(3) + P*Y(38)*X(4)/X(2) GA(4) = GA(4) + P* (Y(37)+Y(38)*X(3)/X(2)) RETURN 620 GA(1) = GA(1) + P* (Y(39)*X(6)+Y(40)) GA(3) = GA(3) + P*Y(41) GA(6) = GA(6) + P*Y(39)*X(1) RETURN 630 GA(1) = GA(1) - P* (Y(42)*X(3)+Y(43))/X(1)**2 GA(3) = GA(3) + P*Y(42)/X(1) GA(6) = GA(6) + P*Y(44) RETURN 640 P = 1.0D5 GA(1) = 1.0D0 GA(2) = 1.0D0 GA(3) = 1.0D0 GA(4) = 0.0D0 GA(5) = 0.0D0 GA(6) = 0.0D0 GA(7) = 0.0D0 GA(8) = 0.0D0 GO TO (650,660,670,680) KA 650 CONTINUE RETURN 660 GA(1) = GA(1) - P* (833.33252D0*X(4)-83333.333D0)/ (X(1)**2*X(6)) GA(4) = GA(4) + P*833.33252D0/ (X(1)*X(6)) GA(6) = GA(6) - P* (833.33252D0*X(4)/X(1)+1.0D2-83333.333D0/X(1))/ + X(6)**2 RETURN 670 GA(2) = GA(2) - P*1.25D3* (X(5)-X(4))/ (X(2)**2*X(7)) GA(4) = GA(4) + P* (1.0D0-1.25D3/X(2))/X(7) GA(5) = GA(5) + P*1.25D3/ (X(2)*X(7)) GA(7) = GA(7) - P* (1.25D3* (X(5)-X(4))/X(2)+X(4))/X(7)**2 RETURN 680 GA(3) = GA(3) - P* (1.25D6-2.5D3*X(5))/ (X(3)**2*X(8)) GA(5) = GA(5) + P* (1.0D0-2.5D3/X(3))/X(8) GA(8) = GA(8) - P* ((1.25D6-2.5D3*X(5))/X(3)+X(5))/X(8)**2 RETURN 690 P = 2.0D3 GA(1) = -1.231060D0*X(12) GA(2) = -1.231060D0*X(13) GA(3) = -1.231060D0*X(14) GA(4) = -1.231060D0*X(15) GA(5) = -1.231060D0*X(16) GA(6) = 0.0D0 GA(7) = 0.0D0 GA(8) = 0.0D0 GA(9) = 0.0D0 GA(10) = 0.0D0 GA(11) = 0.0D0 GA(12) = 1.262626D0 - 1.231060D0*X(1) GA(13) = 1.262626D0 - 1.231060D0*X(2) GA(14) = 1.262626D0 - 1.231060D0*X(3) GA(15) = 1.262626D0 - 1.231060D0*X(4) GA(16) = 1.262626D0 - 1.231060D0*X(5) GO TO (700,710,720,730,740,750,760,770,780, + 790,800,810,820,830,840,850,860,870, + 880) KA 700 CONTINUE RETURN 710 GA(1) = GA(1) + P* (9.75D-1+ (3.475D-2-1.95D-2*X(1))/X(6)) GA(6) = GA(6) - P*X(1)* (3.475D-2-9.75D-3*X(1))/X(6)**2 RETURN 720 GA(2) = GA(2) + P* (9.75D-1+ (3.475D-2-1.95D-2*X(2))/X(7)) GA(7) = GA(7) - P*X(2)* (3.475D-2-9.75D-3*X(2))/X(7)**2 RETURN 730 GA(3) = GA(3) + P* (9.75D-1+ (3.475D-2-1.95D-2*X(3))/X(8)) GA(8) = GA(8) - P*X(3)* (3.475D-2-9.75D-3*X(3))/X(8)**2 RETURN 740 GA(4) = GA(4) + P* (9.75D-1+ (3.475D-2-1.95D-2*X(4))/X(9)) GA(9) = GA(9) - P*X(4)* (3.475D-2-9.75D-3*X(4))/X(9)**2 RETURN 750 GA(5) = GA(5) + P* (9.75D-1+ (3.475D-2-1.95D-2*X(5))/X(10)) GA(10) = GA(10) - P*X(5)* (3.475D-2-9.75D-3*X(5))/X(10)**2 RETURN 760 GA(1) = GA(1) + P*X(12)/ (X(7)*X(11)) GA(6) = GA(6) + P* (1.0D0-X(12)/X(11))/X(7) GA(7) = GA(7) - P* (X(6)+ (X(1)-X(6))*X(12)/X(11))/X(7)**2 GA(11) = GA(11) - P* (X(1)-X(6))*X(12)/ (X(7)*X(11)**2) GA(12) = GA(12) + P* (X(1)-X(6))/ (X(11)*X(7)) RETURN 770 GA(1) = GA(1) - P*2.0D-3*X(12)/X(8) GA(2) = GA(2) + P*2.0D-3*X(13)/X(8) GA(7) = GA(7) + P* (1.0D0+2.0D-3*X(12))/X(8) GA(8) = GA(8) - P* (X(7)+2.0D-3* ((X(7)-X(1))*X(12)+X(2)*X(13)))/ + X(8)**2 GA(12) = GA(12) + P*2.0D-3* (X(7)-X(1))/X(8) GA(13) = GA(13) + P*2.0D-3* (X(2)/X(8)-1.0D0) RETURN 780 GA(2) = GA(2) - P*2.0D-3*X(13) GA(3) = GA(3) + P*2.0D-3*X(14) GA(8) = GA(8) + P* (1.0D0+2.0D-3*X(13)) GA(9) = GA(9) + P* (1.0D0-2.0D-3*X(14)) GA(13) = GA(13) + P*2.0D-3* (X(8)-X(2)) GA(14) = GA(14) + P*2.0D-3* (X(3)-X(9)) RETURN 790 GA(3) = GA(3) - P* (X(9)+ ((X(4)-X(8))*X(15)+5.0D2* (X(10)-X(9)))/ + X(14))/X(3)**2 GA(4) = GA(4) + P*X(15)/ (X(3)*X(14)) GA(8) = GA(8) - P*X(15)/ (X(3)*X(14)) GA(9) = GA(9) + P* (1.0D0-5.0D2/X(14))/X(3) GA(10) = GA(10) + P*5.0D2/ (X(3)*X(14)) GA(14) = GA(14) - P* ((X(4)-X(8))*X(15)+5.0D2* (X(10)-X(9)))/ + (X(3)*X(14)**2) GA(15) = GA(15) + P* (X(4)-X(8))/ (X(3)*X(14)) RETURN 800 GA(4) = GA(4) - P* (X(10)+ (X(5)*X(16)-5.0D2*X(10))/X(15))/X(4)**2 GA(5) = GA(5) + P*X(16)/ (X(4)*X(15)) GA(10) = GA(10) + P* (1.0D0-5.0D2/X(15))/X(4) GA(15) = GA(15) - P* (5.0D2-X(16)+ (X(5)*X(16)-5.0D2*X(10))/X(4))/ + X(15)**2 GA(16) = GA(16) + P* (X(5)/X(4)-1.0D0)/X(15) RETURN 810 GA(4) = GA(4) - P* (9.0D-1-2.0D-3*X(5)*X(16))/X(4)**2 GA(5) = GA(5) - P*2.0D-3*X(16)/X(4) GA(16) = GA(16) + P*2.0D-3* (1.0D0-X(5)/X(4)) RETURN 820 GA(11) = GA(11) - P*X(12)/X(11)**2 GA(12) = GA(12) + P/X(11) RETURN 830 GA(4) = GA(4) + P/X(5) GA(5) = GA(5) - P*X(4)/X(5)**2 RETURN 840 GA(3) = GA(3) + P/X(4) GA(4) = GA(4) - P*X(3)/X(4)**2 RETURN 850 GA(2) = GA(2) + P/X(3) GA(3) = GA(3) - P*X(2)/X(3)**2 RETURN 860 GA(1) = GA(1) + P/X(2) GA(2) = GA(2) - P*X(1)/X(2)**2 RETURN 870 GA(9) = GA(9) + P/X(10) GA(10) = GA(10) - P*X(9)/X(10)**2 RETURN 880 GA(8) = GA(8) + P/X(9) GA(9) = GA(9) - P*X(8)/X(9)**2 RETURN END * SUBROUTINE TAHD22 ALL SYSTEMS 99/12/01 C PORTABILITY : ALL SYSTEMS C 95/12/01 LU : ORIGINAL VERSION * * PURPOSE : * HESSIAN MATRICES OF PARTIAL FUNCTIONS IN THE MINIMAX CRITERION. * DENSE VERSION. * * PARAMETERS : * II N NUMBER OF VARIABLES. * II KA INDEX OF THE PARTIAL FUNCTION. * RI X(N) VECTOR OF VARIABLES. * RO HA(N*(N+1)/2) GRADIENT OF THE PARTIAL FUNCTION * AT THE SELECTED POINT. * II NEXT NUMBER OF THE TEST PROBLEM. * SUBROUTINE TAHD22(N,KA,X,HA,NEXT) C .. Scalar Arguments .. INTEGER KA,N,NEXT C .. C .. Array Arguments .. DOUBLE PRECISION HA(N* (N+1)/2),X(N) C .. C .. Arrays in Common .. DOUBLE PRECISION Y(163) C .. C .. Local Scalars .. DOUBLE PRECISION A,B,C,P,Q,R,S INTEGER I,J,K,KK,L,LL C .. C .. Intrinsic Functions .. INTRINSIC COS,EXP,MOD,SIN,SINH,SQRT C .. C .. Common blocks .. COMMON /EMPR22/Y C .. GO TO (10,10,50,50,90,140,170,230,310, + 410,430,460,570,710,770) NEXT 10 GO TO (20,30,40) KA 20 HA(1) = 2.0D0 HA(2) = 1.0D0 HA(3) = 2.0D0 RETURN 30 HA(1) = -SIN(X(1)) HA(2) = 0.0D0 HA(3) = 0.0D0 RETURN 40 HA(1) = 0.0D0 HA(2) = 0.0D0 HA(3) = COS(X(2)) RETURN 50 GO TO (60,70,80) KA 60 HA(1) = -EXP(X(1)-X(2)) HA(2) = EXP(X(1)-X(2)) HA(3) = -EXP(X(1)-X(2)) RETURN 70 HA(1) = SINH(X(1)-1.0D0) HA(2) = 0.0D0 HA(3) = 0.0D0 RETURN 80 HA(1) = 0.0D0 HA(2) = 0.0D0 HA(3) = 1.0D0/X(2)**2 RETURN 90 DO 100 I = 1,N* (N+1)/2 HA(I) = 0.0D0 100 CONTINUE GO TO (110,120,130) KA 110 A = SQRT((X(1)-X(3))**2+ (X(2)-X(4))**2) B = (X(1)-X(3))/A C = (X(2)-X(4))/A HA(1) = -1.0D0/A + B*B/A HA(2) = B*C/A HA(3) = -1.0D0/A + C*C/A HA(4) = -HA(1) HA(5) = -HA(2) HA(6) = HA(1) HA(7) = -HA(2) HA(8) = -HA(3) HA(9) = HA(3) HA(10) = HA(3) RETURN 120 A = SQRT((X(3)-X(5))**2+ (X(4)-X(6))**2) B = (X(3)-X(5))/A C = (X(4)-X(6))/A HA(6) = -1.0D0/A + B*B/A HA(9) = B*C/A HA(10) = -1.0D0/A + C*C/A HA(13) = -HA(6) HA(14) = -HA(9) HA(15) = HA(6) HA(18) = -HA(9) HA(19) = -HA(10) HA(20) = HA(9) HA(21) = HA(10) RETURN 130 A = SQRT((X(5)-X(1))**2+ (X(6)-X(2))**2) B = (X(5)-X(1))/A C = (X(6)-X(2))/A HA(1) = -1.0D0/A + B*B/A HA(2) = B*C/A HA(3) = -1.0D0/A + C*C/A HA(11) = -HA(1) HA(12) = -HA(2) HA(15) = HA(1) HA(16) = -HA(2) HA(17) = -HA(3) HA(20) = HA(2) HA(21) = HA(3) RETURN 140 DO 150 I = 1,N* (N+1)/2 HA(I) = 0.0D0 150 CONTINUE DO 160 I = 1,N J = I* (I+1)/2 HA(J) = -2.0D0*Y(KA)*Y(KA)*COS(Y(KA)*X(I))/1.5D1 160 CONTINUE RETURN 170 DO 180 I = 1,N* (N+1)/2 HA(I) = 0.0D0 180 CONTINUE K = 0 DO 220 I = 1,5 A = 0.0D0 P = 0.0D0 DO 190 J = 1,N A = A + Y(K+J)*X(J)** (1.0D0-Y(I+80)) P = P + Y(K+J+40)*X(J) 190 CONTINUE B = Y(K+KA)/ (X(KA)**Y(I+80)*A) C = B*Y(I+80)/X(KA) KK = 0 DO 210 J = 1,N Q = Y(K+J)* (1.0D0-Y(I+80))/ (X(J)**Y(I+80)*A) DO 200 L = 1,J R = Y(K+L)* (1.0D0-Y(I+80))/ (X(L)**Y(I+80)*A) KK = KK + 1 HA(KK) = HA(KK) + B* (2.0D0*P*Q*R-Q*Y(K+L+40)- + R*Y(K+J+40)) IF (J.EQ.L) HA(KK) = HA(KK) + C*Q*P IF (L.EQ.KA) HA(KK) = HA(KK) - C* (Y(K+J+40)-Q*P) IF (J.EQ.KA) HA(KK) = HA(KK) - C* (Y(K+L+40)-R*P) 200 CONTINUE 210 CONTINUE KK = KA* (KA+1)/2 Q = Y(K+KA)* (1.0D0-Y(I+80))/ (X(KA)**Y(I+80)*A) HA(KK) = HA(KK) + C*P* (1.0D0+Y(I+80))/X(KA) K = K + N 220 CONTINUE RETURN 230 DO 240 I = 1,N* (N+1)/2 HA(I) = 0.0D0 240 CONTINUE HA(1) = 2.0D0 HA(2) = 1.0D0 HA(3) = 2.0D0 HA(6) = 2.0D0 HA(10) = 8.0D0 HA(15) = 2.0D0 HA(21) = 4.0D0 HA(28) = 1.0D1 HA(36) = 1.4D1 HA(45) = 4.0D0 HA(55) = 2.0D0 GO TO (300,250,260,270,280,290) KA 250 HA(1) = HA(1) + 6.0D1 HA(3) = HA(3) + 8.0D1 HA(6) = HA(6) + 4.0D1 RETURN 260 HA(1) = HA(1) + 1.0D2 HA(6) = HA(6) + 2.0D1 RETURN 270 HA(1) = HA(1) + 1.0D1 HA(3) = HA(3) + 4.0D1 HA(15) = HA(15) + 6.0D1 RETURN 280 HA(1) = HA(1) + 1.0D1 HA(2) = HA(2) - 2.0D1 HA(3) = HA(3) + 4.0D1 RETURN 290 HA(45) = HA(45) + 2.4D2 300 RETURN 310 DO 320 I = 1,N* (N+1)/2 HA(I) = 0.0D0 320 CONTINUE HA(1) = 2.0D0 HA(2) = 1.0D0 HA(3) = 2.0D0 HA(6) = 2.0D0 HA(10) = 8.0D0 HA(15) = 2.0D0 HA(21) = 4.0D0 HA(28) = 1.0D1 HA(36) = 1.4D1 HA(45) = 4.0D0 HA(55) = 2.0D0 HA(66) = 2.0D0 HA(78) = 2.0D1 HA(91) = 1.0D1 HA(105) = 8.0D0 HA(120) = 5.4D1 HA(136) = 1.2D1*X(16)**2 HA(153) = 2.0D0 HA(171) = 2.6D1 HA(190) = 2.0D0 HA(210) = 2.0D0 GO TO (300,250,260,270,280,290,330,340,350,360,370, + 380,390,400) KA 330 HA(1) = HA(1) + 2.0D1 RETURN 340 HA(91) = HA(91) + 1.0D2 RETURN 350 HA(91) = HA(91) + 6.0D1 RETURN 360 HA(1) = HA(1) + 2.8D2 RETURN 370 HA(3) = HA(3) + 3.0D2 RETURN 380 HA(1) = HA(1) + 1.0D2 HA(153) = HA(153) + 10.8D2*X(17)**2 RETURN 390 HA(1) = HA(1) + 2.0D1 RETURN 400 HA(1) = HA(1) + 1.4D2 HA(3) = HA(3) + 1.0D2 HA(190) = HA(190) + 2.0D1 RETURN 410 DO 420 I = 1,N* (N+1)/2 HA(I) = 0.0D0 420 CONTINUE IF (MOD(KA,2).EQ.0) THEN I = (KA+2)/2 J = I* (I+1)/2 HA(J) = HA(J) + 2.0D0 ELSE I = (KA+1)/2 J = I* (I+1)/2 HA(J) = HA(J) + 4.0D0 END IF RETURN 430 DO 440 I = 1,N* (N+1)/2 HA(I) = 0.0D0 440 CONTINUE K = (N-1)/2 KK = K* (K+1)/2 A = Y(KA)**2 L = 0 LL = KK S = 1.0D0 IF (KA.GT.62 .AND. KA.LT.124) S = -S DO 450 I = 1,K L = L + I B = X(I+K)**2 - A C = A*X(I)**2 P = B*B + C Q = B*B - C R = S*P*P HA(L) = A*Q/R HA(L+LL) = -4.0D0*A*B*X(I)*X(I+K)/R LL = LL + K HA(L+LL) = 2.0D0*S*B/P - 4.0D0*Q*X(I+K)**2/R 450 CONTINUE RETURN 460 P = 5.0D2 A = 0.99D0 DO 470 I = 1,N* (N+1)/2 HA(I) = 0.0D0 470 CONTINUE HA(25) = -0.63D-1 GO TO (480,490,500,510,520,530,540,550,560) KA 480 CONTINUE RETURN 490 HA(29) = P* (1.3167D-1-1.334D-2*X(8)) HA(36) = -P*X(1)*1.334D-2 RETURN 500 HA(29) = -P* (1.3167D-1-1.334D-2*X(8)) HA(36) = P*X(1)*1.334D-2 RETURN 510 HA(36) = -0.76D-1*P RETURN 520 HA(36) = 0.76D-1*P RETURN 530 C = (X(4)*X(9)+1.0D3*X(3))**3 Q = (X(4)*X(9)-1.0D3*X(3)) HA(6) = -1.96D8*P*X(4)*X(9)/C HA(9) = -9.80D4*P*X(9)*Q/C HA(10) = 1.96D5*P*X(3)*X(9)**2/C HA(39) = -9.80D4*P*X(4)*Q/C HA(40) = 9.80D4*P*X(3)*Q/C HA(45) = 1.96D5*P*X(3)*X(4)**2/C RETURN 540 C = (X(4)*X(9)+1.0D3*X(3))**3 Q = (X(4)*X(9)-1.0D3*X(3)) HA(6) = 1.96D8*P*X(4)*X(9)/C HA(9) = 9.80D4*P*X(9)*Q/C HA(10) = -1.96D5*P*X(3)*X(9)**2/C HA(39) = 9.80D4*P*X(4)*Q/C HA(40) = -9.80D4*P*X(3)*Q/C HA(45) = -1.96D5*P*X(3)*X(4)**2/C RETURN 550 HA(1) = 2.0D0*P* (X(2)+X(5))/X(1)**3 HA(2) = -P/X(1)**2 HA(11) = -P/X(1)**2 RETURN 560 HA(1) = -2.0D0*P* (X(2)+X(5))/X(1)**3 HA(2) = P/X(1)**2 HA(11) = P/X(1)**2 RETURN 570 P = 1.0D5 DO 580 I = 1,N* (N+1)/2 HA(I) = 0.0D0 580 CONTINUE HA(13) = Y(6) HA(16) = Y(2) GO TO (730,590,600,610,620,630,640,650,660, + 670,680,690,700) KA 590 HA(1) = 2.0D0*P*Y(8)*X(3)/X(1)**3 HA(4) = -P*Y(8)/X(1)**2 HA(21) = 2.0D0*P*Y(7) RETURN 600 HA(4) = -P* (Y(10)+Y(11)*X(6)+Y(12)*X(6)**2)/X(3)**2 HA(6) = 2.0D0*P* (Y(10)+Y(11)*X(6)+Y(12)*X(6)**2)*X(1)/X(3)**3 HA(16) = HA(16) + P* (Y(11)+2.0D0*Y(12)*X(6))/X(3) HA(18) = -P* (Y(11)+2.0D0*Y(12)*X(6))*X(1)/X(3)**2 HA(21) = 2.0D0*P*Y(12)*X(1)/X(3) RETURN 610 HA(21) = 2.0D0*P*Y(13) RETURN 620 HA(14) = -P*Y(19)/X(5)**2 HA(15) = 2.0D0*P* (Y(17)+Y(18)*X(6)+Y(19)*X(4)+Y(20)*X(6)**2)/ + X(5)**3 HA(20) = -P* (Y(18)+2.0D0*Y(20)*X(6))/X(5)**2 HA(21) = 2.0D0*P*Y(20)/X(5) RETURN 630 HA(5) = -P* (Y(22)/X(4)+Y(23))/X(3)**2 HA(6) = 2.0D0*P* (Y(22)/X(4)+Y(23))*X(2)/X(3)**3 HA(8) = -P*Y(22)/ (X(3)*X(4)**2) HA(9) = P*Y(22)*X(2)/ (X(3)*X(4))**2 HA(10) = 2.0D0*P*Y(22)*X(2)/ (X(3)*X(4)**3) RETURN 640 HA(5) = -P* (Y(25)+Y(26)/X(4))/ (X(3)**2*X(7)) HA(6) = 2.0D0*P* (Y(25)+Y(26)/X(4))*X(2)/ (X(3)**3*X(7)) HA(8) = -P*Y(26)/ (X(3)*X(4)**2*X(7)) HA(9) = P*Y(26)*X(2)/ ((X(3)*X(4))**2*X(7)) HA(10) = 2.0D0*P*Y(26)*X(2)/ (X(3)*X(4)**3*X(7)) HA(23) = -P* (Y(25)+Y(26)/X(4))/ (X(3)*X(7)**2) HA(24) = P* (Y(25)+Y(26)/X(4))*X(2)/ (X(3)*X(7))**2 HA(25) = P*Y(26)*X(2)/ (X(3)* (X(4)*X(7))**2) HA(28) = 2.0D0*P* (Y(24)+ (Y(25)+Y(26)/X(4))*X(2)/X(3))/X(7)**3 RETURN 650 HA(15) = 2.0D0*P* (Y(27)+Y(28)*X(7))/X(5)**3 HA(26) = -P*Y(28)/X(5)**2 RETURN 660 HA(4) = -P*Y(33)/X(3)**2 HA(6) = 2.0D0*P* (Y(33)*X(1)+Y(34))/X(3)**3 RETURN 670 HA(5) = -P* (Y(35)/X(4)+Y(36))/X(3)**2 HA(6) = 2.0D0*P* (Y(35)/X(4)+Y(36))*X(2)/X(3)**3 HA(8) = -P*Y(35)/ (X(3)*X(4)**2) HA(9) = P*Y(35)*X(2)/ (X(3)*X(4))**2 HA(10) = 2.0D0*P*Y(35)*X(2)/ (X(3)*X(4)**3) RETURN 680 HA(3) = 2.0D0*P*Y(38)*X(3)*X(4)/X(2)**3 HA(5) = -P*Y(38)*X(4)/X(2)**2 HA(8) = -P*Y(38)*X(3)/X(2)**2 HA(9) = P*Y(38)/X(2) RETURN 690 HA(16) = HA(16) + P*Y(39) RETURN 700 HA(1) = 2.0D0*P* (Y(42)*X(3)+Y(43))/X(1)**3 HA(4) = -P*Y(42)/X(1)**2 RETURN 710 P = 1.0D5 DO 720 I = 1,N* (N+1)/2 HA(I) = 0.0D0 720 CONTINUE GO TO (730,740,750,760) KA 730 CONTINUE RETURN 740 HA(1) = 2.0D0*P* (833.33252D0*X(4)-83333.333D0)/ (X(1)**3*X(6)) HA(7) = -P*833.33252D0/ (X(1)**2*X(6)) HA(16) = P* (833.33252D0*X(4)-83333.333D0)/ (X(1)**2*X(6)**2) HA(19) = -P*833.33252D0/ (X(1)*X(6)**2) HA(21) = 2.0D0*P* (833.33252D0*X(4)/X(1)+1.0D2-83333.333D0/X(1))/ + X(6)**3 RETURN 750 HA(3) = P*2.50D3* (X(5)-X(4))/ (X(2)**3*X(7)) HA(8) = P*1.25D3/ (X(2)**2*X(7)) HA(12) = -P*1.25D3/ (X(2)**2*X(7)) HA(23) = P*1.25D3* (X(5)-X(4))/ (X(2)**2*X(7)**2) HA(25) = -P* (1.0D0-1.25D3/X(2))/X(7)**2 HA(26) = -P*1.25D3/ (X(2)*X(7)**2) HA(28) = 2.0D0*P* (1.25D3* (X(5)-X(4))/X(2)+X(4))/X(7)**3 RETURN 760 HA(6) = 2.0D0*P* (1.25D6-2.5D3*X(5))/ (X(3)**3*X(8)) HA(13) = P*2.5D3/ (X(3)**2*X(8)) HA(31) = P* (1.25D6-2.5D3*X(5))/ (X(3)**2*X(8)**2) HA(33) = -P* (1.00D0-2.5D3/X(3))/X(8)**2 HA(36) = 2.0D0*P* ((1.25D6-2.5D3*X(5))/X(3)+X(5))/X(8)**3 RETURN 770 P = 2.0D3 DO 780 I = 1,N* (N+1)/2 HA(I) = 0.0D0 780 CONTINUE HA(67) = -1.231060D0 HA(80) = -1.231060D0 HA(94) = -1.231060D0 HA(109) = -1.231060D0 HA(125) = -1.231060D0 GO TO (730,790,800,810,820,830,840,850,860,870, + 880,890,900,910,920,930,940,950,960) KA 790 HA(1) = -P*1.95D-2/X(6) HA(16) = -P* (3.475D-2-1.95D-2*X(1))/X(6)**2 HA(21) = 2.0D0*P*X(1)* (3.475D-2-9.75D-3*X(1))/X(6)**3 RETURN 800 HA(3) = -P*1.95D-2/X(7) HA(23) = -P* (3.475D-2-1.95D-2*X(2))/X(7)**2 HA(28) = 2.0D0*P*X(2)* (3.475D-2-9.75D-3*X(2))/X(7)**3 RETURN 810 HA(6) = -P*1.95D-2/X(8) HA(31) = -P* (3.475D-2-1.95D-2*X(3))/X(8)**2 HA(36) = 2.0D0*P*X(3)* (3.475D-2-9.75D-3*X(3))/X(8)**3 RETURN 820 HA(10) = -P*1.95D-2/X(9) HA(40) = -P* (3.475D-2-1.95D-2*X(4))/X(9)**2 HA(45) = 2.0D0*P*X(4)* (3.475D-2-9.75D-3*X(4))/X(9)**3 RETURN 830 HA(15) = -P*1.95D-2/X(10) HA(50) = -P* (3.475D-2-1.95D-2*X(5))/X(10)**2 HA(55) = 2.0D0*P*X(5)* (3.475D-2-9.75D-3*X(5))/X(10)**3 RETURN 840 HA(22) = -P*X(12)/ (X(11)*X(7)**2) HA(27) = -P* (1.0D0-X(12)/X(11))/X(7)**2 HA(28) = 2.0D0*P* (X(6)+ (X(1)-X(6))*X(12)/X(11))/X(7)**3 HA(56) = -P*X(12)/ (X(7)*X(11)**2) HA(61) = P*X(12)/ (X(7)*X(11)**2) HA(62) = P* (X(1)-X(6))*X(12)/ (X(11)*X(7))**2 HA(66) = 2.0D0*P* (X(1)-X(6))*X(12)/ (X(7)*X(11)**3) HA(67) = HA(67) + P/ (X(11)*X(7)) HA(72) = -P/ (X(11)*X(7)) HA(73) = -P* (X(1)-X(6))/ (X(11)*X(7)**2) HA(77) = -P* (X(1)-X(6))/ (X(7)*X(11)**2) RETURN 850 HA(29) = 2.0D-3*P*X(12)/X(8)**2 HA(30) = -2.0D-3*P*X(13)/X(8)**2 HA(35) = -P* (1.0D0+2.0D-3*X(12))/X(8)**2 HA(36) = 2.0D0*P* (X(7)+2.0D-3* ((X(7)-X(1))*X(12)+X(2)*X(13)))/ + X(8)**3 HA(67) = HA(67) - 2.0D-3*P/X(8) HA(73) = 2.0D-3*P/X(8) HA(74) = -2.0D-3*P* (X(7)-X(1))/X(8)**2 HA(80) = HA(80) + 2.0D-3*P/X(8) HA(86) = -2.0D-3*P*X(2)/X(8)**2 RETURN 860 HA(80) = HA(80) - P*2.0D-3 HA(86) = P*2.0D-3 HA(94) = HA(94) + P*2.0D-3 HA(100) = -P*2.0D-3 RETURN 870 HA(6) = 2.0D0*P* (X(9)+ ((X(4)-X(8))*X(15)+5.0D2* (X(10)-X(9)))/ + X(14))/X(3)**3 HA(9) = -P*X(15)/ (X(14)*X(3)**2) HA(31) = P*X(15)/ (X(14)*X(3)**2) HA(39) = -P* (1.0D0-5.0D2/X(14))/X(3)**2 HA(48) = -5.0D2*P/ (X(14)*X(3)**2) HA(94) = HA(94) + P* ((X(4)-X(8))*X(15)+5.0D2* (X(10)-X(9)))/ + (X(14)*X(3))**2 HA(95) = -P*X(15)/ (X(3)*X(14)**2) HA(99) = P*X(15)/ (X(3)*X(14)**2) HA(100) = 5.0D2*P/ (X(3)*X(14)**2) HA(101) = -5.0D2*P/ (X(3)*X(14)**2) HA(105) = 2.0D0*P* ((X(4)-X(8))*X(15)+5.0D2* (X(10)-X(9)))/ + (X(3)*X(14)**3) HA(108) = -P* (X(4)-X(8))/ (X(14)*X(3)**2) HA(109) = HA(109) + P/ (X(3)*X(14)) HA(113) = -P/ (X(3)*X(14)) HA(119) = -P* (X(4)-X(8))/ (X(3)*X(14)**2) RETURN 880 HA(10) = 2.0D0*P* (X(10)+ (X(5)*X(16)-5.0D2*X(10))/X(15))/X(4)**3 HA(14) = -P*X(16)/ (X(15)*X(4)**2) HA(49) = -P* (1.0D0-5.0D2/X(15))/X(4)**2 HA(109) = HA(109) + P* (X(5)*X(16)-5.0D2*X(10))/ (X(15)*X(4))**2 HA(110) = -P*X(16)/ (X(4)*X(15)**2) HA(115) = 5.0D2*P/ (X(4)*X(15)**2) HA(120) = 2.0D0*P* (5.0D2-X(16)+ (X(5)*X(16)-5.0D2*X(10))/X(4))/ + X(15)**3 HA(124) = -P*X(5)/ (X(15)*X(4)**2) HA(125) = HA(125) + P/ (X(4)*X(15)) HA(135) = -P* (X(5)/X(4)-1.0D0)/X(15)**2 RETURN 890 HA(10) = 2.0D0*P* (9.0D-1-2.0D-3*X(5)*X(16))/X(4)**3 HA(14) = P* (2.0D-3*X(16))/X(4)**2 HA(124) = P* (2.0D-3*X(5))/X(4)**2 HA(125) = HA(125) - P*2.0D-3/X(4) RETURN 900 HA(66) = 2.0D0*P*X(12)/X(11)**3 HA(77) = -P/X(11)**2 RETURN 910 HA(14) = -P/X(5)**2 HA(15) = 2.0D0*P*X(4)/X(5)**3 RETURN 920 HA(9) = -P/X(4)**2 HA(10) = 2.0D0*P*X(3)/X(4)**3 RETURN 930 HA(5) = -P/X(3)**2 HA(6) = 2.0D0*P*X(2)/X(3)**3 RETURN 940 HA(2) = -P/X(2)**2 HA(3) = 2.0D0*P*X(1)/X(2)**3 RETURN 950 HA(54) = -P/X(10)**2 HA(55) = 2.0D0*P*X(9)/X(10)**3 RETURN 960 HA(44) = -P/X(9)**2 HA(45) = 2.0D0*P*X(8)/X(9)**3 RETURN END * SUBROUTINE TYTIM1 MS DOS 91/12/01 C PORTABILITY : MS DOS / MS FORTRAN v.5.0 C 91/12/01 SI : ORIGINAL VERSION * * PURPOSE : * GET TIME IN 100TH OF SEC. * SUBROUTINE TYTIM1(ITIME) C .. Scalar Arguments .. INTEGER ITIME C .. C .. Local Scalars .. C INTEGER*2 I100TH,IHR,IMIN,ISEC C .. C .. External Subroutines .. C EXTERNAL GETTIM C .. C CALL GETTIM(IHR,IMIN,ISEC,I100TH) C ITIME = 100* (IHR*60*60+IMIN*60+ISEC) + I100TH ITIME = 0 END * SUBROUTINE TYTIM2 ALL SYSTEMS 91/12/01 C PORTABILITY : ALL SYSTEMS C 91/12/01 SI : ORIGINAL VERSION * * PURPOSE : * PRINT TIME ELAPSED. * SUBROUTINE TYTIM2(ITIME) C .. Scalar Arguments .. INTEGER ITIME C .. C .. Local Scalars .. INTEGER IHR,IMIN,ISEC,IT C .. C .. External Subroutines .. EXTERNAL TYTIM1 C .. C CALL TYTIM1(IT) C IT = IT - ITIME C IHR = IT/ (60*60*100) C IT = IT - IHR*60*60*100 C IMIN = IT/ (60*100) C IT = IT - IMIN*60*100 C ISEC = IT/100 C IT = IT - ISEC*100 C WRITE (6,FMT=9000) IHR,IMIN,ISEC,IT C9000 FORMAT (' TIME=',I2,':',I2.2,':',I2.2,'.',I2.2) END SHAR_EOF fi # end of overwriting check cd .. if test ! -d 'Src' then mkdir 'Src' fi cd 'Src' if test -f 'src.f' then echo shar: will not over-write existing file "'src.f'" else cat << "SHAR_EOF" > 'src.f' ************************************************************************ * SUBROUTINE PMINU ALL SYSTEMS 97/01/22 * PURPOSE : * EASY TO USE SUBROUTINE FOR UNCONSTRAINED MINIMAX OPTIMIZATION. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NA NUMBER OF LINEAR APPROXIMATED FUNCTIONS. * RI X(NF) VECTOR OF VARIABLES. * RO AF(NA) VECTOR CONTAINING VALUES OF THE APPROXIMATED * FUNCTIONS. * IA IA(NA+NF+1) AUXILIARY ARRAY. * RA RA((NF+NA+8)*NF+2*NA+4) AUXILIARY ARRAY. * II IPAR(7) INTEGER PAREMETERS: * IPAR(1) SCALING OF THE BFGS UPDATE. IPAR(1)=1-NO SCALING. * IPAR(1)=2-SCALING IN THE FIRST ITERATION. * IPAR(1)=3-CONTROLLED SCALING. * IPAR(2) CORRECTION OF THE BFGS UPDATE IF A NEGATIVE CURVATURE * OCCURS. IPAR(2)=1-NO CORRECTION. IPAR(2)=2-POWELL'S * CORRECTION. * IPAR(3) RESTART AFTER UNSUCCESSFUL UPDATE. IPAR(3)=0-RESTART * SUPPRESSED. IPAR(3)=1-RESTART PERFORMED. * IPAR(4) INTERPOLATION IN LINE SEARCH. IPAR(4)=1-BISECTION. * IPAR(4)=2-TWO POINT QUADRATIC INTERPOLATION. IPAR(4)=3-THREE * POINT QUADRATIC INTERPOLATION. IPAR(4)=4-THREE POINT CUBIC * INTERPOLATION. * IPAR(5) MAXIMUM NUMBER OF ITERATIONS. * IPAR(6) MAXIMUM NUMBER OF FUNCTION EVALUATIONS. * IPAR(7) PRINT SPECIFICATION. IPAR(7)=0-NO PRINT. * ABS(IPAR(7))=1-PRINT OF FINAL RESULTS. * ABS(IPAR(7))=2-PRINT OF FINAL RESULTS AND ITERATIONS. * IPAR(7)>0-BASIC FINAL RESULTS. IPAR(7)<0-EXTENDED FINAL * RESULTS. * RI RPAR(7) REAL PARAMETERS: * RPAR(1) TOLERANCE FOR CHANGE OF VARIABLES. * RPAR(2) TOLERANCE FOR CHANGE OF FUNCTION VALUES. * RPAR(3) TOLERANCE FOR THE FUNCTION FALUE. * RPAR(4) TOLERANCE FOR THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RPAR(5) TOLERANCE FOR A DESCENT DIRECTION. * RPAR(6) TOLERANCE FOR A FUNCTION DECREASE IN THE LINE SEARCH. * RPAR(7) MAXIMUM STEPSIZE. * RO F VALUE OF THE OBJECTIVE FUNCTION. * RO GMAX MAXIMUM PARTIAL DERIVATIVE. * II IEXT TYPE OF OBJECTIVE FUNCTION. IEXT<0-MAXIMUM OF POSITIVE * VALUES. IEXT=0-MAXIMUM OF ABSOLUTE VALUES. IEXT>0-MAXIMUM * OF NEGATIVE VALUES. * IO ITERM CAUSE OF TERMINATION. * * VARIABLES IN COMMON /STAT/ (STATISTICS) : * IO NDECF NUMBER OF MATRIX DECOMPOSITION. * IO NRES NUMBER OF RESTARTS. * IO NRED NUMBER OF MINOR ITERATIONS. * IO NREM NUMBER OF CONSTRAINT DELETIONS. * IO NADD NUMBER OF CONSTRAINT ADDITIONS. * IO NIT NUMBER OF ITERATIONS. * IO NFV NUMBER OF FUNCTION EVALUATIONS. * IO NFG NUMBER OF GRADIENT EVALUATIONS. * IO NFH NUMBER OF HESSIAN EVALUATIONS. * * SUBPROGRAMS USED : * S PMIN RECURSIVE QUADRATIC PROGRAMMING METHOD WITH THE BFGS * VARIABLE METRIC UPDATE. * * EXTERNAL SUBROUTINES : * SE FUN CONPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION. * CALLING SEQUENCE: CALL FUN(NF,KA,X,FA) WHERE NF IS A NUMBER * OF VARIABLES, KA IS THE INDEX OF THE APPROXIMATED FUNCTION, * X(NF) IS A VECTOR OF VARIABLES AND FA IS THE VALUE OF THE * APPROXIMATED FUNCTION. * SE DER CONPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION. * CALLING SEQUENCE: CALL DER(NF,KA,X,GA) WHERE NF IS A NUMBER * OF VARIABLES, KA IS THE INDEX OF THE APPROXIMATED FUNCTION, * X(NF) IS A VECTOR OF VARIABLES AND GA(NF) IS THE GRADIENT OF * THE APPROXIMATED FUNCTION. * SUBROUTINE PMINU(NF,NA,X,AF,IA,RA,IPAR,RPAR,F,GMAX,IEXT,ITERM) C .. Scalar Arguments .. DOUBLE PRECISION F,GMAX INTEGER IEXT,ITERM,NA,NF C .. C .. Array Arguments .. DOUBLE PRECISION AF(*),RA(*),RPAR(7),X(*) INTEGER IA(*),IPAR(7) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. INTEGER LAFD,LAFO,LAG,LAR,LAZ,LG,LGA,LGO,LH,LIA,LIAA,LS,LXO,NB,NC C .. C .. External Subroutines .. EXTERNAL PMIN C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. NB = 0 NC = 0 * * POINTERS FOR AUXILIARY ARRAYS * LAFO = 1 LAFD = LAFO + NA LGA = LAFD + NA LAG = LGA + NF LAR = LAG + NF*NA LAZ = LAR + (NF+1)* (NF+2)/2 LG = LAZ + NF + 1 LH = LG + NF + 1 LS = LH + NF* (NF+1)/2 LXO = LS + NF + 1 LGO = LXO + NF LIA = 1 LIAA = LIA + NA CALL PMIN(NF,NA,NB,NC,X,IA,RA,RA,RA,IA,RA,RA,RA,RA,AF,IA,RA(LAFO), + RA(LAFD),RA(LGA),RA(LAG),IA(LIAA),RA(LAR),RA(LAZ), + RA(LG),RA(LH),RA(LS),RA(LXO),RA(LGO),RPAR(1),RPAR(2), + RPAR(3),RPAR(4),RPAR(5),RPAR(6),RPAR(7),GMAX,F,IEXT, + IPAR(1),IPAR(2),IPAR(3),IPAR(4),IPAR(5),IPAR(6),IPAR(7), + ITERM) RETURN END ************************************************************************ * SUBROUTINE PMINS ALL SYSTEMS 97/01/22 * PURPOSE : * EASY TO USE SUBROUTINE FOR MINIMAX OPTIMIZATION WITH SIMPLE BOUNDS. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NA NUMBER OF LINEAR APPROXIMATED FUNCTIONS. * II NB CHOICE OF SIMPLE BOUNDS. NB=0-SIMPLE BOUNDS SUPPRESSED. * NB>0-SIMPLE BOUNDS ACCEPTED. * RI X(NF) VECTOR OF VARIABLES. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. IX(I)=0-VARIABLE * X(I) IS UNBOUNDED. IX(I)=1-LOVER BOUND XL(I).LE.X(I). * IX(I)=2-UPPER BOUND X(I).LE.XU(I). IX(I)=3-TWO SIDE BOUND * XL(I).LE.X(I).LE.XU(I). IX(I)=5-VARIABLE X(I) IS FIXED. * RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * RO AF(NA) VECTOR CONTAINING VALUES OF THE APPROXIMATED * FUNCTIONS. * IA IA(NA+NF+1) AUXILIARY ARRAY. * RA RA((NF+NA+8)*NF+2*NA+4) AUXILIARY ARRAY. * II IPAR(7) INTEGER PAREMETERS: * IPAR(1) SCALING OF THE BFGS UPDATE. IPAR(1)=1-NO SCALING. * IPAR(1)=2-SCALING IN THE FIRST ITERATION. * IPAR(1)=3-CONTROLLED SCALING. * IPAR(2) CORRECTION OF THE BFGS UPDATE IF A NEGATIVE CURVATURE * OCCURS. IPAR(2)=1-NO CORRECTION. IPAR(2)=2-POWELL'S * CORRECTION. * IPAR(3) RESTART AFTER UNSUCCESSFUL UPDATE. IPAR(3)=0-RESTART * SUPPRESSED. IPAR(3)=1-RESTART PERFORMED. * IPAR(4) INTERPOLATION IN LINE SEARCH. IPAR(4)=1-BISECTION. * IPAR(4)=2-TWO POINT QUADRATIC INTERPOLATION. IPAR(4)=3-THREE * POINT QUADRATIC INTERPOLATION. IPAR(4)=4-THREE POINT CUBIC * INTERPOLATION. * IPAR(5) MAXIMUM NUMBER OF ITERATIONS. * IPAR(6) MAXIMUM NUMBER OF FUNCTION EVALUATIONS. * IPAR(7) PRINT SPECIFICATION. IPAR(7)=0-NO PRINT. * ABS(IPAR(7))=1-PRINT OF FINAL RESULTS. * ABS(IPAR(7))=2-PRINT OF FINAL RESULTS AND ITERATIONS. * IPAR(7)>0-BASIC FINAL RESULTS. IPAR(7)<0-EXTENDED FINAL * RESULTS. * RI RPAR(7) REAL PARAMETERS: * RPAR(1) TOLERANCE FOR CHANGE OF VARIABLES. * RPAR(2) TOLERANCE FOR CHANGE OF FUNCTION VALUES. * RPAR(3) TOLERANCE FOR THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RPAR(4) TOLERANCE FOR THE FUNCTION FALUE. * RPAR(5) TOLERANCE FOR A DESCENT DIRECTION. * RPAR(6) TOLERANCE FOR A FUNCTION DECREASE IN THE LINE SEARCH. * RPAR(7) MAXIMUM STEPSIZE. * RO F VALUE OF THE OBJECTIVE FUNCTION. * RO GMAX MAXIMUM PARTIAL DERIVATIVE. * II IEXT TYPE OF OBJECTIVE FUNCTION. IEXT<0-MAXIMUM OF POSITIVE * VALUES. IEXT=0-MAXIMUM OF ABSOLUTE VALUES. IEXT>0-MAXIMUM * OF NEGATIVE VALUES. * IO ITERM CAUSE OF TERMINATION. * * VARIABLES IN COMMON /STAT/ (STATISTICS) : * IO NDECF NUMBER OF MATRIX DECOMPOSITION. * IO NRES NUMBER OF RESTARTS. * IO NRED NUMBER OF MINOR ITERATIONS. * IO NREM NUMBER OF CONSTRAINT DELETIONS. * IO NADD NUMBER OF CONSTRAINT ADDITIONS. * IO NIT NUMBER OF ITERATIONS. * IO NFV NUMBER OF FUNCTION EVALUATIONS. * IO NFG NUMBER OF GRADIENT EVALUATIONS. * IO NFH NUMBER OF HESSIAN EVALUATIONS. * * SUBPROGRAMS USED : * S PMIN RECURSIVE QUADRATIC PROGRAMMING METHOD WITH THE BFGS * VARIABLE METRIC UPDATE. * * EXTERNAL SUBROUTINES : * SE FUN CONPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION. * CALLING SEQUENCE: CALL FUN(NF,KA,X,FA) WHERE NF IS A NUMBER * OF VARIABLES, KA IS THE INDEX OF THE APPROXIMATED FUNCTION, * X(NF) IS A VECTOR OF VARIABLES AND FA IS THE VALUE OF THE * APPROXIMATED FUNCTION. * SE DER CONPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION. * CALLING SEQUENCE: CALL DER(NF,KA,X,GA) WHERE NF IS A NUMBER * OF VARIABLES, KA IS THE INDEX OF THE APPROXIMATED FUNCTION, * X(NF) IS A VECTOR OF VARIABLES AND GA(NF) IS THE GRADIENT OF * THE APPROXIMATED FUNCTION. * * METHOD : * RECURSIVE QUADRATIC PROGRAMMING METHOD WITH THE VARIABLE METRIC * UPDATE. * SUBROUTINE PMINS(NF,NA,NB,X,IX,XL,XU,AF,IA,RA,IPAR,RPAR,F,GMAX, + IEXT,ITERM) C .. Scalar Arguments .. DOUBLE PRECISION F,GMAX INTEGER IEXT,ITERM,NA,NB,NF C .. C .. Array Arguments .. DOUBLE PRECISION AF(*),RA(*),RPAR(7),X(*),XL(*),XU(*) INTEGER IA(*),IPAR(7),IX(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. INTEGER LAFD,LAFO,LAG,LAR,LAZ,LG,LGA,LGO,LH,LIA,LIAA,LS,LXO,NC C .. C .. External Subroutines .. EXTERNAL PMIN C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. NC = 0 * * POINTERS FOR AUXILIARY ARRAYS * LAFO = 1 LAFD = LAFO + NA LGA = LAFD + NA LAG = LGA + NF LAR = LAG + NF*NA LAZ = LAR + (NF+1)* (NF+2)/2 LG = LAZ + NF + 1 LH = LG + NF + 1 LS = LH + NF* (NF+1)/2 LXO = LS + NF + 1 LGO = LXO + NF LIA = 1 LIAA = LIA + NA CALL PMIN(NF,NA,NB,NC,X,IX,XL,XU,RA,IA,RA,RA,RA,RA,AF,IA,RA(LAFO), + RA(LAFD),RA(LGA),RA(LAG),IA(LIAA),RA(LAR),RA(LAZ), + RA(LG),RA(LH),RA(LS),RA(LXO),RA(LGO),RPAR(1),RPAR(2), + RPAR(3),RPAR(4),RPAR(5),RPAR(6),RPAR(7),GMAX,F,IEXT, + IPAR(1),IPAR(2),IPAR(3),IPAR(4),IPAR(5),IPAR(6),IPAR(7), + ITERM) RETURN END ************************************************************************ * SUBROUTINE PMINL ALL SYSTEMS 97/01/22 * PURPOSE : * EASY TO USE SUBROUTINE FOR MINIMAX OPTIMIZATION WITH SIMPLE BOUNDS * AND GENERAL LINEAR CONSTRAINTS. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NA NUMBER OF LINEAR APPROXIMATED FUNCTIONS. * II NB CHOICE OF SIMPLE BOUNDS. NB=0-SIMPLE BOUNDS SUPPRESSED. * NB>0-SIMPLE BOUNDS ACCEPTED. * II NC NUMBER OF LINEAR CONSTRAINTS. * RI X(NF) VECTOR OF VARIABLES. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. IX(I)=0-VARIABLE * X(I) IS UNBOUNDED. IX(I)=1-LOVER BOUND XL(I).LE.X(I). * IX(I)=2-UPPER BOUND X(I).LE.XU(I). IX(I)=3-TWO SIDE BOUND * XL(I).LE.X(I).LE.XU(I). IX(I)=5-VARIABLE X(I) IS FIXED. * RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * RI CF(NC) VECTOR CONTAINING VALUES OF THE CONSTRAINT FUNCTIONS. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * IC(KC)=0-CONSTRAINT CF(KC) IS NOT USED. IC(KC)=1-LOVER * CONSTRAINT CL(KC).LE.CF(KC). IC(KC)=2-UPPER CONSTRAINT * CF(KC).LE.CU(KC). IC(KC)=3-TWO SIDE CONSTRAINT * CL(KC).LE.CF(KC).LE.CU(KC). IC(KC)=5-EQUALITY CONSTRAINT * CF(KC).EQ.CL(KC). * RI CL(NC) VECTOR CONTAINING LOWER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CU(NC) VECTOR CONTAINING UPPER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RO AF(NA) VECTOR CONTAINING VALUES OF THE APPROXIMATED * FUNCTIONS. * IA IA(NA+NF+1) AUXILIARY ARRAY. * RA RA((NF+NA+8)*NF+2*NA+4) AUXILIARY ARRAY. * II IPAR(7) INTEGER PAREMETERS: * IPAR(1) SCALING OF THE BFGS UPDATE. IPAR(1)=1-NO SCALING. * IPAR(1)=2-SCALING IN THE FIRST ITERATION. * IPAR(1)=3-CONTROLLED SCALING. * IPAR(2) CORRECTION OF THE BFGS UPDATE IF A NEGATIVE CURVATURE * OCCURS. IPAR(2)=1-NO CORRECTION. IPAR(2)=2-POWELL'S * CORRECTION. * IPAR(3) RESTART AFTER UNSUCCESSFUL UPDATE. IPAR(3)=0-RESTART * SUPPRESSED. IPAR(3)=1-RESTART PERFORMED. * IPAR(4) INTERPOLATION IN LINE SEARCH. IPAR(4)=1-BISECTION. * IPAR(4)=2-TWO POINT QUADRATIC INTERPOLATION. IPAR(4)=3-THREE * POINT QUADRATIC INTERPOLATION. IPAR(4)=4-THREE POINT CUBIC * INTERPOLATION. * IPAR(5) MAXIMUM NUMBER OF ITERATIONS. * IPAR(6) MAXIMUM NUMBER OF FUNCTION EVALUATIONS. * IPAR(7) PRINT SPECIFICATION. IPAR(7)=0-NO PRINT. * ABS(IPAR(7))=1-PRINT OF FINAL RESULTS. * ABS(IPAR(7))=2-PRINT OF FINAL RESULTS AND ITERATIONS. * IPAR(7)>0-BASIC FINAL RESULTS. IPAR(7)<0-EXTENDED FINAL * RESULTS. * RI RPAR(7) REAL PARAMETERS: * RPAR(1) TOLERANCE FOR CHANGE OF VARIABLES. * RPAR(2) TOLERANCE FOR CHANGE OF FUNCTION VALUES. * RPAR(3) TOLERANCE FOR THE FUNCTION FALUE. * RPAR(4) TOLERANCE FOR THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RPAR(5) TOLERANCE FOR A DESCENT DIRECTION. * RPAR(6) TOLERANCE FOR A FUNCTION DECREASE IN THE LINE SEARCH. * RPAR(7) MAXIMUM STEPSIZE. * RO F VALUE OF THE OBJECTIVE FUNCTION. * RO GMAX MAXIMUM PARTIAL DERIVATIVE. * II IEXT TYPE OF OBJECTIVE FUNCTION. IEXT<0-MAXIMUM OF POSITIVE * VALUES. IEXT=0-MAXIMUM OF ABSOLUTE VALUES. IEXT>0-MAXIMUM * OF NEGATIVE VALUES. * IO ITERM CAUSE OF TERMINATION. * * VARIABLES IN COMMON /STAT/ (STATISTICS) : * IO NDECF NUMBER OF MATRIX DECOMPOSITION. * IO NRES NUMBER OF RESTARTS. * IO NRED NUMBER OF MINOR ITERATIONS. * IO NREM NUMBER OF CONSTRAINT DELETIONS. * IO NADD NUMBER OF CONSTRAINT ADDITIONS. * IO NIT NUMBER OF ITERATIONS. * IO NFV NUMBER OF FUNCTION EVALUATIONS. * IO NFG NUMBER OF GRADIENT EVALUATIONS. * IO NFH NUMBER OF HESSIAN EVALUATIONS. * * SUBPROGRAMS USED : * S PMIN RECURSIVE QUADRATIC PROGRAMMING METHOD WITH THE BFGS * VARIABLE METRIC UPDATE. * * EXTERNAL SUBROUTINES : * SE FUN CONPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION. * CALLING SEQUENCE: CALL FUN(NF,KA,X,FA) WHERE NF IS A NUMBER * OF VARIABLES, KA IS THE INDEX OF THE APPROXIMATED FUNCTION, * X(NF) IS A VECTOR OF VARIABLES AND FA IS THE VALUE OF THE * APPROXIMATED FUNCTION. * SE DER CONPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION. * CALLING SEQUENCE: CALL DER(NF,KA,X,GA) WHERE NF IS A NUMBER * OF VARIABLES, KA IS THE INDEX OF THE APPROXIMATED FUNCTION, * X(NF) IS A VECTOR OF VARIABLES AND GA(NF) IS THE GRADIENT OF * THE APPROXIMATED FUNCTION. * SUBROUTINE PMINL(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,AF,IA,RA, + IPAR,RPAR,F,GMAX,IEXT,ITERM) * * POINTERS FOR AUXILIARY ARRAYS * C .. Scalar Arguments .. DOUBLE PRECISION F,GMAX INTEGER IEXT,ITERM,NA,NB,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION AF(*),CF(*),CG(*),CL(*),CU(*),RA(*),RPAR(7),X(*), + XL(*),XU(*) INTEGER IA(*),IC(*),IPAR(7),IX(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. INTEGER LAFD,LAFO,LAG,LAR,LAZ,LCFD,LG,LGA,LGO,LH,LIA,LIAA,LS,LXO C .. C .. External Subroutines .. EXTERNAL PMIN C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. LCFD = 1 LAFO = LCFD + NC LAFD = LAFO + NA LGA = LAFD + NA LAG = LGA + NF LAR = LAG + NF*NA LAZ = LAR + (NF+1)* (NF+2)/2 LG = LAZ + NF + 1 LH = LG + NF + 1 LS = LH + NF* (NF+1)/2 LXO = LS + NF + 1 LGO = LXO + NF LIA = 1 LIAA = LIA + NA CALL PMIN(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,RA,AF,IA,RA(LAFO), + RA(LAFD),RA(LGA),RA(LAG),IA(LIAA),RA(LAR),RA(LAZ), + RA(LG),RA(LH),RA(LS),RA(LXO),RA(LGO),RPAR(1),RPAR(2), + RPAR(3),RPAR(4),RPAR(5),RPAR(6),RPAR(7),GMAX,F,IEXT, + IPAR(1),IPAR(2),IPAR(3),IPAR(4),IPAR(5),IPAR(6),IPAR(7), + ITERM) RETURN END ************************************************************************ * SUBROUTINE PMIN ALL SYSTEMS 97/01/22 * PURPOSE : * GENERAL SUBROUTINE FOR MINIMAX OPTIMIZATION WITH SIMPLE BOUNDS * AND GENERAL LINEAR CONSTRAINTS. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NA NUMBER OF LINEAR APPROXIMATED FUNCTIONS. * II NB CHOICE OF SIMPLE BOUNDS. NB=0-SIMPLE BOUNDS SUPPRESSED. * NB>0-SIMPLE BOUNDS ACCEPTED. * II NC NUMBER OF LINEAR CONSTRAINTS. * RI X(NF) VECTOR OF VARIABLES. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. IX(I)=0-VARIABLE * X(I) IS UNBOUNDED. IX(I)=1-LOVER BOUND XL(I).LE.X(I). * IX(I)=2-UPPER BOUND X(I).LE.XU(I). IX(I)=3-TWO SIDE BOUND * XL(I).LE.X(I).LE.XU(I). IX(I)=5-VARIABLE X(I) IS FIXED. * RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * RO CF(NC) VECTOR CONTAINING VALUES OF THE CONSTRAINT FUNCTIONS. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * IC(KC)=0-CONSTRAINT CF(KC) IS NOT USED. IC(KC)=1-LOVER * CONSTRAINT CL(KC).LE.CF(KC). IC(KC)=2-UPPER CONSTRAINT * CF(KC).LE.CU(KC). IC(KC)=3-TWO SIDE CONSTRAINT * CL(KC).LE.CF(KC).LE.CU(KC). IC(KC)=5-EQUALITY CONSTRAINT * CF(KC).EQ.CL(KC). * RI CL(NC) VECTOR CONTAINING LOWER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CU(NC) VECTOR CONTAINING UPPER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RA CFD(NA) VECTOR CONTAINING INCREMENTS OF THE CONSTRAINT * FUNCTIONS. * RO AF(NA) VECTOR CONTAINING VALUES OF THE APPROXIMATED * FUNCTIONS. * II IA(NA) VECTOR CONTAINING TYPES OF DEVIATIONS. * RA AFO(NA) VECTOR CONTAINING SAVED VALUES OF THE APPROXIMATED * FUNCTIONS. * RA AFD(NA) VECTOR CONTAINING INCREMENTS OF THE APPROXIMATED * FUNCTIONS. * RA GA(NF) GRADIENT OF THE SELECTED APPROXIMATED FUNCTION. * RO AG(NF*NA) MATRIX WHOSE COLUMNS ARE GRADIENTS OF THE * APPROXIMATED FUNCTIONS. * IO IAA(NF+1) VECTOR CONTAINING INDICES OF ACTIVE FUNCTIONS. * RO AR((NF+1)*(NF+2)/2) TRIANGULAR DECOMPOSITION OF KERNEL OF THE * ORTHOGONAL PROJECTION. * RO AZ(NF+1) VECTOR OF LAGRANGE MULTIPLIERS. * RO G(NF) GRADIENT OF THE OBJECTIVE FUNCTION. * RU H(NF*(NF+1)/2) TRIANGULAR DECOMPOSITION OR INVERSION OF THE * HESSIAN MATRIX APPROXIMATION. * RO S(NF+1) DIRECTION VECTOR. * RU XO(NF) VECTORS OF VARIABLES DIFFERENCE. * RI GO(NF) GRADIENTS DIFFERENCE. * RI TOLX TOLERANCE FOR CHANGE OF VARIABLES. * RI TOLF TOLERANCE FOR CHANGE OF FUNCTION VALUES. * RI TOLB TOLERANCE FOR THE FUNCTION FALUE. * RI TOLG TOLERANCE FOR THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RI TOLD TOLERANCE FOR A DESCENT DIRECTION. * RI TOLS TOLERANCE FOR A FUNCTION DECREASE IN THE LINE SEARCH. * RI XMAX MAXIMUM STEPSIZE. * RO GMAX MAXIMUM PARTIAL DERIVATIVE. * RO F VALUE OF THE OBJECTIVE FUNCTION. * FUNCTIONS. * II IEXT TYPE OF OBJECTIVE FUNCTION. IEXT<0-MAXIMUM OF POSITIVE * VALUES. IEXT=0-MAXIMUM OF ABSOLUTE VALUES. IEXT>0-MAXIMUM * OF NEGATIVE VALUES. * II MET SELECTION OF SELF SCALING. MET=1-SELF SCALING SUPPRESSED. * MET=2 INITIAL SELF SCALING. MET=3 CONTROLLED SELF SCALING. * II MEC CORRECTION IF THE NEGATIVE CURVATURE OCCURS. * MEC=1-CORRECTION SUPPRESSED. MEC=2-POWELL'S CORRECTION. * II MER RESTART AFTER UNSUCCESSFUL UPDATE. MER=0-RESTART * SUPPRESSED. MER=1-RESTART PERFORMED. * II MES INTERPOLATION METHOD SELECTION. MES=1-BISECTION. MES=2-TWO * POINT QUADRATIC INTERPOLATION. MES=3-THREE POINT QUADRATIC * INTERPOLATION. MES=4-THREE POINT CUBIC INTERPOLATION. * II MIT MAXIMUN NUMBER OF ITERATIONS. * II MFV MAXIMUN NUMBER OF FUNCTION EVALUATIONS. * II IPRNT PRINT SPECIFICATION. IPRNT=0-NO PRINT. * ABS(IPRNT)=1-PRINT OF FINAL RESULTS. * ABS(IPRNT)=2-PRINT OF FINAL RESULTS AND ITERATIONS. * IPRNT>0-BASIC FINAL RESULTS. IPRNT<0-EXTENDED FINAL * RESULTS. * IO ITERM CAUSE OF TERMINATION. * * VARIABLES IN COMMON /STAT/ (STATISTICS) : * IO NDECF NUMBER OF MATRIX DECOMPOSITION. * IO NRES NUMBER OF RESTARTS. * IO NRED NUMBER OF MINOR ITERATIONS. * IO NREM NUMBER OF CONSTRAINT DELETIONS. * IO NADD NUMBER OF CONSTRAINT ADDITIONS. * IO NIT NUMBER OF ITERATIONS. * IO NFV NUMBER OF FUNCTION EVALUATIONS. * IO NFG NUMBER OF GRADIENT EVALUATIONS. * IO NFH NUMBER OF HESSIAN EVALUATIONS. * * SUBPROGRAMS USED : * S PDDXQ1 DETERMINATION OF THE DESCENT DIRECTION. * S PA1MX2 COMPUTATION OF THE VALUE AND THE GRADIENT OF THE * OBJECTIVE FUNCTION WHICH IS DEFINED AS A MAXIMUM OF THE * APPROXIMATED FUNCTIONS. * S PS0LA2 LINE SEARCH USING ONLY FUNCTION VALUES. * S PYTRFD DETERMINATION OF DIFFERENCES FOR VARIABLE METRIC * UPDATES. * S PUDBG1 VARIABLE METRIC UPDATE AFTER GILL-MURRAY DECOMPOSITION. * S MXDSMI SYMMETRIC MATRIX IS REPLACED BY THE UNIT MATRIX. * RF MXVDOT DOT PRODUCT OF TWO VECTORS. * S MXVCOP COPYING OF A VECTOR. * RF MXVMAX L-INFINITY NORM OF A VECTOR. * * EXTERNAL SUBROUTINES : * SE FUN CONPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION. * CALLING SEQUENCE: CALL FUN(NF,KA,X,FA) WHERE NF IS A NUMBER * OF VARIABLES, KA IS THE INDEX OF THE APPROXIMATED FUNCTION, * X(NF) IS A VECTOR OF VARIABLES AND FA IS THE VALUE OF THE * APPROXIMATED FUNCTION. * SE DER CONPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION. * CALLING SEQUENCE: CALL DER(NF,KA,X,GA) WHERE NF IS A NUMBER * OF VARIABLES, KA IS THE INDEX OF THE APPROXIMATED FUNCTION, * X(NF) IS A VECTOR OF VARIABLES AND GA(NF) IS THE GRADIENT OF * THE APPROXIMATED FUNCTION. * * METHOD : * RECURSIVE QUADRATIC PROGRAMMING METHOD WITH THE BFGS VARIABLE METRIC * UPDATE. * SUBROUTINE PMIN(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,CFD,AF,IA, + AFO,AFD,GA,AG,IAA,AR,AZ,G,H,S,XO,GO,TOLX,TOLF, + TOLB,TOLG,TOLD,TOLS,XMAX,GMAX,F,IEXT,MET,MEC,MER, + MES,MIT,MFV,IPRNT,ITERM) C .. Scalar Arguments .. DOUBLE PRECISION F,GMAX,TOLB,TOLD,TOLF,TOLG,TOLS,TOLX,XMAX INTEGER IEXT,IPRNT,ITERM,MEC,MER,MES,MET,MFV,MIT,NA,NB,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION AF(*),AFD(*),AFO(*),AG(*),AR(*),AZ(*),CF(*), + CFD(*),CG(*),CL(*),CU(*),G(*),GA(*),GO(*),H(*), + S(*),X(*),XL(*),XO(*),XU(*) INTEGER IA(*),IAA(*),IC(*),IX(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION ALF1,ALF2,DMAX,EPS7,EPS9,ETA0,ETA2,ETA9,FA,FMAX, + FMIN,FO,GNORM,P,PO,R,RMAX,RMIN,RO,SNORM,TEMP, + UMAX,XNORM INTEGER I,IDECF,IREST,ITERD,ITERH,ITERL,ITERQ,ITERS,K,KA,KBC,KBF, + KC,KD,KIT,LD,MRED,MTESF,MTESX,N,NTESF,NTESX C .. C .. External Functions .. DOUBLE PRECISION MXVDOT EXTERNAL MXVDOT C .. C .. External Subroutines .. EXTERNAL MXDSMI,MXVCOP,MXVSET,PA1MX2,PDDXQ1,PLLPB2,PLNEWS,PS0LA2, + PUDBG1,PYTRFD C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX,MIN,SQRT C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. IF (ABS(IPRNT).GT.1) WRITE (6,FMT='(1X,''ENTRY TO PMIN :'')') * * INITIATION * KBF = 0 KBC = 0 IF (NB.GT.0) KBF = 2 IF (NC.GT.0) KBC = 2 NIT = 0 NFV = 0 NTESX = 0 NTESF = 0 MTESX = 2 MTESF = 2 ITERM = 0 ITERS = 0 ITERD = 0 ITERQ = 0 MRED = 20 IREST = 1 ITERS = 2 NDECF = 0 IDECF = 1 ETA0 = 1.0D-15 ETA2 = 1.0D-15 ETA9 = 1.0D60 EPS7 = 1.0D-10 EPS9 = 1.0D-8 ALF1 = 1.0D-10 ALF2 = 1.0D10 FMAX = 1.0D60 FMIN = 0.0D0 IF (IEXT.NE.0) FMIN = -FMAX IF (TOLX.LE.0.0D0) TOLX = 1.0D-8 IF (TOLF.LE.0.0D0) TOLF = 1.0D-16 IF (TOLG.LE.0.0D0) TOLG = 1.0D-6 IF (TOLB.LE.0.0D0) TOLB = FMIN + 1.0D-16 IF (TOLD.LE.0.0D0) TOLD = 1.0D-8 IF (TOLS.LE.0.0D0) TOLS = 1.0D-4 IF (XMAX.LE.0.0D0) XMAX = 1.0D3 IF (MET.LE.0) MET = 3 IF (MEC.LE.0) MEC = 1 IF (MES.LE.0) MES = 1 IF (MIT.LE.0) MIT = 1000 IF (MFV.LE.0) MFV = 2000 IF (NC.GT.0) EPS7 = 1.0D-8 KD = 1 LD = -1 KIT = 0 * * INITIATION OF TYPES OF DEVIATIONS * DO 10 KA = 1,NA IA(KA) = 3 IF (IEXT.LT.0) IA(KA) = 2 IF (IEXT.GT.0) IA(KA) = 1 10 CONTINUE * * INITIAL OPERATIONS WITH SIMPLE BOUNDS * IF (KBF.GT.0) THEN DO 20 I = 1,NF IF ((IX(I).EQ.3.OR.IX(I).EQ.4) .AND. XU(I).LE.XL(I)) THEN XU(I) = XL(I) IX(I) = 5 ELSE IF (IX(I).EQ.5 .OR. IX(I).EQ.6) THEN XL(I) = X(I) XU(I) = X(I) IX(I) = 5 END IF IF (IX(I).EQ.1 .OR. IX(I).EQ.3) X(I) = MAX(X(I),XL(I)) IF (IX(I).EQ.2 .OR. IX(I).EQ.3) X(I) = MIN(X(I),XU(I)) 20 CONTINUE END IF * * INITIAL OPERATIONS WITH GENERAL LINEAR CONSTRAINTS * IF (KBC.GT.0) THEN K = 0 DO 30 KC = 1,NC IF ((IC(KC).EQ.3.OR.IC(KC).EQ.4) .AND. + CU(KC).LE.CL(KC)) THEN CU(KC) = CL(KC) IC(KC) = 5 ELSE IF (IC(KC).EQ.5 .OR. IC(KC).EQ.6) THEN CU(KC) = CL(KC) IC(KC) = 5 END IF CF(KC) = MXVDOT(NF,X,CG(K+1)) K = K + NF 30 CONTINUE END IF * * DETERMINATION OF AN INITIAL FEASIBLE POINT * IF (KBC.GT.0) THEN CALL MXVSET(NF,0.0D0,GO) CALL PLLPB2(NF,NC,X,IX,XO,XL,XU,CF,CFD,IC,IAA,CL,CU,CG,AR,AZ, + GO,GO,S,1,KBF,KBC,ETA9,EPS7,EPS9,UMAX,GMAX,N, + ITERL) ELSE IF (KBF.GT.0) THEN DO 40 I = 1,NF IF (IX(I).GE.5) IX(I) = -IX(I) IF (IX(I).LE.0) THEN ELSE IF ((IX(I).EQ.1.OR.IX(I).EQ.3) .AND. + X(I).LE.XL(I)) THEN X(I) = XL(I) ELSE IF ((IX(I).EQ.2.OR.IX(I).EQ.3) .AND. + X(I).GE.XU(I)) THEN X(I) = XU(I) END IF CALL PLNEWS(X,IX,XL,XU,EPS9,I,ITERL) IF (IX(I).GT.10) IX(I) = 10 - IX(I) 40 CONTINUE END IF FO = FMIN GMAX = ETA9 DMAX = ETA9 * * COMPUTATION OF THE VALUE AND THE GRADIENT OF THE OBJECTIVE * FUNCTION TOGETHER WITH THE VALUES AND THE GRADIENTS OF THE * APPROXIMATED FUNCTIONS * CALL PA1MX2(NF,NA,X,F,FA,AF,GA,AG,G,KD,LD,IEXT) 50 CONTINUE IF (ABS(IPRNT).GT.1) WRITE (6,FMT= +'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG='',I5,2X, ''F ='', +D15.8,2X,''G ='',D11.4)') NIT,NFV,NFG,F,GMAX * * START OF THE ITERATION WITH TESTS FOR TERMINATION. * N = NF UMAX = 0.0D0 IF (ITERM.LT.0) GO TO 90 IF (ITERS.EQ.0) GO TO 60 IF (NIT.LE.0) FO = F + MIN(SQRT(ABS(F)),ABS(F)/1.0D1) IF (F.LE.TOLB) THEN ITERM = 3 GO TO 90 END IF IF (KD.GT.0) THEN IF (GMAX.LE.TOLG .AND. UMAX.LE.TOLG) THEN ITERM = 4 GO TO 90 END IF END IF IF (DMAX.LE.TOLX) THEN ITERM = 1 NTESX = NTESX + 1 IF (NTESX.GE.MTESX) GO TO 90 ELSE NTESX = 0 END IF TEMP = ABS(FO-F)/MAX(ABS(F),1.0D0) IF (TEMP.LE.TOLF) THEN ITERM = 2 NTESF = NTESF + 1 IF (NTESF.GE.MTESF) GO TO 90 ELSE NTESF = 0 END IF 60 IF (NIT.GE.MIT) THEN ITERM = 12 GO TO 90 END IF IF (NFV.GE.MFV) THEN ITERM = 11 GO TO 90 END IF ITERM = 0 NIT = NIT + 1 70 CONTINUE N = NF * * RESTART * IF (IREST.GT.0) THEN CALL MXDSMI(N,H) LD = MIN(LD,1) IDECF = -1 IF (KIT.LT.NIT) THEN NRES = NRES + 1 KIT = NIT ELSE ITERM = -10 IF (ITERS.LT.0) ITERM = ITERS - 5 GO TO 90 END IF END IF * * DIRECTION DETERMINATION USING A SPECIAL QUADRATIC PROGRAMMING * PROCEDURE * CALL MXVCOP(NA,AF,AFO) CALL PDDXQ1(NF,NA,NC,X,IX,XL,XU,AF,AFD,IA,IAA,AG,AR,AZ,CF,IC,CL, + CU,CG,G,H,S,F,KBF,KBC,IDECF,ETA0,ETA2,ETA9,EPS7,EPS9, + TOLG,UMAX,GMAX,GNORM,SNORM,XNORM,N,ITERQ,ITERD,ITERM) IF (ITERQ.LT.0) THEN IREST = 1 GO TO 70 END IF IF (ITERD.LT.0) ITERM = ITERD IF (ITERM.NE.0) GO TO 90 * * TEST FOR SUFFICIENT DESCENT * P = MXVDOT(NF,G,S) IREST = 1 IF (SNORM.LE.0.0D0) THEN ELSE IF (P+TOLD*GNORM*SNORM.LE.0.0D0) THEN IREST = 0 END IF IF (IREST.EQ.0) THEN NRED = 0 RMIN = ALF1*GNORM/SNORM RMAX = MIN(ALF2*GNORM/SNORM,XMAX/SNORM) ELSE GO TO 70 END IF * * PREPARATION OF LINE SEARCH * RO = 0.0D0 FO = F PO = P CALL MXVCOP(NF,X,XO) CALL MXVCOP(NF,G,GO) * * LINE SEARCH WITHOUT DIRECTIONAL DERIVATIVES * CALL PS0LA2(NF,NA,X,XO,S,R,RO,F,FO,PO,RMIN,RMAX,FMIN,FMAX,FA,AF, + GA,AG,G,KD,LD,IEXT,NIT,KIT,TOLS,MES,NRED,MRED,ITERS) * * DECISION AFTER UNSUCCESSFUL LINE SEARCH * IF (ITERS.LE.0) THEN R = 0.0D0 F = FO P = PO CALL MXVCOP(NF,XO,X) CALL MXVCOP(NA,AFO,AF) IREST = 1 LD = KD GO TO 70 ELSE IF (KBC.GT.0) THEN K = 0 DO 80 KC = 1,NC CF(KC) = MXVDOT(NF,X,CG(K+1)) K = K + NF 80 CONTINUE END IF * * COMPUTATION OF THE VALUE AND THE GRADIENT OF THE OBJECTIVE * FUNCTION TOGETHER WITH THE VALUES AND THE GRADIENTS OF THE * APPROXIMATED FUNCTIONS * IF (KD.GT.LD) THEN CALL PA1MX2(NF,NA,X,F,FA,AF,GA,AG,G,KD,LD,IEXT) END IF * * PREPARATION OF VARIABLE METRIC UPDATE * CALL PYTRFD(NF,NC,X,XO,IAA,AG,AZ,CG,G,GO,N,KD,LD,R,F,FO,P,PO,DMAX, + ITERS) * * VARIABLE METRIC UPDATE * CALL PUDBG1(N,H,G,S,XO,GO,R,PO,NIT,KIT,ITERH,MET,MEC) IF (MER.GT.0 .AND. ITERH.GT.0) IREST = 1 * * END OF THE ITERATION * GO TO 50 90 IF (IPRNT.GT.1 .OR. IPRNT.LT.0) WRITE (6, + FMT='(1X,''EXIT FROM PMIN :'')') IF (IPRNT.NE.0) WRITE (6,FMT= +'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG='',I5,2X, ''F ='', +D15.8,2X,''G ='',D11.4,2X,''ITERM='',I3)') NIT,NFV,NFG,F,GMAX, + ITERM IF (IPRNT.LT.0) WRITE (6,FMT='(1X,''X ='',5D15.7:/(4X,5D15.7))') + (X(I),I=1,NF) RETURN END ************************************************************************ * SUBROUTINE PBUNU ALL SYSTEMS 97/01/22 * PURPOSE : * EASY TO USE SUBROUTINE FOR UNCONSTRAINED NONSMOOTH OPTIMIZATION. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NA MAXIMUM BUNDLE DIMENSION. * RI X(NF) VECTOR OF VARIABLES. * IA IA(NA+NF+1) AUXILIARY ARRAY. * RA RA(NF*(NF+1)/2+NF*(NA+9)+5*NA+4) AUXILIARY ARRAY. * II IPAR(7) INTEGER PAREMETERS: * IPAR(1) WEIGHT UPDATING METHOD SPECIFICATION. * IPAR(1)=1-QUADRATIC INTERPOLATION. IPAR(1)=2-LOCAL MINIMUM * LOCALIZATION. IPAR(1)=3-QUASI-NEWTON CONDITION. * IPAR(2) INTERPOLATION IN LINE SEARCH. IPAR(2)=1-BISECTION. * IPAR(2)=2-TWO POINT QUADRATIC INTERPOLATION. IPAR(2)=3-THREE * POINT QUADRATIC INTERPOLATION. IPAR(2)=4-THREE POINT CUBIC * INTERPOLATION. * IPAR(3) MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF VARIABLES * SMALLER THAN RPAR(1). * IPAR(4) MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF FUNCTION * VALUES SMALLER THAN RPAR(2). * IPAR(5) MAXIMUM NUMBER OF ITERATIONS. * IPAR(6) MAXIMUM NUMBER OF FUNCTION EVALUATIONS. * IPAR(7) PRINT SPECIFICATION. IPAR(7)=0-NO PRINT. * ABS(IPAR(7))=1-PRINT OF FINAL RESULTS. * ABS(IPAR(7))=2-PRINT OF FINAL RESULTS AND ITERATIONS. * IPAR(7)>0-BASIC FINAL RESULTS. IPAR(7)<0-EXTENDED FINAL * RESULTS. * RI RPAR(9) REAL PARAMETERS: * RPAR(1) TOLERANCE FOR CHANGE OF VARIABLES. * RPAR(2) TOLERANCE FOR CHANGE OF FUNCTION VALUES. * RPAR(3) TOLERANCE FOR THE FUNCTION FALUE. * RPAR(4) TOLERANCE FOR THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RPAR(5) TOLERANCE FOR A DESCENT DIRECTION. * RPAR(6) TOLERANCE FOR A FUNCTION DECREASE IN THE LINE SEARCH. * RPAR(7) TOLERANCE FOR DIRECTIONAL DERIVATIVE IN THE LINE SEARCH. * RPAR(8) DISTANCE MEASURE PARAMETER. * RPAR(9) MAXIMUM STEPSIZE. * RO FP VALUE OF THE OBJECTIVE FUNCTION. * RO GMAX MAXIMUM ABSOLUTE VALUE OF A PARTIAL DERIVATIVE. * IO ITERM CAUSE OF TERMINATION. * * VARIABLES IN COMMON /STAT/ (STATISTICS) : * IO NDECF NUMBER OF MATRIX DECOMPOSITION. * IO NRES NUMBER OF RESTARTS. * IO NRED NUMBER OF MINOR ITERATIONS. * IO NREM NUMBER OF CONSTRAINT DELETIONS. * IO NADD NUMBER OF CONSTRAINT ADDITIONS. * IO NIT NUMBER OF ITERATIONS. * IO NFV NUMBER OF FUNCTION EVALUATIONS. * IO NFG NUMBER OF GRADIENT EVALUATIONS. * IO NFH NUMBER OF HESSIAN EVALUATIONS. * * SUBPROGRAMS USED : * S PBUN PROXIMAL BUNDLE METHOD WITH LINE SEARCH WHICH USES A * SPECIAL QUADRATIC PROGRAMMING SUBALGORITHM. * * EXTERNAL SUBROUTINES : * SE FUNDER COMPUTATION OF THE VALUE AND THE GRADIENT OF THE * OBJECTIVE FUNCTION. CALLING SEQUENCE: CALL FUNDER(NF,X,F,G) * WHERE NF IS A NUMBER OF VARIALES, X(NF) IS A VECTOR OF * VARIABLES, F IS THE VALUE OF THE OBJECTIVE FUNCTION AND * G(NF) IS THE GRADIENT OF THE OBJECTIVE FUNCTION. * SUBROUTINE PBUNU(NF,NA,X,IA,RA,IPAR,RPAR,FP,GMAX,ITERM) C .. Scalar Arguments .. DOUBLE PRECISION FP,GMAX INTEGER ITERM,NA,NF C .. C .. Array Arguments .. DOUBLE PRECISION RA(*),RPAR(9),X(*) INTEGER IA(*),IPAR(7) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. INTEGER LAF,LAFD,LAG,LAR,LAZ,LG,LGO,LGS,LH,LIA,LIAA,LS,LXO,LXS,NB, + NC C .. C .. External Subroutines .. EXTERNAL PBUN C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. IF (NA.LE.0) NA = NF + 3 NB = 0 NC = 0 * * POINTERS FOR AUXILIUARY ARRAYS * LAF = 1 LAFD = LAF + 4*NA LAG = LAFD + NA LAR = LAG + NF*NA LAZ = LAR + (NF+1)* (NF+2)/2 LG = LAZ + NF + 1 LH = LG + NF LS = LH + NF LXO = LS + NF + 1 LGO = LXO + NF LXS = LGO + NF + 1 LGS = LXS + NF LIA = 1 LIAA = LIA + NA CALL PBUN(NF,NA,NB,NC,X,IA,RA,RA,RA,IA,RA,RA,RA,RA,RA(LAF),IA, + RA(LAFD),RA(LAG),IA(LIAA),RA(LAR),RA(LAZ),RA(LG),RA(LH), + RA(LS),RA(LXO),RA(LGO),RA(LXS),RA(LGS),RPAR(1),RPAR(2), + RPAR(3),RPAR(4),RPAR(5),RPAR(6),RPAR(7),RPAR(8),RPAR(9), + GMAX,FP,IPAR(1),IPAR(2),IPAR(3),IPAR(4),IPAR(5),IPAR(6), + IPAR(7),ITERM) RETURN END ************************************************************************ * SUBROUTINE PBUNS ALL SYSTEMS 97/01/22 * PURPOSE : * EASY TO USE SUBROUTINE FOR NONSMOOTH OPTIMIZATION WITH SIMPLE * BOUNDS. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NA MAXIMUM BUNDLE DIMENSION. * II NB NUMBER OF SIMPLE BOUNDS. NB=0-SIMPLE BOUNDS SUPPRESSED. * NB=NF-SIMPLE BOUNDS ACCEPTED. * RI X(NF) VECTOR OF VARIABLES. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. IX(I)=0-VARIABLE * X(I) IS UNBOUNDED. IX(I)=1-LOVER BOUND XL(I).LE.X(I). * IX(I)=2-UPPER BOUND X(I).LE.XU(I). IX(I)=3-TWO SIDE BOUND * XL(I).LE.X(I).LE.XU(I). IX(I)=5-VARIABLE X(I) IS FIXED. * RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * IA IA(NA+NF+1) AUXILIARY ARRAY. * RA RA(NF*(NF+1)/2+NF*(NA+9)+5*NA+4) AUXILIARY ARRAY. * II IPAR(7) INTEGER PAREMETERS: * IPAR(1) WEIGHT UPDATING METHOD SPECIFICATION. * IPAR(1)=1-QUADRATIC INTERPOLATION. IPAR(1)=2-LOCAL MINIMUM * LOCALIZATION. IPAR(1)=3-QUASI-NEWTON CONDITION. * IPAR(2) INTERPOLATION IN LINE SEARCH. IPAR(2)=1-BISECTION. * IPAR(2)=2-TWO POINT QUADRATIC INTERPOLATION. IPAR(2)=3-THREE * POINT QUADRATIC INTERPOLATION. IPAR(2)=4-THREE POINT CUBIC * INTERPOLATION. * IPAR(3) MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF VARIABLES * SMALLER THAN RPAR(1). * IPAR(4) MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF FUNCTION * VALUES SMALLER THAN RPAR(2). * IPAR(5) MAXIMUM NUMBER OF ITERATIONS. * IPAR(6) MAXIMUM NUMBER OF FUNCTION EVALUATIONS. * IPAR(7) PRINT SPECIFICATION. IPAR(7)=0-NO PRINT. * ABS(IPAR(7))=1-PRINT OF FINAL RESULTS. * ABS(IPAR(7))=2-PRINT OF FINAL RESULTS AND ITERATIONS. * IPAR(7)>0-BASIC FINAL RESULTS. IPAR(7)<0-EXTENDED FINAL * RESULTS. * RI RPAR(9) REAL PARAMETERS: * RPAR(1) TOLERANCE FOR CHANGE OF VARIABLES. * RPAR(2) TOLERANCE FOR CHANGE OF FUNCTION VALUES. * RPAR(3) TOLERANCE FOR THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RPAR(4) TOLERANCE FOR THE FUNCTION FALUE. * RPAR(5) TOLERANCE FOR A DESCENT DIRECTION. * RPAR(6) TOLERANCE FOR A FUNCTION DECREASE IN THE LINE SEARCH. * RPAR(7) TOLERANCE FOR DIRECTIONAL DERIVATIVE IN THE LINE SEARCH. * RPAR(8) DISTANCE MEASURE PARAMETER. * RPAR(9) MAXIMUM STEPSIZE. * RO FP VALUE OF THE OBJECTIVE FUNCTION. * RO GMAX MAXIMUM ABSOLUTE VALUE OF AN ELEMENT OF THE LAGARANGIAN * FUNCTION. * IO ITERM CAUSE OF TERMINATION. * * VARIABLES IN COMMON /STAT/ (STATISTICS) : * IO NDECF NUMBER OF MATRIX DECOMPOSITION. * IO NRES NUMBER OF RESTARTS. * IO NRED NUMBER OF MINOR ITERATIONS. * IO NREM NUMBER OF CONSTRAINT DELETIONS. * IO NADD NUMBER OF CONSTRAINT ADDITIONS. * IO NIT NUMBER OF ITERATIONS. * IO NFV NUMBER OF FUNCTION EVALUATIONS. * IO NFG NUMBER OF GRADIENT EVALUATIONS. * IO NFH NUMBER OF HESSIAN EVALUATIONS. * * SUBPROGRAMS USED : * S PBUN PROXIMAL BUNDLE METHOD WITH LINE SEARCH WHICH USES A * SPECIAL QUADRATIC PROGRAMMING SUBALGORITHM. * * EXTERNAL SUBROUTINES : * SE FUNDER COMPUTATION OF THE VALUE AND THE GRADIENT OF THE * OBJECTIVE FUNCTION. CALLING SEQUENCE: CALL FUNDER(NF,X,F,G) * WHERE NF IS A NUMBER OF VARIALES, X(NF) IS A VECTOR OF * VARIABLES, F IS THE VALUE OF THE OBJECTIVE FUNCTION AND * G(NF) IS THE GRADIENT OF THE OBJECTIVE FUNCTION. * SUBROUTINE PBUNS(NF,NA,NB,X,IX,XL,XU,IA,RA,IPAR,RPAR,FP,GMAX, + ITERM) C .. Scalar Arguments .. DOUBLE PRECISION FP,GMAX INTEGER ITERM,NA,NB,NF C .. C .. Array Arguments .. DOUBLE PRECISION RA(*),RPAR(9),X(*),XL(*),XU(*) INTEGER IA(*),IPAR(7),IX(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. INTEGER LAF,LAFD,LAG,LAR,LAZ,LG,LGO,LGS,LH,LIA,LIAA,LS,LXO,LXS,NC C .. C .. External Subroutines .. EXTERNAL PBUN C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. IF (NA.LE.0) NA = NF + 3 NC = 0 * * POINTERS FOR AUXILIUARY ARRAYS * LAF = 1 LAFD = LAF + 4*NA LAG = LAFD + NA LAR = LAG + NF*NA LAZ = LAR + (NF+1)* (NF+2)/2 LG = LAZ + NF + 1 LH = LG + NF LS = LH + NF LXO = LS + NF + 1 LGO = LXO + NF LXS = LGO + NF + 1 LGS = LXS + NF LIA = 1 LIAA = LIA + NA CALL PBUN(NF,NA,NB,NC,X,IX,XL,XU,RA,IA,RA,RA,RA,RA,RA(LAF),IA, + RA(LAFD),RA(LAG),IA(LIAA),RA(LAR),RA(LAZ),RA(LG),RA(LH), + RA(LS),RA(LXO),RA(LGO),RA(LXS),RA(LGS),RPAR(1),RPAR(2), + RPAR(3),RPAR(4),RPAR(5),RPAR(6),RPAR(7),RPAR(8),RPAR(9), + GMAX,FP,IPAR(1),IPAR(2),IPAR(3),IPAR(4),IPAR(5),IPAR(6), + IPAR(7),ITERM) RETURN END ************************************************************************ * SUBROUTINE PBUNL ALL SYSTEMS 97/01/22 * PURPOSE : * EASY TO USE SUBROUTINE FOR NONSMOOTH OPTIMIZATION WITH SIMPLE * BOUNDS AND GENERAL LINEAR CONSTRAINTS. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NA MAXIMUM BUNDLE DIMENSION. * II NB NUMBER OF SIMPLE BOUNDS. NB=0-SIMPLE BOUNDS SUPPRESSED. * NB=NF-SIMPLE BOUNDS ACCEPTED. * II NC NUMBER OF LINEAR CONSTRAINTS. * RI X(NF) VECTOR OF VARIABLES. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. IX(I)=0-VARIABLE * X(I) IS UNBOUNDED. IX(I)=1-LOVER BOUND XL(I).LE.X(I). * IX(I)=2-UPPER BOUND X(I).LE.XU(I). IX(I)=3-TWO SIDE BOUND * XL(I).LE.X(I).LE.XU(I). IX(I)=5-VARIABLE X(I) IS FIXED. * RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * RI CF(NC) VECTOR CONTAINING VALUES OF THE CONSTRAINT FUNCTIONS. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * IC(KC)=0-CONSTRAINT CF(KC) IS NOT USED. IC(KC)=1-LOVER * CONSTRAINT CL(KC).LE.CF(KC). IC(KC)=2-UPPER CONSTRAINT * CF(KC).LE.CU(KC). IC(KC)=3-TWO SIDE CONSTRAINT * CL(KC).LE.CF(KC).LE.CU(KC). IC(KC)=5-EQUALITY CONSTRAINT * CF(KC).EQ.CL(KC). * RI CL(NC) VECTOR CONTAINING LOWER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CU(NC) VECTOR CONTAINING UPPER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * IA IA(NA+NF+1) AUXILIARY ARRAY. * RA RA(NF*(NF+1)/2+NF*(NA+9)+5*NA+4) AUXILIARY ARRAY. * II IPAR(7) INTEGER PAREMETERS: * IPAR(1) WEIGHT UPDATING METHOD SPECIFICATION. * IPAR(1)=1-QUADRATIC INTERPOLATION. IPAR(1)=2-LOCAL MINIMUM * LOCALIZATION. IPAR(1)=3-QUASI-NEWTON CONDITION. * IPAR(2) INTERPOLATION IN LINE SEARCH. IPAR(2)=1-BISECTION. * IPAR(2)=2-TWO POINT QUADRATIC INTERPOLATION. IPAR(2)=3-THREE * POINT QUADRATIC INTERPOLATION. IPAR(2)=4-THREE POINT CUBIC * INTERPOLATION. * IPAR(3) MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF VARIABLES * SMALLER THAN RPAR(1). * IPAR(4) MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF FUNCTION * VALUES SMALLER THAN RPAR(2). * IPAR(5) MAXIMUM NUMBER OF ITERATIONS. * IPAR(6) MAXIMUM NUMBER OF FUNCTION EVALUATIONS. * IPAR(7) PRINT SPECIFICATION. IPAR(7)=0-NO PRINT. * ABS(IPAR(7))=1-PRINT OF FINAL RESULTS. * ABS(IPAR(7))=2-PRINT OF FINAL RESULTS AND ITERATIONS. * IPAR(7)>0-BASIC FINAL RESULTS. IPAR(7)<0-EXTENDED FINAL * RESULTS. * RI RPAR(9) REAL PARAMETERS: * RPAR(1) TOLERANCE FOR CHANGE OF VARIABLES. * RPAR(2) TOLERANCE FOR CHANGE OF FUNCTION VALUES. * RPAR(3) TOLERANCE FOR THE FUNCTION FALUE. * RPAR(4) TOLERANCE FOR THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RPAR(5) TOLERANCE FOR A DESCENT DIRECTION. * RPAR(6) TOLERANCE FOR A FUNCTION DECREASE IN THE LINE SEARCH. * RPAR(7) TOLERANCE FOR DIRECTIONAL DERIVATIVE IN THE LINE SEARCH. * RPAR(8) DISTANCE MEASURE PARAMETER. * RPAR(9) MAXIMUM STEPSIZE. * RO FP VALUE OF THE OBJECTIVE FUNCTION. * RO GMAX MAXIMUM ABSOLUTE VALUE OF AN ELEMENT OF THE LAGARANGIAN * FUNCTION. * IO ITERM CAUSE OF TERMINATION. * * VARIABLES IN COMMON /STAT/ (STATISTICS) : * IO NDECF NUMBER OF MATRIX DECOMPOSITION. * IO NRES NUMBER OF RESTARTS. * IO NRED NUMBER OF MINOR ITERATIONS. * IO NREM NUMBER OF CONSTRAINT DELETIONS. * IO NADD NUMBER OF CONSTRAINT ADDITIONS. * IO NIT NUMBER OF ITERATIONS. * IO NFV NUMBER OF FUNCTION EVALUATIONS. * IO NFG NUMBER OF GRADIENT EVALUATIONS. * IO NFH NUMBER OF HESSIAN EVALUATIONS. * * SUBPROGRAMS USED : * S PBUN PROXIMAL BUNDLE METHOD WITH LINE SEARCH WHICH USES A * SPECIAL QUADRATIC PROGRAMMING SUBALGORITHM. * * EXTERNAL SUBROUTINES : * SE FUNDER COMPUTATION OF THE VALUE AND THE GRADIENT OF THE * OBJECTIVE FUNCTION. CALLING SEQUENCE: CALL FUNDER(NF,X,F,G) * WHERE NF IS A NUMBER OF VARIALES, X(NF) IS A VECTOR OF * VARIABLES, F IS THE VALUE OF THE OBJECTIVE FUNCTION AND * G(NF) IS THE GRADIENT OF THE OBJECTIVE FUNCTION. * SUBROUTINE PBUNL(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,IA,RA,IPAR, + RPAR,FP,GMAX,ITERM) C .. Scalar Arguments .. DOUBLE PRECISION FP,GMAX INTEGER ITERM,NA,NB,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION CF(*),CG(*),CL(*),CU(*),RA(*),RPAR(9),X(*),XL(*), + XU(*) INTEGER IA(*),IC(*),IPAR(7),IX(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. INTEGER LAF,LAFD,LAG,LAR,LAZ,LCFD,LG,LGO,LGS,LH,LIA,LIAA,LS,LXO, + LXS C .. C .. External Subroutines .. EXTERNAL PBUN C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. IF (NA.LE.0) NA = NF + 3 * * POINTERS FOR AUXILIUARY ARRAYS * LCFD = 1 LAF = LCFD + NC LAFD = LAF + 4*NA LAG = LAFD + NA LAR = LAG + NF*NA LAZ = LAR + (NF+1)* (NF+2)/2 LG = LAZ + NF + 1 LH = LG + NF LS = LH + NF LXO = LS + NF + 1 LGO = LXO + NF LXS = LGO + NF + 1 LGS = LXS + NF LIA = 1 LIAA = LIA + NA CALL PBUN(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,RA,RA(LAF),IA, + RA(LAFD),RA(LAG),IA(LIAA),RA(LAR),RA(LAZ),RA(LG),RA(LH), + RA(LS),RA(LXO),RA(LGO),RA(LXS),RA(LGS),RPAR(1),RPAR(2), + RPAR(3),RPAR(4),RPAR(5),RPAR(6),RPAR(7),RPAR(8),RPAR(9), + GMAX,FP,IPAR(1),IPAR(2),IPAR(3),IPAR(4),IPAR(5),IPAR(6), + IPAR(7),ITERM) RETURN END ************************************************************************ * SUBROUTINE PBUN ALL SYSTEMS 97/01/22 * PURPOSE : * GENERAL SUBROUTINE FOR NONSMOOTH OPTIMIZATION WITH SIMPLE BOUNDS * AND GENERAL LINEAR CONSTRAINTS. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NA MAXIMUM BUNDLE DIMENSION. * II NB NUMBER OF SIMPLE BOUNDS. NB=0-SIMPLE BOUNDS SUPPRESSED. * NB>0-SIMPLE BOUNDS ACCEPTED. * II NC NUMBER OF LINEAR CONSTRAINTS. * RU X(NF) VECTOR OF VARIABLES. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. IX(I)=0-VARIABLE * X(I) IS UNBOUNDED. IX(I)=1-LOWER BOUND XL(I).LE.X(I). * IX(I)=2-UPPER BOUND X(I).LE.XU(I). IX(I)=3-TWO SIDE BOUND * XL(I).LE.X(I).LE.XU(I). IX(I)=5-VARIABLE X(I) IS FIXED. * RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * RO CF(NC) VECTOR CONTAINING VALUES OF THE CONSTRAINT FUNCTIONS. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * IC(KC)=0-CONSTRAINT CF(KC) IS NOT USED. IC(KC)=1-LOWER * CONSTRAINT CL(KC).LE.CF(KC). IC(KC)=2-UPPER CONSTRAINT * CF(KC).LE.CU(KC). IC(KC)=3-TWO SIDE CONSTRAINT * CL(KC).LE.CF(KC).LE.CU(KC). IC(KC)=5-EQUALITY CONSTRAINT * CF(KC).EQ.CL(KC). * RI CL(NC) VECTOR CONTAINING LOWER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CU(NC) VECTOR CONTAINING UPPER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RA AF(4*NA) VECTOR OF BUNDLE VALUES. * IA IA(NA) VECTOR CONTAINING TYPES OF DEVIATIONS. * RA AFD(NA) VECTOR CONTAINING INCREMENTS OF BUNDLE FUNCTIONS. * RA AG(NF*NA) MATRIX WHOSE COLUMNS ARE BUNDLE GRADIENTS. * IA IAA(NF+1) VECTOR CONTAINING INDICES OF ACTIVE FUNCTIONS. * RA AR((NF+1)*(NF+2)/2) TRIANGULAR DECOMPOSITION OF KERNEL OF THE * ORTHOGONAL PROJECTION. * RA AZ(NF+1) VECTOR OF LAGRANGE MULTIPLIERS. * RA G(NF) SUBGRADIENT OF THE OBJECTIVE FUNCTION. * RA H(NF) DIAGONAL MATRIX OF WEIGHT PARAMETERS. * RA S(NF+1) DIRECTION VECTOR. * RA XO(NF) INCREMENT VECTOR. * RA GO(NF+1) GRADIENT OF THE LAGRANGIAN FUNCTION. * RA XS(NF) AUXILIARY VECTOR. * RA GS(NF) AUXILIARY VECTOR. * RI TOLX TOLERANCE FOR CHANGE OF VARIABLES. * RI TOLF TOLERANCE FOR CHANGE OF FUNCTION VALUES. * RI TOLB TOLERANCE FOR THE FUNCTION VALUE. * RI TOLG TOLERANCE FOR THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RI TOLD TOLERANCE FOR A DESCENT DIRECTION. * RI TOLS TOLERANCE FOR A FUNCTION DECREASE IN THE LINE SEARCH. * RI TOLP TOLERANCE FOR DIRECTIONAL DERIVATIVE IN THE LINE SEARCH. * RI ETA DISTANCE MEASURE PARAMETER. * RI XMAX MAXIMUM STEPSIZE. * RO GMAX MAXIMUM ABSOLUTE VALUE OF A PARTIAL DERIVATIVE. * RO FP VALUE OF THE OBJECTIVE FUNCTION. * II MET WEIGHT UPDATING METHOD SPECIFICATION. MET=1-QUADRATIC * INTERPOLATION. MET=2-LOCAL MINIMUM LOCALIZATION. * MET=3-QUASI-NEWTON CONDITION. * II MES METHOD SELECTION. MES=1-BISECTION. MES=2-TWO POINT * QUADRATIC INTERPOLATION. * II MTESX MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF VARIABLES * SMALLER THAN TOLX. * II MTESF MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF FUNCTION * VALUES SMALLER THAN TOLF. * II MIT MAXIMUN NUMBER OF ITERATIONS. * II MFV MAXIMUN NUMBER OF FUNCTION EVALUATIONS. * II IPRNT PRINT SPECIFICATION. IPRNT=0-NO PRINT. * ABS(IPRNT)=1-PRINT OF FINAL RESULTS. * ABS(IPRNT)=2-PRINT OF FINAL RESULTS AND ITERATIONS. * IPRNT>0-BASIC FINAL RESULTS. IPRNT<0-EXTENDED FINAL * RESULTS. * IO ITERM CAUSE OF TERMINATION. * * VARIABLES IN COMMON /STAT/ (STATISTICS) : * IO NDECF NUMBER OF MATRIX DECOMPOSITION. * IO NRES NUMBER OF RESTARTS. * IO NRED NUMBER OF MINOR ITERATIONS. * IO NREM NUMBER OF CONSTRAINT DELETIONS. * IO NADD NUMBER OF CONSTRAINT ADDITIONS. * IO NIT NUMBER OF ITERATIONS. * IO NFV NUMBER OF FUNCTION EVALUATIONS. * IO NFG NUMBER OF GRADIENT EVALUATIONS. * IO NFH NUMBER OF HESSIAN EVALUATIONS. * * SUBPROGRAMS USED : * S PDDBQ1 DETERMINATION OF THE DESCENT DIRECTION. * S PS1L05 LINE SEARCH USING FUNCTION VALUES AND DERIVATIVES. * S MXVCOP COPYING OF A VECTOR. * S MXVDIF DIFFERENCE OF TWO VECTORS. * S MXVDIR VECTOR AUGMENTED BY THE SCALED VECTOR. * RF MXVDOT DOT PRODUCT OF TWO VECTORS. * * EXTERNAL SUBROUTINES : * SE FUNDER COMPUTATION OF THE VALUE AND THE GRADIENT OF THE * OBJECTIVE FUNCTION. CALLING SEQUENCE: CALL FUNDER(NF,X,F,G) * WHERE NF IS A NUMBER OF VARIABLES, X(NF) IS A VECTOR OF * VARIABLES, F IS THE VALUE OF THE OBJECTIVE FUNCTION AND * G(NF) IS THE GRADIENT OF THE OBJECTIVE FUNCTION. * * METHOD : * PROXIMAL BUNDLE METHOD WITH LINE SEARCH WHICH USES A SPECIAL * QUADRATIC PROGRAMMING SUBALGORITHM. * SUBROUTINE PBUN(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,CFD,AF,IA, + AFD,AG,IAA,AR,AZ,G,H,S,XO,GO,XS,GS,TOLX,TOLF,TOLB, + TOLG,TOLD,TOLS,TOLP,ETA,XMAX,GMAX,FP,MET,MES, + MTESX,MTESF,MIT,MFV,IPRNT,ITERM) C .. Scalar Arguments .. DOUBLE PRECISION ETA,FP,GMAX,TOLB,TOLD,TOLF,TOLG,TOLP,TOLS,TOLX, + XMAX INTEGER IPRNT,ITERM,MES,MET,MFV,MIT,MTESF,MTESX,NA,NB,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION AF(*),AFD(*),AG(*),AR(*),AZ(*),CF(*),CFD(*), + CG(*),CL(*),CU(*),G(*),GO(*),GS(*),H(*),S(*), + X(*),XL(*),XO(*),XS(*),XU(*) INTEGER IA(*),IAA(*),IC(*),IX(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION ALF2,DMAX,EPS7,EPS9,ETA0,ETA2,ETA9,F,FMAX,FMIN, + FO,FUB,GNORM,P,PO,PP,R,RMAX,RMIN,RP,SNORM,TEMP, + TO,UMAX,XNORM INTEGER I,IDECF,IREST,ITERD,ITERL,ITERQ,ITERS,K,KBC,KBF,KC,KIT, + MAL,MES2,MOS,N,NTESF,NTESX C .. C .. External Functions .. DOUBLE PRECISION MXVDOT EXTERNAL MXVDOT C .. C .. External Subroutines .. EXTERNAL FUNDER,MXVCOP,MXVDIF,MXVDIR,MXVSET,PDDBQ1,PLLPB2,PLNEWS, + PS1L05 C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX,MIN,SQRT C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. IF (ABS(IPRNT).GT.1) WRITE (6,FMT='(1X,''ENTRY TO PBUN :'')') * * INITIATION * KBF = 0 KBC = 0 IF (NB.GT.0) KBF = 2 IF (NC.GT.0) KBC = 2 NIT = 0 NFV = 0 NFG = 0 NTESX = 0 NTESF = 0 ITERM = 0 ITERD = 0 ITERQ = 0 IREST = 0 ITERS = 2 NDECF = 0 IDECF = 10 ETA0 = 1.0D-15 ETA2 = 1.0D-15 ETA9 = 1.0D60 EPS7 = 1.0D-10 EPS9 = 1.0D-8 ALF2 = 1.0D10 FMAX = 1.0D60 FMIN = -FMAX IF (TOLX.LE.0.0D0) TOLX = 1.0D-8 IF (TOLF.LE.0.0D0) TOLF = 1.0D-8 IF (TOLB.EQ.0.0D0) TOLB = FMIN + 1.0D-16 IF (TOLG.LE.0.0D0) TOLG = 1.0D-6 IF (TOLD.LE.0.0D0) TOLD = 1.0D-4 IF (TOLS.LE.0.0D0) TOLS = 1.0D-2 IF (TOLP.LE.0.0D0) TOLP = 5.0D-1 IF (XMAX.LE.0.0D0) XMAX = 1.0D3 IF (MET.LE.0) MET = 1 IF (MES.LE.0) MES = 4 IF (MTESX.LE.0) MTESX = 20 IF (MTESF.LE.0) MTESF = 2 IF (MIT.LE.0) MIT = 1000 IF (MFV.LE.0) MFV = 2000 MOS = 1 MES2 = 1 IF (MET.EQ.2) MES2 = 2 IF (MET.EQ.3) MOS = 2 KIT = 0 MAL = 0 * * INITIAL OPERATIONS WITH SIMPLE BOUNDS * IF (KBF.GT.0) THEN DO 10 I = 1,NF IF ((IX(I).EQ.3.OR.IX(I).EQ.4) .AND. XU(I).LE.XL(I)) THEN XU(I) = XL(I) IX(I) = 5 ELSE IF (IX(I).EQ.5 .OR. IX(I).EQ.6) THEN XL(I) = X(I) XU(I) = X(I) IX(I) = 5 END IF IF (IX(I).EQ.1 .OR. IX(I).EQ.3) X(I) = MAX(X(I),XL(I)) IF (IX(I).EQ.2 .OR. IX(I).EQ.3) X(I) = MIN(X(I),XU(I)) 10 CONTINUE END IF * * INITIAL OPERATIONS WITH GENERAL LINEAR CONSTRAINTS * IF (KBC.GT.0) THEN K = 0 DO 20 KC = 1,NC IF ((IC(KC).EQ.3.OR.IC(KC).EQ.4) .AND. + CU(KC).LE.CL(KC)) THEN CU(KC) = CL(KC) IC(KC) = 5 ELSE IF (IC(KC).EQ.5 .OR. IC(KC).EQ.6) THEN CU(KC) = CL(KC) IC(KC) = 5 END IF CF(KC) = MXVDOT(NF,X,CG(K+1)) K = K + NF 20 CONTINUE END IF * * DETERMINATION OF AN INITIAL FEASIBLE POINT * IF (KBC.GT.0) THEN CALL MXVSET(NF,0.0D0,GO) CALL PLLPB2(NF,NC,X,IX,XO,XL,XU,CF,CFD,IC,IAA,CL,CU,CG,AR,AZ, + GO,GO,S,1,KBF,KBC,ETA9,EPS7,EPS9,UMAX,GMAX,N, + ITERL) ELSE IF (KBF.GT.0) THEN DO 30 I = 1,NF IF (IX(I).GE.5) IX(I) = -IX(I) IF (IX(I).LE.0) THEN ELSE IF ((IX(I).EQ.1.OR.IX(I).EQ.3) .AND. + X(I).LE.XL(I)) THEN X(I) = XL(I) ELSE IF ((IX(I).EQ.2.OR.IX(I).EQ.3) .AND. + X(I).GE.XU(I)) THEN X(I) = XU(I) END IF CALL PLNEWS(X,IX,XL,XU,EPS9,I,ITERL) IF (IX(I).GT.10) IX(I) = 10 - IX(I) 30 CONTINUE END IF FO = FMIN FUB = FMAX GMAX = ETA9 DMAX = ETA9 * * COMPUTATION OF THE VALUE AND THE GRADIENT OF THE OBJECTIVE * FUNCTION * CALL FUNDER(NF,X,F,G) NFV = NFV + 1 NFG = NFG + 1 40 CONTINUE IF (ABS(IPRNT).GT.1) WRITE (6,FMT= +'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG='',I5,2X, ''F ='', +D15.8,2X,''G ='',D11.4)') NIT,NFV,NFG,FP,GMAX * * START OF THE ITERATION WITH TESTS FOR TERMINATION. * N = NF UMAX = 0.0D0 IF (ITERM.LT.0) GO TO 90 IF (ITERS.EQ.0) GO TO 50 IF (NIT.LE.0) FO = F + MIN(SQRT(ABS(F)),ABS(F)/1.0D1) IF (F.LE.TOLB) THEN ITERM = 3 GO TO 90 END IF IF (DMAX.LE.TOLX) THEN ITERM = 1 NTESX = NTESX + 1 IF (NTESX.GE.MTESX) GO TO 90 ELSE NTESX = 0 END IF TEMP = ABS(FO-FUB)/MAX(ABS(FUB),1.0D0) IF (TEMP.LE.TOLF) THEN ITERM = 2 NTESF = NTESF + 1 IF (NTESF.GE.MTESF) GO TO 90 ELSE NTESF = 0 END IF 50 IF (NIT.GE.MIT) THEN ITERM = 12 GO TO 90 END IF IF (NFV.GE.MFV) THEN ITERM = 11 GO TO 90 END IF ITERM = 0 NIT = NIT + 1 60 CONTINUE * * RESTART * IF (IREST.GT.0) THEN IF (KIT.LT.NIT) THEN NRES = NRES + 1 KIT = NIT ELSE ITERM = -10 IF (ITERS.LT.0) ITERM = ITERS - 5 GO TO 90 END IF END IF * * DIRECTION DETERMINATION USING A SPECIAL QUADRATIC PROGRAMMING * PROCEDURE AND THE BUNDLE UPDATE * CALL PDDBQ1(NF,NA,NC,X,IX,XL,XU,F,FO,FP,FUB,AF,AFD,IA,IAA,AG,AR, + AZ,CF,IC,CL,CU,CG,G,H,S,XO,GO,XS,GS,P,R,RP,TO,KBF,KBC, + IDECF,ETA0,ETA2,ETA9,EPS7,EPS9,TOLF,TOLG,ETA,UMAX, + GMAX,GNORM,SNORM,XNORM,N,MAL,NIT,MOS,NTESF,NTESX, + ITERQ,ITERD,ITERS,ITERM) IF (ITERD.LT.0) ITERM = ITERD IF (ITERM.NE.0) GO TO 90 * * TEST FOR SUFFICIENT DESCENT * P = MXVDOT(NF,GO,S) IREST = 1 IF (SNORM.LE.0.0D0) THEN ELSE IF (P+TOLD*GNORM*SNORM.LE.0.0D0) THEN IREST = 0 END IF IF (IREST.EQ.0) THEN NRED = 0 RMIN = 1.0D-3 RMAX = MIN(ALF2*GNORM/SNORM,XMAX/SNORM) ELSE GO TO 60 END IF * * PREPARATION OF LINE SEARCH * FP = FO FO = F PO = P PP = MXVDOT(NF,G,S) CALL MXVCOP(NF,X,XO) CALL MXVCOP(NF,G,GO) * * LINE SEARCH WITH DIRECTIONAL DERIVATIVES WHICH ALLOWS NULL STEPS * CALL PS1L05(NF,X,XO,S,R,RP,F,FO,FP,P,PO,PP,TO,G,SNORM,RMIN,RMAX, + FMIN,FMAX,TOLS,TOLP,ETA,MES,MES2,ITERS) ITERD = 0 * * DECISION AFTER UNSUCCESSFUL LINE SEARCH * IF (ITERS.LE.0) THEN R = 0.0D0 F = FO P = PO CALL MXVCOP(NF,XO,X) ELSE IF (ITERS.GE.9) CALL MXVDIR(NF,RP,S,XO,X) CALL MXVDIF(NF,X,XO,XO) IF (KBC.GT.0) THEN K = 0 DO 70 KC = 1,NC CF(KC) = MXVDOT(NF,X,CG(K+1)) K = K + NF 70 CONTINUE END IF END IF * * COMPUTATION OF VALUES FOR TERMINATION CRITERIA * DMAX = 0.0D0 DO 80 I = 1,NF DMAX = MAX(DMAX,ABS(XO(I))/MAX(ABS(X(I)),1.0D0)) 80 CONTINUE TEMP = FUB FUB = F IF (ITERS.GE.9) FUB = FUB - (R-RP)*P FUB = (FUB+TEMP)*0.5D0 * * END OF THE ITERATION * GO TO 40 90 IF (IPRNT.GT.1 .OR. IPRNT.LT.0) WRITE (6, + FMT='(1X,''EXIT FROM PBUN :'')') IF (IPRNT.NE.0) WRITE (6,FMT= +'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG='',I5,2X, ''F ='', +D15.8,2X,''G ='',D11.4,2X,''ITERM='',I3)') NIT,NFV,NFG,FP,GMAX, + ITERM IF (IPRNT.LT.0) WRITE (6,FMT='(1X,''X ='',5D15.7:/(4X,5D15.7))') + (X(I),I=1,NF) RETURN END ************************************************************************ * SUBROUTINE PNEWU ALL SYSTEMS 97/01/22 * PURPOSE : * EASY TO USE SUBROUTINE FOR UNCONSTRAINED NONSMOOTH OPTIMIZATION. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NA MAXIMUM BUNDLE DIMENSION. * RI X(NF) VECTOR OF VARIABLES. * IA IA(NA+NF+1) AUXILIARY ARRAY. * RA RA((NA+3)*NF*(NF+1)/2+(NA+6)*NF+6*NA+4) AUXILIARY ARRAY. * II IPAR(7) INTEGER PAREMETERS: * IPAR(1) EXPONENT FOR DISTANCE MEASURE. * IPAR(2) INTERPOLATION IN LINE SEARCH. IPAR(2)=1-BISECTION. * IPAR(2)=2-TWO POINT QUADRATIC INTERPOLATION. IPAR(2)=3-THREE * POINT QUADRATIC INTERPOLATION. IPAR(2)=4-THREE POINT CUBIC * INTERPOLATION. * IPAR(3) MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF VARIABLES * SMALLER THAN RPAR(1). * IPAR(4) MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF FUNCTION * VALUES SMALLER THAN RPAR(2). * IPAR(5) MAXIMUM NUMBER OF ITERATIONS. * IPAR(6) MAXIMUM NUMBER OF FUNCTION EVALUATIONS. * IPAR(7) PRINT SPECIFICATION. IPAR(7)=0-NO PRINT. * ABS(IPAR(7))=1-PRINT OF FINAL RESULTS. * ABS(IPAR(7))=2-PRINT OF FINAL RESULTS AND ITERATIONS. * IPAR(7)>0-BASIC FINAL RESULTS. IPAR(7)<0-EXTENDED FINAL * RESULTS. * RI RPAR(9) REAL PARAMETERS: * RPAR(1) TOLERANCE FOR CHANGE OF VARIABLES. * RPAR(2) TOLERANCE FOR CHANGE OF FUNCTION VALUES. * RPAR(3) TOLERANCE FOR THE FUNCTION FALUE. * RPAR(4) TOLERANCE FOR THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RPAR(5) TOLERANCE FOR A DESCENT DIRECTION. * RPAR(6) TOLERANCE FOR A FUNCTION DECREASE IN THE LINE SEARCH. * RPAR(7) TOLERANCE FOR DIRECTIONAL DERIVATIVE IN THE LINE SEARCH. * RPAR(8) DISTANCE MEASURE PARAMETER. * RPAR(9) MAXIMUM STEPSIZE. * RO FP VALUE OF THE OBJECTIVE FUNCTION. * RO GMAX MAXIMUM ABSOLUTE VALUE OF AN ELEMENT OF THE LAGARANGIAN * FUNCTION. * II IHES A WAY FOR COMPUTING SECOND DERIVATIVES. IHES=0-NUMERICAL * COMPUTATION. IHES>0-ANALYTICAL COMPUTATION. * IO ITERM CAUSE OF TERMINATION. * * VARIABLES IN COMMON /STAT/ (STATISTICS) : * IO NDECF NUMBER OF MATRIX DECOMPOSITION. * IO NRES NUMBER OF RESTARTS. * IO NRED NUMBER OF MINOR ITERATIONS. * IO NREM NUMBER OF CONSTRAINT DELETIONS. * IO NADD NUMBER OF CONSTRAINT ADDITIONS. * IO NIT NUMBER OF ITERATIONS. * IO NFV NUMBER OF FUNCTION EVALUATIONS. * IO NFG NUMBER OF GRADIENT EVALUATIONS. * IO NFH NUMBER OF HESSIAN EVALUATIONS. * * SUBPROGRAMS USED : * S PNEW BUNDLE NEWTON METHOD WITH LINE SEARCH WHICH USES A SPECIAL * QUADRATIC PROGRAMMING SUBALGORITHM. * * EXTERNAL SUBROUTINES : * SE FUNDER COMPUTATION OF THE VALUE AND THE GRADIENT OF THE * OBJECTIVE FUNCTION. CALLING SEQUENCE: CALL FUNDER(NF,X,F,G) * WHERE NF IS A NUMBER OF VARIALES, X(NF) IS A VECTOR OF * VARIABLES, F IS THE VALUE OF THE OBJECTIVE FUNCTION AND * G(NF) IS THE GRADIENT OF THE OBJECTIVE FUNCTION. * SE HES COMPUTATION OF THE HESSIAN MATRIX OF THE OBJECTIVE * FUNCTION. CALLING SEQUENCE: CALL HES(NF,X,H) WHERE * NF IS A NUMBER OF VARIALES, X(NF) IS A VECTOR OF * VARIABLES AND H(NF*(NF+1)/2) IS THE UPPER RIGHT CORNER * OF THE SYMMETRIC HESSIAN MATRIX STORED BY COLUMNS. THIS * SUBTOUTINE IS USED ONLY IF IHES>0, BUT IT MUST BE * INCLUDED AS AN EMPTY SUBROUTINE IF IHES=0. * SUBROUTINE PNEWU(NF,NA,X,IA,RA,IPAR,RPAR,FP,GMAX,IHES,ITERM) C .. Scalar Arguments .. DOUBLE PRECISION FP,GMAX INTEGER IHES,ITERM,NA,NF C .. C .. Array Arguments .. DOUBLE PRECISION RA(*),RPAR(9),X(*) INTEGER IA(*),IPAR(7) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. INTEGER LAF,LAFD,LAG,LAH,LAR,LAZ,LG,LGO,LH,LHF,LIA,LIAA,LS,LSO, + LXO,NB,NC C .. C .. External Subroutines .. EXTERNAL PNEW C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. IF (NA.LE.0) NA = NF + 3 NB = 0 NC = 0 * * POINTERS FOR AUXILIUARY ARRAYS * LAF = 1 LAFD = LAF + 5*NA LAG = LAFD + NA LAR = LAG + NF*NA LAZ = LAR + (NF+1)* (NF+2)/2 LG = LAZ + NF + 1 LH = LG + NF LHF = LH + NF* (NF+1)/2 LAH = LHF + NF* (NF+1)/2 LS = LAH + NA*NF* (NF+1)/2 LSO = LS + NF + 1 LXO = LSO + NF LGO = LXO + NF LIA = 1 LIAA = LIA + NA CALL PNEW(NF,NA,NB,NC,X,IA,RA,RA,RA,IA,RA,RA,RA,RA,RA(LAF),IA, + RA(LAFD),RA(LAG),IA(LIAA),RA(LAR),RA(LAZ),RA(LG),RA(LH), + RA(LHF),RA(LAH),RA(LS),RA(LSO),RA(LXO),RA(LGO),RPAR(1), + RPAR(2),RPAR(3),RPAR(4),RPAR(5),RPAR(6),RPAR(7),RPAR(8), + RPAR(9),GMAX,FP,IPAR(1),IPAR(2),IPAR(3),IPAR(4),IPAR(5), + IPAR(6),IPAR(7),IHES,ITERM) RETURN END ************************************************************************ * SUBROUTINE PNEWS ALL SYSTEMS 97/01/22 * PURPOSE : * EASY TO USE SUBROUTINE FOR NONSMOOTH OPTIMIZATION WITH SIMPLE * BOUNDS. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NA MAXIMUM BUNDLE DIMENSION. * II NB NUMBER OF SIMPLE BOUNDS. NB=0-SIMPLE BOUNDS SUPPRESSED. * NB=NF-SIMPLE BOUNDS ACCEPTED. * RI X(NF) VECTOR OF VARIABLES. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. IX(I)=0-VARIABLE * X(I) IS UNBOUNDED. IX(I)=1-LOVER BOUND XL(I).LE.X(I). * IX(I)=2-UPPER BOUND X(I).LE.XU(I). IX(I)=3-TWO SIDE BOUND * XL(I).LE.X(I).LE.XU(I). IX(I)=5-VARIABLE X(I) IS FIXED. * RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * IA IA(NA+NF+1) AUXILIARY ARRAY. * RA RA((NA+3)*NF*(NF+1)/2+(NA+6)*NF+6*NA+4) AUXILIARY ARRAY. * II IPAR(7) INTEGER PAREMETERS: * IPAR(1) EXPONENT FOR DISTANCE MEASURE. * IPAR(2) INTERPOLATION IN LINE SEARCH. IPAR(2)=1-BISECTION. * IPAR(2)=2-TWO POINT QUADRATIC INTERPOLATION. IPAR(2)=3-THREE * POINT QUADRATIC INTERPOLATION. IPAR(2)=4-THREE POINT CUBIC * INTERPOLATION. * IPAR(3) MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF VARIABLES * SMALLER THAN RPAR(1). * IPAR(4) MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF FUNCTION * VALUES SMALLER THAN RPAR(2). * IPAR(5) MAXIMUM NUMBER OF ITERATIONS. * IPAR(6) MAXIMUM NUMBER OF FUNCTION EVALUATIONS. * IPAR(7) PRINT SPECIFICATION. IPAR(7)=0-NO PRINT. * ABS(IPAR(7))=1-PRINT OF FINAL RESULTS. * ABS(IPAR(7))=2-PRINT OF FINAL RESULTS AND ITERATIONS. * IPAR(7)>0-BASIC FINAL RESULTS. IPAR(7)<0-EXTENDED FINAL * RESULTS. * RI RPAR(9) REAL PARAMETERS: * RPAR(1) TOLERANCE FOR CHANGE OF VARIABLES. * RPAR(2) TOLERANCE FOR CHANGE OF FUNCTION VALUES. * RPAR(3) TOLERANCE FOR THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RPAR(4) TOLERANCE FOR THE FUNCTION FALUE. * RPAR(5) TOLERANCE FOR A DESCENT DIRECTION. * RPAR(6) TOLERANCE FOR A FUNCTION DECREASE IN THE LINE SEARCH. * RPAR(7) TOLERANCE FOR DIRECTIONAL DERIVATIVE IN THE LINE SEARCH. * RPAR(8) DISTANCE MEASURE PARAMETER. * RPAR(9) MAXIMUM STEPSIZE. * RO FP VALUE OF THE OBJECTIVE FUNCTION. * RO GMAX MAXIMUM ABSOLUTE VALUE OF AN ELEMENT OF THE LAGARANGIAN * FUNCTION. * II IHES A WAY FOR COMPUTING SECOND DERIVATIVES. IHES=0-NUMERICAL * COMPUTATION. IHES>0-ANALYTICAL COMPUTATION. * IO ITERM CAUSE OF TERMINATION. * * VARIABLES IN COMMON /STAT/ (STATISTICS) : * IO NDECF NUMBER OF MATRIX DECOMPOSITION. * IO NRES NUMBER OF RESTARTS. * IO NRED NUMBER OF MINOR ITERATIONS. * IO NREM NUMBER OF CONSTRAINT DELETIONS. * IO NADD NUMBER OF CONSTRAINT ADDITIONS. * IO NIT NUMBER OF ITERATIONS. * IO NFV NUMBER OF FUNCTION EVALUATIONS. * IO NFG NUMBER OF GRADIENT EVALUATIONS. * IO NFH NUMBER OF HESSIAN EVALUATIONS. * * SUBPROGRAMS USED : * S PNEW BUNDLE NEWTON METHOD WITH LINE SEARCH WHICH USES A SPECIAL * QUADRATIC PROGRAMMING SUBALGORITHM. * * EXTERNAL SUBROUTINES : * SE FUNDER COMPUTATION OF THE VALUE AND THE GRADIENT OF THE * OBJECTIVE FUNCTION. CALLING SEQUENCE: CALL FUNDER(NF,X,F,G) * WHERE NF IS A NUMBER OF VARIALES, X(NF) IS A VECTOR OF * VARIABLES, F IS THE VALUE OF THE OBJECTIVE FUNCTION AND * G(NF) IS THE GRADIENT OF THE OBJECTIVE FUNCTION. * SE HES COMPUTATION OF THE HESSIAN MATRIX OF THE OBJECTIVE * FUNCTION. CALLING SEQUENCE: CALL HES(NF,X,H) WHERE * NF IS A NUMBER OF VARIALES, X(NF) IS A VECTOR OF * VARIABLES AND H(NF*(NF+1)/2) IS THE UPPER RIGHT CORNER * OF THE SYMMETRIC HESSIAN MATRIX STORED BY COLUMNS. THIS * SUBTOUTINE IS USED ONLY IF IHES>0, BUT IT MUST BE * INCLUDED AS AN EMPTY SUBROUTINE IF IHES=0. * SUBROUTINE PNEWS(NF,NA,NB,X,IX,XL,XU,IA,RA,IPAR,RPAR,FP,GMAX,IHES, + ITERM) C .. Scalar Arguments .. DOUBLE PRECISION FP,GMAX INTEGER IHES,ITERM,NA,NB,NF C .. C .. Array Arguments .. DOUBLE PRECISION RA(*),RPAR(9),X(*),XL(*),XU(*) INTEGER IA(*),IPAR(7),IX(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. INTEGER LAF,LAFD,LAG,LAH,LAR,LAZ,LG,LGO,LH,LHF,LIA,LIAA,LS,LSO, + LXO,NC C .. C .. External Subroutines .. EXTERNAL PNEW C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. IF (NA.LE.0) NA = NF + 3 NC = 0 * * POINTERS FOR AUXILIUARY ARRAYS * LAF = 1 LAFD = LAF + 5*NA LAG = LAFD + NA LAR = LAG + NF*NA LAZ = LAR + (NF+1)* (NF+2)/2 LG = LAZ + NF + 1 LH = LG + NF LHF = LH + NF* (NF+1)/2 LAH = LHF + NF* (NF+1)/2 LS = LAH + NA*NF* (NF+1)/2 LSO = LS + NF + 1 LXO = LSO + NF LGO = LXO + NF LIA = 1 LIAA = LIA + NA CALL PNEW(NF,NA,NB,NC,X,IX,XL,XU,RA,IA,RA,RA,RA,RA,RA(LAF),IA, + RA(LAFD),RA(LAG),IA(LIAA),RA(LAR),RA(LAZ),RA(LG),RA(LH), + RA(LHF),RA(LAH),RA(LS),RA(LSO),RA(LXO),RA(LGO),RPAR(1), + RPAR(2),RPAR(3),RPAR(4),RPAR(5),RPAR(6),RPAR(7),RPAR(8), + RPAR(9),GMAX,FP,IPAR(1),IPAR(2),IPAR(3),IPAR(4),IPAR(5), + IPAR(6),IPAR(7),IHES,ITERM) RETURN END ************************************************************************ * SUBROUTINE PNEWL ALL SYSTEMS 97/01/22 * PURPOSE : * EASY TO USE SUBROUTINE FOR NONSMOOTH OPTIMIZATION WITH SIMPLE * BOUNDS AND GENERAL LINEAR CONSTRAINTS. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NA MAXIMUM BUNDLE DIMENSION. * II NB NUMBER OF SIMPLE BOUNDS. NB=0-SIMPLE BOUNDS SUPPRESSED. * NB=NF-SIMPLE BOUNDS ACCEPTED. * II NC NUMBER OF LINEAR CONSTRAINTS. * RI X(NF) VECTOR OF VARIABLES. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. IX(I)=0-VARIABLE * X(I) IS UNBOUNDED. IX(I)=1-LOVER BOUND XL(I).LE.X(I). * IX(I)=2-UPPER BOUND X(I).LE.XU(I). IX(I)=3-TWO SIDE BOUND * XL(I).LE.X(I).LE.XU(I). IX(I)=5-VARIABLE X(I) IS FIXED. * RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * RI CF(NC) VECTOR CONTAINING VALUES OF THE CONSTRAINT FUNCTIONS. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * IC(KC)=0-CONSTRAINT CF(KC) IS NOT USED. IC(KC)=1-LOVER * CONSTRAINT CL(KC).LE.CF(KC). IC(KC)=2-UPPER CONSTRAINT * CF(KC).LE.CU(KC). IC(KC)=3-TWO SIDE CONSTRAINT * CL(KC).LE.CF(KC).LE.CU(KC). IC(KC)=5-EQUALITY CONSTRAINT * CF(KC).EQ.CL(KC). * RI CL(NC) VECTOR CONTAINING LOWER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CU(NC) VECTOR CONTAINING UPPER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * IA IA(NA+NF+1) AUXILIARY ARRAY. * RA RA((NA+3)*NF*(NF+1)/2+(NA+6)*NF+6*NA+4) AUXILIARY ARRAY. * II IPAR(7) INTEGER PAREMETERS: * IPAR(1) EXPONENT FOR DISTANCE MEASURE. * IPAR(2) INTERPOLATION IN LINE SEARCH. IPAR(2)=1-BISECTION. * IPAR(2)=2-TWO POINT QUADRATIC INTERPOLATION. IPAR(2)=3-THREE * POINT QUADRATIC INTERPOLATION. IPAR(2)=4-THREE POINT CUBIC * INTERPOLATION. * IPAR(3) MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF VARIABLES * SMALLER THAN RPAR(1). * IPAR(4) MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF FUNCTION * VALUES SMALLER THAN RPAR(2). * IPAR(5) MAXIMUM NUMBER OF ITERATIONS. * IPAR(6) MAXIMUM NUMBER OF FUNCTION EVALUATIONS. * IPAR(7) PRINT SPECIFICATION. IPAR(7)=0-NO PRINT. * ABS(IPAR(7))=1-PRINT OF FINAL RESULTS. * ABS(IPAR(7))=2-PRINT OF FINAL RESULTS AND ITERATIONS. * IPAR(7)>0-BASIC FINAL RESULTS. IPAR(7)<0-EXTENDED FINAL * RESULTS. * RI RPAR(9) REAL PARAMETERS: * RPAR(1) TOLERANCE FOR CHANGE OF VARIABLES. * RPAR(2) TOLERANCE FOR CHANGE OF FUNCTION VALUES. * RPAR(3) TOLERANCE FOR THE FUNCTION FALUE. * RPAR(4) TOLERANCE FOR THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RPAR(5) TOLERANCE FOR A DESCENT DIRECTION. * RPAR(6) TOLERANCE FOR A FUNCTION DECREASE IN THE LINE SEARCH. * RPAR(7) TOLERANCE FOR DIRECTIONAL DERIVATIVE IN THE LINE SEARCH. * RPAR(8) DISTANCE MEASURE PARAMETER. * RPAR(9) MAXIMUM STEPSIZE. * RO FP VALUE OF THE OBJECTIVE FUNCTION. * RO GMAX MAXIMUM ABSOLUTE VALUE OF AN ELEMENT OF THE LAGARANGIAN * FUNCTION. * II IHES A WAY FOR COMPUTING SECOND DERIVATIVES. IHES=0-NUMERICAL * COMPUTATION. IHES>0-ANALYTICAL COMPUTATION. * IO ITERM CAUSE OF TERMINATION. * * VARIABLES IN COMMON /STAT/ (STATISTICS) : * IO NDECF NUMBER OF MATRIX DECOMPOSITION. * IO NRES NUMBER OF RESTARTS. * IO NRED NUMBER OF MINOR ITERATIONS. * IO NREM NUMBER OF CONSTRAINT DELETIONS. * IO NADD NUMBER OF CONSTRAINT ADDITIONS. * IO NIT NUMBER OF ITERATIONS. * IO NFV NUMBER OF FUNCTION EVALUATIONS. * IO NFG NUMBER OF GRADIENT EVALUATIONS. * IO NFH NUMBER OF HESSIAN EVALUATIONS. * * SUBPROGRAMS USED : * S PNEW BUNDLE NEWTON METHOD WITH LINE SEARCH WHICH USES A SPECIAL * QUADRATIC PROGRAMMING SUBALGORITHM. * * EXTERNAL SUBROUTINES : * SE FUNDER COMPUTATION OF THE VALUE AND THE GRADIENT OF THE * OBJECTIVE FUNCTION. CALLING SEQUENCE: CALL FUNDER(NF,X,F,G) * WHERE NF IS A NUMBER OF VARIALES, X(NF) IS A VECTOR OF * VARIABLES, F IS THE VALUE OF THE OBJECTIVE FUNCTION AND * G(NF) IS THE GRADIENT OF THE OBJECTIVE FUNCTION. * SE HES COMPUTATION OF THE HESSIAN MATRIX OF THE OBJECTIVE * FUNCTION. CALLING SEQUENCE: CALL HES(NF,X,H) WHERE * NF IS A NUMBER OF VARIALES, X(NF) IS A VECTOR OF * VARIABLES AND H(NF*(NF+1)/2) IS THE UPPER RIGHT CORNER * OF THE SYMMETRIC HESSIAN MATRIX STORED BY COLUMNS. THIS * SUBTOUTINE IS USED ONLY IF IHES>0, BUT IT MUST BE * INCLUDED AS AN EMPTY SUBROUTINE IF IHES=0. * SUBROUTINE PNEWL(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,IA,RA,IPAR, + RPAR,FP,GMAX,IHES,ITERM) C .. Scalar Arguments .. DOUBLE PRECISION FP,GMAX INTEGER IHES,ITERM,NA,NB,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION CF(*),CG(*),CL(*),CU(*),RA(*),RPAR(9),X(*),XL(*), + XU(*) INTEGER IA(*),IC(*),IPAR(7),IX(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. INTEGER LAF,LAFD,LAG,LAH,LAR,LAZ,LCFD,LG,LGO,LH,LHF,LIA,LIAA,LS, + LSO,LXO C .. C .. External Subroutines .. EXTERNAL PNEW C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. IF (NA.LE.0) NA = NF + 3 * * POINTERS FOR AUXILIUARY ARRAYS * LCFD = 1 LAF = LCFD + 1 LAFD = LAF + 5*NA LAG = LAFD + NA LAR = LAG + NF*NA LAZ = LAR + (NF+1)* (NF+2)/2 LG = LAZ + NF + 1 LH = LG + NF LHF = LH + NF* (NF+1)/2 LAH = LHF + NF* (NF+1)/2 LS = LAH + NA*NF* (NF+1)/2 LSO = LS + NF + 1 LXO = LSO + NF LGO = LXO + NF LIA = 1 LIAA = LIA + NA CALL PNEW(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,RA,RA(LAF),IA, + RA(LAFD),RA(LAG),IA(LIAA),RA(LAR),RA(LAZ),RA(LG),RA(LH), + RA(LHF),RA(LAH),RA(LS),RA(LSO),RA(LXO),RA(LGO),RPAR(1), + RPAR(2),RPAR(3),RPAR(4),RPAR(5),RPAR(6),RPAR(7),RPAR(8), + RPAR(9),GMAX,FP,IPAR(1),IPAR(2),IPAR(3),IPAR(4),IPAR(5), + IPAR(6),IPAR(7),IHES,ITERM) RETURN END ************************************************************************ * SUBROUTINE PNEW ALL SYSTEMS 97/01/22 * PURPOSE : * GENERAL SUBROUTINE FOR NONSMOOTH OPTIMIZATION WITH SIMPLE BOUNDS * AND GENERAL LINEAR CONSTRAINTS. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NA MAXIMUM BUNDLE DIMENSION. * II NB NUMBER OF SIMPLE BOUNDS. NB=0-SIMPLE BOUNDS SUPPRESSED. * NB>0-SIMPLE BOUNDS ACCEPTED. * II NC NUMBER OF LINEAR CONSTRAINTS. * RU X(NF) VECTOR OF VARIABLES. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. IX(I)=0-VARIABLE * X(I) IS UNBOUNDED. IX(I)=1-LOWER BOUND XL(I).LE.X(I). * IX(I)=2-UPPER BOUND X(I).LE.XU(I). IX(I)=3-TWO SIDE BOUND * XL(I).LE.X(I).LE.XU(I). IX(I)=5-VARIABLE X(I) IS FIXED. * RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * RO CF(NC) VECTOR CONTAINING VALUES OF THE CONSTRAINT FUNCTIONS. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * IC(KC)=0-CONSTRAINT CF(KC) IS NOT USED. IC(KC)=1-LOWER * CONSTRAINT CL(KC).LE.CF(KC). IC(KC)=2-UPPER CONSTRAINT * CF(KC).LE.CU(KC). IC(KC)=3-TWO SIDE CONSTRAINT * CL(KC).LE.CF(KC).LE.CU(KC). IC(KC)=5-EQUALITY CONSTRAINT * CF(KC).EQ.CL(KC). * RI CL(NC) VECTOR CONTAINING LOWER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CU(NC) VECTOR CONTAINING UPPER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RA AF(5*NA) VECTOR OF BUNDLE VALUES. * IA IA(NA) VECTOR CONTAINING TYPES OF DEVIATIONS. * RA AFD(NA) VECTOR CONTAINING INCREMENTS OF BUNDLE FUNCTIONS. * RA AG(NF*NA) MATRIX WHOSE COLUMNS ARE BUNDLE GRADIENTS. * IA IAA(NF+1) VECTOR CONTAINING INDICES OF ACTIVE FUNCTIONS. * RA AR((NF+1)*(NF+2)/2) TRIANGULAR DECOMPOSITION OF KERNEL OF THE * ORTHOGONAL PROJECTION. * RA AZ(NF+1) VECTOR OF LAGRANGE MULTIPLIERS. * RA G(NF) SUBGRADIENT OF THE OBJECTIVE FUNCTION. * RA H(NF*(NF+1)/2) AGGREGATE HESSIAN MATRIX. * RA HF(NF*(NF+1)/2) HESSIAN MATRIX OF THE OBJECTIVE FUNCTION. * RA AH(NA*NF*(NF+1)/2) BUNDLE OF HESSIAN MATRICES. * RA S(NF+1) DIRECTION VECTOR. * RA SO(NF) AUXILIARY VECTOR. * RA XO(NF) INCREMENT VECTOR. * RA GO(NF+1) GRADIENT OF THE LAGRANGIAN FUNCTION. * RI TOLX TOLERANCE FOR CHANGE OF VARIABLES. * RI TOLF TOLERANCE FOR CHANGE OF FUNCTION VALUES. * RI TOLB TOLERANCE FOR THE FUNCTION FALUE. * RI TOLG TOLERANCE FOR THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RI TOLD TOLERANCE FOR A DESCENT DIRECTION. * RI TOLS TOLERANCE FOR A FUNCTION DECREASE IN THE LINE SEARCH. * RI TOLP TOLERANCE FOR DIRECTIONAL DERIVATIVE IN THE LINE SEARCH. * RI ETA DISTANCE MEASURE PARAMETER. * RI XMAX MAXIMUM STEPSIZE. * RO GMAX MAXIMUM ABSOLUTE VALUE OF A PARTIAL DERIVATIVE. * RO FP VALUE OF THE OBJECTIVE FUNCTION. * II MOS EXPONENT FOR DISTANCE MEASURE. * II MES METHOD SELECTION. MES=1-BISECTION. MES=2-TWO POINT * QUADRATIC INTERPOLATION. MES=3-THREE POINT QUADRATIC * INTERPOLATION. MES=4-THREE POINT CUBIC INTERPOLATION. * II MTESX MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF VARIABLES * SMALLER THAN TOLX. * II MTESF MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF FUNCTION * VALUES SMALLER THAN TOLF. * II MIT MAXIMUN NUMBER OF ITERATIONS. * II MFV MAXIMUN NUMBER OF FUNCTION EVALUATIONS. * II IPRNT PRINT SPECIFICATION. IPRNT=0-NO PRINT. * ABS(IPRNT)=1-PRINT OF FINAL RESULTS. * ABS(IPRNT)=2-PRINT OF FINAL RESULTS AND ITERATIONS. * IPRNT>0-BASIC FINAL RESULTS. IPRNT<0-EXTENDED FINAL * RESULTS. * II IHES A WAY FOR COMPUTING SECOND DERIVATIVES. IHES=0-NUMERICAL * COMPUTATION. IHES>0-ANALYTICAL COMPUTATION. * IO ITERM CAUSE OF TERMINATION. * * VARIABLES IN COMMON /STAT/ (STATISTICS) : * IO NDECF NUMBER OF MATRIX DECOMPOSITION. * IO NRES NUMBER OF RESTARTS. * IO NRED NUMBER OF MINOR ITERATIONS. * IO NREM NUMBER OF CONSTRAINT DELETIONS. * IO NADD NUMBER OF CONSTRAINT ADDITIONS. * IO NIT NUMBER OF ITERATIONS. * IO NFV NUMBER OF FUNCTION EVALUATIONS. * IO NFG NUMBER OF GRADIENT EVALUATIONS. * IO NFH NUMBER OF HESSIAN EVALUATIONS. * * SUBPROGRAMS USED : * S PDDBQ2 DETERMINATION OF THE DESCENT DIRECTION. * S PS1L05 LINE SEARCH USING FUNCTION VALUES AND DERIVATIVES. * S MXVCOP COPYING OF A VECTOR. * S MXVDIF DIFFERENCE OF TWO VECTORS. * S MXVDIR VECTOR AUGMENTED BY THE SCALED VECTOR. * RF MXVDOT DOT PRODUCT OF TWO VECTORS. * * EXTERNAL SUBROUTINES : * SE FUNDER COMPUTATION OF THE VALUE AND THE GRADIENT OF THE * OBJECTIVE FUNCTION. CALLING SEQUENCE: CALL FUNDER(NF,X,F,G) * WHERE NF IS A NUMBER OF VARIALES, X(NF) IS A VECTOR OF * VARIABLES, F IS THE VALUE OF THE OBJECTIVE FUNCTION AND * G(NF) IS THE GRADIENT OF THE OBJECTIVE FUNCTION. * SE HES COMPUTATION OF THE HESSIAN MATRIX OF THE OBJECTIVE * FUNCTION. CALLING SEQUENCE: CALL HES(NF,X,H) WHERE * NF IS A NUMBER OF VARIALES, X(NF) IS A VECTOR OF * VARIABLES AND H(NF*(NF+1)/2) IS THE UPPER RIGHT CORNER * OF THE SYMMETRIC HESSIAN MATRIX STORED BY COLUMNS. THIS * SUBTOUTINE IS USED ONLY IF IHES>0, BUT IT MUST BE * INCLUDED AS AN EMPTY SUBROUTINE IF IHES=0. * * METHOD : * BUNDLE NEWTON METHOD WITH LINE SEARCH WHICH USES A SPECIAL * QUADRATIC PROGRAMMING SUBALGORITHM. * SUBROUTINE PNEW(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,CFD,AF,IA, + AFD,AG,IAA,AR,AZ,G,H,HF,AH,S,SO,XO,GO,TOLX,TOLF, + TOLB,TOLG,TOLD,TOLS,TOLP,ETA,XMAX,GMAX,FP,MOS,MES, + MTESX,MTESF,MIT,MFV,IPRNT,IHES,ITERM) C .. Scalar Arguments .. DOUBLE PRECISION ETA,FP,GMAX,TOLB,TOLD,TOLF,TOLG,TOLP,TOLS,TOLX, + XMAX INTEGER IHES,IPRNT,ITERM,MES,MFV,MIT,MOS,MTESF,MTESX,NA,NB,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION AF(*),AFD(*),AG(*),AH(*),AR(*),AZ(*),CF(*), + CFD(*),CG(*),CL(*),CU(*),G(*),GO(*),H(*),HF(*), + S(*),SO(*),X(*),XL(*),XO(*),XU(*) INTEGER IA(*),IAA(*),IC(*),IX(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION ALF2,DMAX,EPS7,EPS9,ETA0,ETA1,ETA2,ETA9,F,FMAX, + FMIN,FO,FUB,GNORM,P,PO,PP,R,RMAX,RMIN,RP,SNORM, + TEMP,TO,UMAX,XNORM INTEGER I,IDECF,IREST,ITERD,ITERL,ITERQ,ITERS,K,KBC,KBF,KC,KIT, + MAL,MES2,N,NTESF,NTESX C .. C .. External Functions .. DOUBLE PRECISION MXVDOT EXTERNAL MXVDOT C .. C .. External Subroutines .. EXTERNAL FUNDER,HES,MXDSMI,MXVCOP,MXVDIF,MXVDIR,MXVSET,PDDBQ2, + PF1HS1,PLLPB2,PLNEWS,PS1L05 C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX,MIN,SQRT C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. IF (ABS(IPRNT).GT.1) WRITE (6,FMT='(1X,''ENTRY TO PNEW :'')') * * INITIATION * KBF = 0 KBC = 0 IF (NB.GT.0) KBF = 2 IF (NC.GT.0) KBC = 2 NIT = 0 NFV = 0 NFG = 0 NFH = 0 NTESX = 0 NTESF = 0 ITERM = 0 ITERS = 0 ITERD = 0 ITERQ = 0 IREST = 0 ITERS = 2 NDECF = 0 IDECF = 0 ETA0 = 1.0D-15 ETA1 = 1.0D-15 ETA2 = 1.0D-4 ETA9 = 1.0D60 EPS7 = 1.0D-10 EPS9 = 1.0D-8 ALF2 = 1.0D10 FMAX = 1.0D60 FMIN = -FMAX IF (TOLX.LE.0.0D0) TOLX = 1.0D-8 IF (TOLF.LE.0.0D0) TOLF = 1.0D-8 IF (TOLB.EQ.0.0D0) TOLB = FMIN + 1.0D-16 IF (TOLG.LE.0.0D0) TOLG = 1.0D-6 IF (TOLD.LE.0.0D0) TOLD = 1.0D-4 IF (TOLS.LE.0.0D0) TOLS = 1.0D-2 IF (TOLP.LE.0.0D0) TOLP = 5.0D-1 IF (XMAX.LE.0.0D0) XMAX = 1.0D3 IF (MES.LE.0) MES = 4 IF (MOS.LE.0) MOS = 1 IF (MTESX.LE.0) MTESX = 20 IF (MTESF.LE.0) MTESF = 2 IF (MIT.LE.0) MIT = 1000 IF (MFV.LE.0) MFV = 2000 MES2 = 1 KIT = 0 MAL = 0 * * INITIAL OPERATIONS WITH SIMPLE BOUNDS * IF (KBF.GT.0) THEN DO 10 I = 1,NF IF ((IX(I).EQ.3.OR.IX(I).EQ.4) .AND. XU(I).LE.XL(I)) THEN XU(I) = XL(I) IX(I) = 5 ELSE IF (IX(I).EQ.5 .OR. IX(I).EQ.6) THEN XL(I) = X(I) XU(I) = X(I) IX(I) = 5 END IF IF (IX(I).EQ.1 .OR. IX(I).EQ.3) X(I) = MAX(X(I),XL(I)) IF (IX(I).EQ.2 .OR. IX(I).EQ.3) X(I) = MIN(X(I),XU(I)) 10 CONTINUE END IF * * INITIAL OPERATIONS WITH GENERAL LINEAR CONSTRAINTS * IF (KBC.GT.0) THEN K = 0 DO 20 KC = 1,NC IF ((IC(KC).EQ.3.OR.IC(KC).EQ.4) .AND. + CU(KC).LE.CL(KC)) THEN CU(KC) = CL(KC) IC(KC) = 5 ELSE IF (IC(KC).EQ.5 .OR. IC(KC).EQ.6) THEN CU(KC) = CL(KC) IC(KC) = 5 END IF CF(KC) = MXVDOT(NF,X,CG(K+1)) K = K + NF 20 CONTINUE END IF * * DETERMINATION OF AN INITIAL FEASIBLE POINT * IF (KBC.GT.0) THEN CALL MXVSET(NF,0.0D0,GO) CALL PLLPB2(NF,NC,X,IX,XO,XL,XU,CF,CFD,IC,IAA,CL,CU,CG,AR,AZ, + GO,GO,S,1,KBF,KBC,ETA9,EPS7,EPS9,UMAX,GMAX,N, + ITERL) ELSE IF (KBF.GT.0) THEN DO 30 I = 1,NF IF (IX(I).GE.5) IX(I) = -IX(I) IF (IX(I).LE.0) THEN ELSE IF ((IX(I).EQ.1.OR.IX(I).EQ.3) .AND. + X(I).LE.XL(I)) THEN X(I) = XL(I) ELSE IF ((IX(I).EQ.2.OR.IX(I).EQ.3) .AND. + X(I).GE.XU(I)) THEN X(I) = XU(I) END IF CALL PLNEWS(X,IX,XL,XU,EPS9,I,ITERL) IF (IX(I).GT.10) IX(I) = 10 - IX(I) 30 CONTINUE END IF FO = FMIN FUB = FMAX GMAX = ETA9 DMAX = ETA9 * * COMPUTATION OF THE VALUE AND THE GRADIENT OF THE OBJECTIVE * FUNCTION * CALL FUNDER(NF,X,F,G) NFV = NFV + 1 NFG = NFG + 1 IF (IHES.GT.0) THEN CALL HES(NF,X,HF) NFH = NFH + 1 ELSE CALL PF1HS1(NF,X,HF,G,SO,ETA1) END IF 40 CONTINUE IF (ABS(IPRNT).GT.1) WRITE (6,FMT= +'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG='',I5,2X, ''F ='', +D15.8,2X,''G ='',D11.4)') NIT,NFV,NFG,FP,GMAX * * START OF THE ITERATION WITH TESTS FOR TERMINATION. * N = NF UMAX = 0.0D0 IF (ITERM.LT.0) GO TO 90 IF (ITERS.EQ.0) GO TO 50 IF (NIT.LE.0) FO = F + MIN(SQRT(ABS(F)),ABS(F)/1.0D1) IF (F.LE.TOLB) THEN ITERM = 3 GO TO 90 END IF IF (DMAX.LE.TOLX) THEN ITERM = 1 NTESX = NTESX + 1 IF (NTESX.GE.MTESX) GO TO 90 ELSE NTESX = 0 END IF TEMP = ABS(FO-FUB)/MAX(ABS(FUB),1.0D0) IF (TEMP.LE.TOLF) THEN ITERM = 2 NTESF = NTESF + 1 IF (NTESF.GE.MTESF) GO TO 90 ELSE NTESF = 0 END IF 50 IF (NIT.GE.MIT) THEN ITERM = 12 GO TO 90 END IF IF (NFV.GE.MFV) THEN ITERM = 11 GO TO 90 END IF ITERM = 0 NIT = NIT + 1 60 CONTINUE * * RESTART * IF (IREST.GT.0) THEN CALL MXDSMI(NF,HF) IDECF = -1 IF (KIT.LT.NIT) THEN NRES = NRES + 1 KIT = NIT ELSE ITERM = -10 IF (ITERS.LT.0) ITERM = ITERS - 5 GO TO 90 END IF END IF N = NF * * DIRECTION DETERMINATION USING A SPECIAL QUADRATIC PROGRAMMING * PROCEDURE AND THE BUNDLE UPDATE * CALL PDDBQ2(NF,NA,NC,X,IX,XL,XU,F,FO,FP,FUB,AF,AFD,IA,IAA,AG,AR, + AZ,CF,IC,CL,CU,CG,G,H,HF,AH,S,GO,P,R,RP,KBF,KBC,IDECF, + ETA0,ETA2,ETA9,EPS7,EPS9,TOLF,TOLG,ETA,UMAX,GMAX, + GNORM,SNORM,XNORM,N,MAL,NIT,MOS,NTESF,NTESX,ITERQ, + ITERD,ITERS,ITERM) IF (ITERD.LT.0) ITERM = ITERD IF (ITERM.NE.0) GO TO 90 * * TEST FOR SUFFICIENT DESCENT * P = MXVDOT(NF,GO,S) IREST = 1 IF (SNORM.LE.0.0D0) THEN ELSE IF (P+TOLD*GNORM*SNORM.LE.0.0D0) THEN IREST = 0 END IF IF (IREST.EQ.0) THEN NRED = 0 RMIN = 1.0D-3 RMAX = MIN(ALF2*GNORM/SNORM,XMAX/SNORM) ELSE GO TO 60 END IF IF (NIT.EQ.1) KIT = NIT * * PREPARATION OF LINE SEARCH * FP = FO FO = F PO = P PP = MXVDOT(NF,G,S) CALL MXVCOP(NF,X,XO) CALL MXVCOP(NF,G,GO) * * LINE SEARCH WITH DIRECTIONAL DERIVATIVES WHICH ALLOWS NULL STEPS * TO = 1.0D0 CALL PS1L05(NF,X,XO,S,R,RP,F,FO,FP,P,PO,PP,TO,G,SNORM,RMIN,RMAX, + FMIN,FMAX,TOLS,TOLP,ETA,MES,MES2,ITERS) ITERD = 0 IF (IHES.GT.0) THEN CALL HES(NF,X,HF) NFH = NFH + 1 ELSE CALL PF1HS1(NF,X,HF,G,SO,ETA1) END IF * * DECISION AFTER UNSUCCESSFUL LINE SEARCH * IF (ITERS.LE.0) THEN R = 0.0D0 F = FO P = PO CALL MXVCOP(NF,XO,X) ELSE IF (ITERS.GE.9) CALL MXVDIR(NF,RP,S,XO,X) CALL MXVDIF(NF,X,XO,XO) C F = F - MXVDOT(NF,XO,G) IF (KBC.GT.0) THEN K = 0 DO 70 KC = 1,NC CF(KC) = MXVDOT(NF,X,CG(K+1)) K = K + NF 70 CONTINUE END IF END IF * * COMPUTATION OF VALUES FOR TERMINATION CRITERIA * DMAX = 0.0D0 DO 80 I = 1,NF DMAX = MAX(DMAX,ABS(XO(I))/MAX(ABS(X(I)),1.0D0)) 80 CONTINUE TEMP = FUB FUB = F IF (ITERS.GE.9) FUB = FUB - (R-RP)*P FUB = (FUB+TEMP)*0.5D0 * * END OF THE ITERATION * GO TO 40 90 IF (IPRNT.GT.1 .OR. IPRNT.LT.0) WRITE (6, + FMT='(1X,''EXIT FROM PNEW :'')') IF (IPRNT.NE.0) WRITE (6,FMT= +'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG='',I5,2X, ''F ='', +D15.8,2X,''G ='',D11.4,2X,''ITERM='',I3)') NIT,NFV,NFG,FP,GMAX, + ITERM IF (IPRNT.LT.0) WRITE (6,FMT='(1X,''X ='',5D15.7:/(4X,5D15.7))') + (X(I),I=1,NF) RETURN END ************************************************************************ * SUBROUTINE PVARU ALL SYSTEMS 97/01/22 * PURPOSE : * EASY TO USE SUBROUTINE FOR UNCONSTRAINED NONSMOOTH OPTIMIZATION. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NA MAXIMUM BUNDLE DIMENSION. * RI X(NF) VECTOR OF VARIABLES. * RA RA(NF*(NF+11)/2+2*NA*(NF+2)) AUXILIARY ARRAY. * II IPAR(7) INTEGER PAREMETERS: * IPAR(1) CONVEXITY ASSUMPTION. IPAR(1)=0 IF THE OBJECTIVE * FUNCTION IS CONVEX. IPAR(1)=1 IF THE OBJECTIVE FUNCTION * IS NONCONVEX. * IPAR(2) EXPONENT FOR DISTANCE MEASURE. * IPAR(3) MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF VARIABLES * SMALLER THAN TOLX. * IPAR(4) MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF FUNCTION * VALUES SMALLER THAN TOLF. * IPAR(5) MAXIMUM NUMBER OF ITERATIONS. * IPAR(6) MAXIMUM NUMBER OF FUNCTION EVALUATIONS. * IPAR(7) PRINT SPECIFICATION. IPAR(5)=0-NO PRINT. * ABS(IPAR(5))=1-PRINT OF FINAL RESULTS. * ABS(IPAR(5))=2-PRINT OF FINAL RESULTS AND ITERATIONS. * IPAR(5)>0-BASIC FINAL RESULTS. IPAR(5)<0-EXTENDED FINAL * RESULTS. * RI RPAR(7) REAL PARAMETERS: * RPAR(1) TOLERANCE FOR CHANGE OF VARIABLES. * RPAR(2) TOLERANCE FOR CHANGE OF FUNCTION VALUES. * RPAR(3) TOLERANCE FOR THE FUNCTION VALUE. * RPAR(4) TOLERANCE FOR THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RPAR(5) DISTANCE MEASURE PARAMETER. * RPAR(6) MAXIMUM STEPSIZE. * RO F VALUE OF THE OBJECTIVE FUNCTION. * RO GMAX MAXIMUM ABSOLUTE VALUE OF A PARTIAL DERIVATIVE. * IO ITERM CAUSE OF TERMINATION. * * VARIABLES IN COMMON /STAT/ (STATISTICS) : * IO NDECF NUMBER OF MATRIX DECOMPOSITION. * IO NRES NUMBER OF RESTARTS. * IO NRED NUMBER OF MINOR ITERATIONS. * IO NREM NUMBER OF CONSTRAINT DELETIONS. * IO NADD NUMBER OF CONSTRAINT ADDITIONS. * IO NIT NUMBER OF ITERATIONS. * IO NFV NUMBER OF FUNCTION EVALUATIONS. * IO NFG NUMBER OF GRADIENT EVALUATIONS. * IO NFH NUMBER OF HESSIAN EVALUATIONS. * * SUBPROGRAMS USED : * S PVAR BUNDLE VARIABLE METRIC METHOD FOR CONVEX NONSMOOTH * OPTIMIZATION. * * EXTERNAL SUBROUTINES : * SE FUNDER COMPUTATION OF THE VALUE AND THE GRADIENT OF THE * OBJECTIVE FUNCTION. CALLING SEQUENCE: CALL FUNDER(NF,X,F,G) * WHERE NF IS A NUMBER OF VARIALES, X(NF) IS A VECTOR OF * VARIABLES, F IS THE VALUE OF THE OBJECTIVE FUNCTION AND * G(NF) IS THE GRADIENT OF THE OBJECTIVE FUNCTION. * SUBROUTINE PVARU(NF,NA,X,RA,IPAR,RPAR,F,GMAX,ITERM) C .. Scalar Arguments .. DOUBLE PRECISION F,GMAX INTEGER ITERM,NA,NF C .. C .. Array Arguments .. DOUBLE PRECISION RA(*),RPAR(7),X(*) INTEGER IPAR(7) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. INTEGER LAF,LAG,LAX,LG,LGO,LGP,LGS,LH,LS,LXO,NB,NC C .. C .. Local Arrays .. INTEGER IA(1) C .. C .. External Subroutines .. EXTERNAL PVAR C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. IF (NA.LE.0) NA = NF + 3 NB = 0 NC = 0 * * POINTERS FOR AUXILIUARY ARRAYS * LAF = 1 LAX = LAF + 4*NA LAG = LAX + NF*NA LG = LAG + NF*NA LH = LG + NF LS = LH + NF* (NF+1)/2 LXO = LS + NF LGO = LXO + NF LGP = LGO + NF LGS = LGP + NF CALL PVAR(NF,NA,NB,NC,X,IA,RA,RA,RA,IA,RA,RA,RA,IA,RA,RA,RA, + RA(LAF),RA(LAX),RA(LAG),RA(LG),RA(LGP),RA(LH),RA(LS), + RA(LS),RA(LXO),RA(LGO),RA(LGP),RA(LGS),RPAR(1),RPAR(2), + RPAR(3),RPAR(4),RPAR(5),RPAR(6),RPAR(7),GMAX,F,IPAR(1), + IPAR(2),IPAR(3),IPAR(4),IPAR(5),IPAR(6),IPAR(7),ITERM) RETURN END ************************************************************************ * SUBROUTINE PVARS ALL SYSTEMS 97/01/22 * PURPOSE : * EASY TO USE SUBROUTINE FOR UNCONSTRAINED NONSMOOTH OPTIMIZATION. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NA MAXIMUM BUNDLE DIMENSION. * RI X(NF) VECTOR OF VARIABLES. * RA RA(NF*(NF+11)/2+2*NA*(NF+2)) AUXILIARY ARRAY. * II IPAR(7) INTEGER PAREMETERS: * IPAR(1) CONVEXITY ASSUMPTION. IPAR(1)=0 IF THE OBJECTIVE * FUNCTION IS CONVEX. IPAR(1)=1 IF THE OBJECTIVE FUNCTION * IS NONCONVEX. * IPAR(2) EXPONENT FOR DISTANCE MEASURE. * IPAR(3) MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF VARIABLES * SMALLER THAN TOLX. * IPAR(4) MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF FUNCTION * VALUES SMALLER THAN TOLF. * IPAR(5) MAXIMUM NUMBER OF ITERATIONS. * IPAR(6) MAXIMUM NUMBER OF FUNCTION EVALUATIONS. * IPAR(7) PRINT SPECIFICATION. IPAR(5)=0-NO PRINT. * ABS(IPAR(5))=1-PRINT OF FINAL RESULTS. * ABS(IPAR(5))=2-PRINT OF FINAL RESULTS AND ITERATIONS. * IPAR(5)>0-BASIC FINAL RESULTS. IPAR(5)<0-EXTENDED FINAL * RESULTS. * RI RPAR(6) REAL PARAMETERS: * RPAR(1) TOLERANCE FOR CHANGE OF VARIABLES. * RPAR(2) TOLERANCE FOR CHANGE OF FUNCTION VALUES. * RPAR(3) TOLERANCE FOR THE FUNCTION VALUE. * RPAR(4) TOLERANCE FOR THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RPAR(5) DISTANCE MEASURE PARAMETER. * RPAR(6) MAXIMUM STEPSIZE. * RO F VALUE OF THE OBJECTIVE FUNCTION. * RO GMAX MAXIMUM ABSOLUTE VALUE OF A PARTIAL DERIVATIVE. * IO ITERM CAUSE OF TERMINATION. * * VARIABLES IN COMMON /STAT/ (STATISTICS) : * IO NDECF NUMBER OF MATRIX DECOMPOSITION. * IO NRES NUMBER OF RESTARTS. * IO NRED NUMBER OF MINOR ITERATIONS. * IO NREM NUMBER OF CONSTRAINT DELETIONS. * IO NADD NUMBER OF CONSTRAINT ADDITIONS. * IO NIT NUMBER OF ITERATIONS. * IO NFV NUMBER OF FUNCTION EVALUATIONS. * IO NFG NUMBER OF GRADIENT EVALUATIONS. * IO NFH NUMBER OF HESSIAN EVALUATIONS. * * SUBPROGRAMS USED : * S PVAR BUNDLE VARIABLE METRIC METHOD FOR CONVEX NONSMOOTH * OPTIMIZATION. * * EXTERNAL SUBROUTINES : * SE FUNDER COMPUTATION OF THE VALUE AND THE GRADIENT OF THE * OBJECTIVE FUNCTION. CALLING SEQUENCE: CALL FUNDER(NF,X,F,G) * WHERE NF IS A NUMBER OF VARIALES, X(NF) IS A VECTOR OF * VARIABLES, F IS THE VALUE OF THE OBJECTIVE FUNCTION AND * G(NF) IS THE GRADIENT OF THE OBJECTIVE FUNCTION. * SUBROUTINE PVARS(NF,NA,NB,X,IX,XL,XU,RA,IPAR,RPAR,F,GMAX,ITERM) C .. Scalar Arguments .. DOUBLE PRECISION F,GMAX INTEGER ITERM,NA,NB,NF C .. C .. Array Arguments .. DOUBLE PRECISION RA(*),RPAR(7),X(*),XL(*),XU(*) INTEGER IPAR(7),IX(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. INTEGER LAF,LAG,LAX,LG,LGN,LGO,LGP,LGS,LH,LS,LXO,NC C .. C .. External Subroutines .. EXTERNAL PVAR C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. IF (NA.LE.0) NA = NF + 3 NC = 0 * * POINTERS FOR AUXILIUARY ARRAYS * LAF = 1 LAX = LAF + 4*NA LAG = LAX + NF*NA LG = LAG + NF*NA LGN = LG + NF LH = LGN + NF LS = LH + NF* (NF+1)/2 LXO = LS + NF LGO = LXO + NF LGP = LGO + NF LGS = LGP + NF CALL PVAR(NF,NA,NB,NC,X,IX,XL,XU,RA,IX,RA,RA,RA,IX,RA,RA,RA, + RA(LAF),RA(LAX),RA(LAG),RA(LG),RA(LGN),RA(LH),RA(LS), + RA(LS),RA(LXO),RA(LGO),RA(LGP),RA(LGS),RPAR(1),RPAR(2), + RPAR(3),RPAR(4),RPAR(5),RPAR(6),RPAR(7),GMAX,F,IPAR(1), + IPAR(2),IPAR(3),IPAR(4),IPAR(5),IPAR(6),IPAR(7),ITERM) RETURN END ************************************************************************ * SUBROUTINE PVARL ALL SYSTEMS 97/01/22 * PURPOSE : * EASY TO USE SUBROUTINE FOR UNCONSTRAINED NONSMOOTH OPTIMIZATION. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NA MAXIMUM BUNDLE DIMENSION. * RI X(NF) VECTOR OF VARIABLES. * RA RA(NF*(NF+11)/2+2*NA*(NF+2)) AUXILIARY ARRAY. * II IPAR(7) INTEGER PAREMETERS: * IPAR(1) CONVEXITY ASSUMPTION. IPAR(1)=0 IF THE OBJECTIVE * FUNCTION IS CONVEX. IPAR(1)=1 IF THE OBJECTIVE FUNCTION * IS NONCONVEX. * IPAR(2) EXPONENT FOR DISTANCE MEASURE. * IPAR(3) MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF VARIABLES * SMALLER THAN TOLX. * IPAR(4) MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF FUNCTION * VALUES SMALLER THAN TOLF. * IPAR(5) MAXIMUM NUMBER OF ITERATIONS. * IPAR(6) MAXIMUM NUMBER OF FUNCTION EVALUATIONS. * IPAR(7) PRINT SPECIFICATION. IPAR(5)=0-NO PRINT. * ABS(IPAR(5))=1-PRINT OF FINAL RESULTS. * ABS(IPAR(5))=2-PRINT OF FINAL RESULTS AND ITERATIONS. * IPAR(5)>0-BASIC FINAL RESULTS. IPAR(5)<0-EXTENDED FINAL * RESULTS. * RI RPAR(6) REAL PARAMETERS: * RPAR(1) TOLERANCE FOR CHANGE OF VARIABLES. * RPAR(2) TOLERANCE FOR CHANGE OF FUNCTION VALUES. * RPAR(3) TOLERANCE FOR THE FUNCTION VALUE. * RPAR(4) TOLERANCE FOR THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RPAR(5) DISTANCE MEASURE PARAMETER. * RPAR(6) MAXIMUM STEPSIZE. * RO F VALUE OF THE OBJECTIVE FUNCTION. * RO GMAX MAXIMUM ABSOLUTE VALUE OF A PARTIAL DERIVATIVE. * IO ITERM CAUSE OF TERMINATION. * * VARIABLES IN COMMON /STAT/ (STATISTICS) : * IO NDECF NUMBER OF MATRIX DECOMPOSITION. * IO NRES NUMBER OF RESTARTS. * IO NRED NUMBER OF MINOR ITERATIONS. * IO NREM NUMBER OF CONSTRAINT DELETIONS. * IO NADD NUMBER OF CONSTRAINT ADDITIONS. * IO NIT NUMBER OF ITERATIONS. * IO NFV NUMBER OF FUNCTION EVALUATIONS. * IO NFG NUMBER OF GRADIENT EVALUATIONS. * IO NFH NUMBER OF HESSIAN EVALUATIONS. * * SUBPROGRAMS USED : * S PVAR BUNDLE VARIABLE METRIC METHOD FOR CONVEX NONSMOOTH * OPTIMIZATION. * * EXTERNAL SUBROUTINES : * SE FUNDER COMPUTATION OF THE VALUE AND THE GRADIENT OF THE * OBJECTIVE FUNCTION. CALLING SEQUENCE: CALL FUNDER(NF,X,F,G) * WHERE NF IS A NUMBER OF VARIALES, X(NF) IS A VECTOR OF * VARIABLES, F IS THE VALUE OF THE OBJECTIVE FUNCTION AND * G(NF) IS THE GRADIENT OF THE OBJECTIVE FUNCTION. * SUBROUTINE PVARL(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,IA,RA,IPAR, + RPAR,F,GMAX,ITERM) C .. Scalar Arguments .. DOUBLE PRECISION F,GMAX INTEGER ITERM,NA,NB,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION CF(*),CG(*),CL(*),CU(*),RA(*),RPAR(7),X(*),XL(*), + XU(*) INTEGER IA(*),IC(*),IPAR(7),IX(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. INTEGER LAF,LAG,LAX,LCFD,LCR,LCZ,LG,LGN,LGO,LGP,LGS,LH,LS,LSN,LXO C .. C .. External Subroutines .. EXTERNAL PVAR C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. IF (NA.LE.0) NA = NF + 3 * * POINTERS FOR AUXILIUARY ARRAYS * LCFD = 1 LCR = LCFD + NC LCZ = LCR + NF* (NF+1)/2 LAF = LCZ + NF*NF LAX = LAF + 4*NA LAG = LAX + NF*NA LG = LAG + NF*NA LGN = LG + NF LH = LGN + NF LS = LH + NF* (NF+1)/2 LSN = LS + NF LXO = LSN + NF LGO = LXO + NF LGP = LGO + NF LGS = LGP + NF CALL PVAR(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,IA,RA(LCFD), + RA(LCR),RA(LCZ),RA(LAF),RA(LAX),RA(LAG),RA(LG),RA(LGN), + RA(LH),RA(LS),RA(LSN),RA(LXO),RA(LGO),RA(LGP),RA(LGS), + RPAR(1),RPAR(2),RPAR(3),RPAR(4),RPAR(5),RPAR(6),RPAR(7), + GMAX,F,IPAR(1),IPAR(2),IPAR(3),IPAR(4),IPAR(5),IPAR(6), + IPAR(7),ITERM) RETURN END ************************************************************************ * SUBROUTINE PVAR ALL SYSTEMS 99/01/22 * PURPOSE : * GENERAL VARIABLE METRIC SUBROUTINE FOR NONSMOOTH OPTIMIZATION. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NA MAXIMUM BUNDLE DIMENSION. * II NB NUMBER OF BOX CONSTRAINTS. * II NC NUMBER OF GENERAL LINEAR CONSTRAINTS. * RU X(NF) VECTOR OF VARIABLES. * RA AF(4*NA) VECTOR OF BUNDLE VALUES. * RA AX(NF*NA) MATRIX WHOSE COLUMNS ARE BUNDLE POINTS. * RA AG(NF*NA) MATRIX WHOSE COLUMNS ARE BUNDLE GRADIENTS. * RA G(NF) SUBGRADIENT OF THE OBJECTIVE FUNCTION. * RA H(NF*(NF+1)/2) APPROXIMATION OF THE HESSIAN MATRIX. * RA S(NF) DIRECTION VECTOR. * RA XO(NF) DIFFERENCE OF VECTORS OF VARIABLES. * RA GO(NF) DIFFERENCE OF GRADIENTS. * RA GP(NF) AUXILIARY VECTOR. * RI TOLX TOLERANCE FOR CHANGE OF VARIABLES. * RI TOLF TOLERANCE FOR CHANGE OF FUNCTION VALUES. * RI TOLB TOLERANCE FOR THE FUNCTION VALUE. * RI TOLG TOLERANCE FOR THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RI ETA DISTANCE MEASURE PARAMETER. * RI XMAX MAXIMUM STEPSIZE. * RO GMAX VALUE OF THE TERMINATION CRITERION. * RO F VALUE OF THE OBJECTIVE FUNCTION. C*PL*ERROR* Comment line too long * II MEX CONVEXITY ASSUMPTION. MEX=0-CONVEX VERSION OF THE METHOD IS USED. * MEX=1-NONCONVEX VERSION OF THE METHOD IS USED. * II MOS EXPONENT FOR DISTANCE MEASURE. * II MTESX MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF VARIABLES * SMALLER THAN TOLX. * II MTESF MAXIMUM NUMBER OF ITERATIONS WITH CHANGES OF FUNCTION * VALUES SMALLER THAN TOLF. * II MIT MAXIMUN NUMBER OF ITERATIONS. * II MFV MAXIMUN NUMBER OF FUNCTION EVALUATIONS. * II IPRNT PRINT SPECIFICATION. IPRNT=0-NO PRINT. * ABS(IPRNT)=1-PRINT OF FINAL RESULTS. * ABS(IPRNT)=2-PRINT OF FINAL RESULTS AND ITERATIONS. * IPRNT>0-BASIC FINAL RESULTS. IPRNT<0-EXTENDED FINAL * RESULTS. * IO ITERM CAUSE OF TERMINATION. * * VARIABLES IN COMMON /STAT/ (STATISTICS) : * IO NDECF NUMBER OF MATRIX DECOMPOSITION. * IO NRES NUMBER OF RESTARTS. * IO NRED NUMBER OF MINOR ITERATIONS. * IO NREM NUMBER OF CONSTRAINT DELETIONS. * IO NADD NUMBER OF CONSTRAINT ADDITIONS. * IO NIT NUMBER OF ITERATIONS. * IO NFV NUMBER OF FUNCTION EVALUATIONS. * IO NFG NUMBER OF GRADIENT EVALUATIONS. * IO NFH NUMBER OF HESSIAN EVALUATIONS. * * SUBPROGRAMS USED : * S PS1L07 LINE SEARCH USING FUNCTION VALUES AND DERIVATIVES. * S PS1L08 LINE SEARCH USING FUNCTION VALUES AND DERIVATIVES. * S PUDVI2 VARIABLE METRIC UPDATE OF THE INVERSE HESSIAN MATRIX. * S PYBUN1 BUNDLE SELECTION. * S PYAGR1 SUBGRADIENT AGGREGATION. * S PYAGR2 SIMPLIFIED SUBGRADIENT AGGREGATION. * S MXDPGF GILL-MURRAY DECOMPOSITION OF A DENSE SYMMETRIC MATRIX. * S MXDPGB BACK SUBSTITUTION AFTER GILL-MURRAY DECOMPOSITION. * S MXDSMI DENSE SYMMETRIC MATRIX A IS SET TO THE UNIT MATRIX. * S MXDSMM MATRIX VECTOR PRODUCT. * S MXVCOP COPYING OF A VECTOR. * S MXVDIF DIFFERENCE OF TWO VECTORS. * RF MXVDOT DOT PRODUCT OF TWO VECTORS. * S MXVNEG COPYING OF A VECTOR WITH CHANGE OF THE SIGN. * RF MXVSAB L-1 NORM OF A VECTOR. * * EXTERNAL SUBROUTINES : * SE FUNDER COMPUTATION OF THE VALUE AND THE GRADIENT OF THE * OBJECTIVE FUNCTION. CALLING SEQUENCE: CALL FUNDER(NF,X,F,G) * WHERE NF IS A NUMBER OF VARIABLES, X(NF) IS A VECTOR OF * VARIABLES, F IS THE VALUE OF THE OBJECTIVE FUNCTION AND * G(NF) IS THE GRADIENT OF THE OBJECTIVE FUNCTION. * * METHOD : * MEX=0 - L.LUKSAN, J.VLCEK: GLOBALLY CONVERGENT VARIABLE METRIC METHOD * FOR CONVEX NONSMOOTH UNCONSTRAINED MINIMIZATION. JOTA 102 * (1999) 593-613. * MEX=1 - J.VLCEK, L.LUKSAN: GLOBALLY CONVERGENT VARIABLE METRIC METHOD * FOR NONCONVEX NONDIFFERENTIABLE UNCONSTRAINED MINIMIZATION. * REPORT B 8/1999, DEPARTMENT OF MATHEMATICAL INFORMATION * TECHNOLOGY, UNIVERSITY OF JYVASKYLA, 1999. * SUBROUTINE PVAR(NF,NA,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,CG,ICA,CFD,CR, + CZ,AF,AX,AG,G,GN,H,S,SN,XO,GO,GP,GS,TOLX,TOLF, + TOLB,TOLG,ETA,EPS,XMAX,GMAX,F,MEX,MOS,MTESX,MTESF, + MIT,MFV,IPRNT,ITERM) C .. Scalar Arguments .. DOUBLE PRECISION EPS,ETA,F,GMAX,TOLB,TOLF,TOLG,TOLX,XMAX INTEGER IPRNT,ITERM,MEX,MFV,MIT,MOS,MTESF,MTESX,NA,NB,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION AF(*),AG(*),AX(*),CF(*),CFD(*),CG(*),CL(*),CR(*), + CU(*),CZ(*),G(*),GN(*),GO(*),GP(*),GS(*),H(*), + S(*),SN(*),X(*),XL(*),XO(*),XU(*) INTEGER IC(*),ICA(*),IX(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION ALF,ALFN,ALFV,BET,CON1,CON2,DF,DMAX,EPS0,EPS1, + EPS2,EPS7,EPS9,ETA2,ETA9,FMAX,FMIN,FO,GAM,GNORM, + P,PO,POM,R,RHO,RMAX,RMIN,RO,RP,SNORM,UMAX,XNORM INTEGER I,IDECF,IER,INEW,INF,IOLD,IREST,IRET,ITERL,ITERS,JC,JE,JL, + JR,JU,K,KBC,KBF,KC,KIT,KOLD,KREM,MAL,N,NNC,NNK,NNV,NTESF, + NTESX C .. C .. External Functions .. DOUBLE PRECISION MXVDOT,MXVNOR,MXVSAB EXTERNAL MXVDOT,MXVNOR,MXVSAB C .. C .. External Subroutines .. EXTERNAL FUNDER,MXDPGF,MXDPGI,MXDSDA,MXDSMI,MXDSMM,MXDSMS,MXVCOP, + MXVDIR,MXVNEG,MXVSET,PLLPB1,PLNEWS,PS1L07,PS1L08,PUDVI2, + PYADB4,PYAGB1,PYAGB2,PYBUN1,PYRMB1,PYTRBD,PYTRBG,PYTRBS C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX,MIN,SQRT C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. IF (ABS(IPRNT).GT.1) WRITE (6,FMT='(1X,''ENTRY TO PVAR :'')') * * INITIATION * KBF = 0 KBC = 0 IF (NB.GT.0) KBF = 2 IF (NC.GT.0) KBC = 2 NIT = 0 NFV = 0 NFG = 0 KREM = 0 NREM = 0 NRES = 0 NADD = 0 NTESX = 0 NTESF = 0 ITERM = 0 ITERS = 0 IREST = 1 ITERS = 2 NDECF = 0 IDECF = 0 ETA9 = 1.0D60 EPS0 = 1.0D-6 EPS1 = 1.0D-4 EPS2 = 2.5D-1 EPS7 = 1.0D-8 EPS9 = 1.0D-8 FMAX = 1.0D60 FMIN = -FMAX IF (TOLX.LE.0.0D0) TOLX = 1.0D-8 IF (TOLF.LE.0.0D0) TOLF = 1.0D-8 IF (TOLB.EQ.0.0D0) TOLB = FMIN + 1.0D-16 IF (TOLG.LE.0.0D0) TOLG = 1.0D-6 IF (XMAX.LE.0.0D0) XMAX = 1.0D3 IF (EPS.LE.0.0D0) EPS = 0.5D0 IF (MOS.LE.0) MOS = 2 IF (MTESX.LE.0) MTESX = 2 IF (MTESF.LE.0) MTESF = 2 IF (MIT.LE.0) MIT = 1000 IF (MFV.LE.0) MFV = 2000 N = NF KIT = 0 * * INITIAL OPERATIONS WITH SIMPLE BOUNDS * IF (KBF.GT.0) THEN DO 10 I = 1,NF IF ((IX(I).EQ.3.OR.IX(I).EQ.4) .AND. XU(I).LE.XL(I)) THEN XU(I) = XL(I) IX(I) = 5 ELSE IF (IX(I).EQ.5 .OR. IX(I).EQ.6) THEN XL(I) = X(I) XU(I) = X(I) IX(I) = 5 END IF IF (IX(I).EQ.1 .OR. IX(I).EQ.3) X(I) = MAX(X(I),XL(I)) IF (IX(I).EQ.2 .OR. IX(I).EQ.3) X(I) = MIN(X(I),XU(I)) 10 CONTINUE END IF * * INITIAL OPERATIONS WITH GENERAL LINEAR CONSTRAINTS * IF (KBC.GT.0) THEN K = 0 DO 20 KC = 1,NC IF ((IC(KC).EQ.3.OR.IC(KC).EQ.4) .AND. + CU(KC).LE.CL(KC)) THEN CU(KC) = CL(KC) IC(KC) = 5 ELSE IF (IC(KC).EQ.5 .OR. IC(KC).EQ.6) THEN CU(KC) = CL(KC) IC(KC) = 5 END IF CF(KC) = MXVDOT(NF,X,CG(K+1)) K = K + NF 20 CONTINUE END IF * * DETERMINATION OF AN INITIAL FEASIBLE POINT * IF (KBC.GT.0) THEN CALL MXVSET(NF,0.0D0,GO) CALL PLLPB1(NF,NC,X,IX,XO,XL,XU,CF,CFD,IC,ICA,CL,CU,CG,CR,CZ, + GO,GO,S,1,KBF,KBC,ETA9,EPS7,EPS9,UMAX,GMAX,N, + ITERL) ELSE IF (KBF.GT.0) THEN DO 30 I = 1,NF IF (IX(I).GE.5) IX(I) = -IX(I) IF (IX(I).LE.0) THEN ELSE IF ((IX(I).EQ.1.OR.IX(I).EQ.3) .AND. + X(I).LE.XL(I)) THEN X(I) = XL(I) ELSE IF ((IX(I).EQ.2.OR.IX(I).EQ.3) .AND. + X(I).GE.XU(I)) THEN X(I) = XU(I) END IF CALL PLNEWS(X,IX,XL,XU,EPS9,I,INEW) IF (IX(I).GT.10) IX(I) = 10 - IX(I) 30 CONTINUE END IF MAL = 0 JR = 0 JC = 0 JE = 0 JU = 0 NNC = 0 NNK = 0 NNV = 0 GAM = 1.0D0 IF (MEX.EQ.0) THEN CON1 = 2.0D0 CON2 = 1.0D0 RHO = 1.0D-8 ETA2 = 1.0D-8 ELSE CON1 = 1.0D2 CON2 = 1.0D-1 RHO = 1.0D-12 ETA2 = 1.0D-12 END IF FO = FMIN * * COMPUTATION OF THE VALUE AND THE GRADIENT OF THE OBJECTIVE * FUNCTION * CALL FUNDER(NF,X,F,G) NFV = NFV + 1 NFG = NFG + 1 DF = ABS(F) + 1.0D0 CALL PYBUN1(NF,NA,MAL,X,G,F,AX,AG,AF,ITERS) CALL MXDSMI(N,H) * * START OF THE ITERATION WITH TESTS FOR TERMINATION. * 40 CONTINUE IF (ITERS.GT.0) THEN IF (MEX.EQ.0) THEN JC = 0 JU = 0 NNC = 0 END IF ALFN = 0.0D0 ALFV = 0.0D0 CALL MXVCOP(NF,G,GP) END IF CALL PYTRBG(NF,N,NC,IX,IC,ICA,CG,CR,CZ,GP,GN,UMAX,GMAX,KBF,KBC, + IOLD,KOLD) IF (ABS(IPRNT).GT.1) WRITE (6,FMT= +'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG='',I5,2X, ''F ='', +D15.8,2X,''G ='',D11.4)') NIT,NFV,NFG,F,GMAX IF (ITERM.LT.0) GO TO 80 IF (F.LE.TOLB) THEN ITERM = 3 GO TO 80 END IF IF (NIT.GE.MIT) THEN ITERM = 12 GO TO 80 END IF IF (NFV.GE.MFV) THEN ITERM = 11 GO TO 80 END IF ITERM = 0 NIT = NIT + 1 CALL PYRMB1(NF,N,IX,IC,ICA,CG,CR,CZ,GP,GN,H,EPS,UMAX,GMAX,KBF,KBC, + IOLD,KOLD,KREM,IER,ITERM) IF (ITERM.NE.0) GO TO 80 50 CONTINUE * * RESTART * IF (IREST.GT.0) THEN CALL MXDSMI(N,H) IDECF = -1 IF (KIT.LT.NIT) THEN NRES = NRES + 1 KIT = NIT ELSE ITERM = -10 IF (ITERS.LT.0) ITERM = ITERS - 5 GO TO 80 END IF END IF IF (MEX.EQ.1 .AND. JE.GT.0) GO TO 60 * * DIRECTION DETERMINATION * IF (IDECF.LT.0) THEN IDECF = 9 INF = 0 END IF IF (IDECF.EQ.0) THEN * * INVERSION * ALF = ETA2 CALL MXDPGF(N,H,INF,ALF,BET) CALL MXDPGI(N,H) NDECF = NDECF + 1 IDECF = 9 ELSE IF (IDECF.EQ.9) THEN ELSE ITERM = -1 GO TO 80 END IF GNORM = SQRT(MXVDOT(N,GN,GN)) * * NEWTON LIKE STEP * CALL MXDSMM(N,H,GN,SN) CALL MXVNEG(N,SN,SN) SNORM = SQRT(MXVDOT(N,SN,SN)) P = MXVDOT(N,GN,SN) * * TEST ON DESCENT DIRECTION * IF (P+EPS0*GNORM*SNORM.LE.0.0D0) THEN IREST = 0 ELSE IREST = 1 GO TO 50 END IF XNORM = -P + 2.0D0*ALFV POM = RHO*GNORM**2 IF (XNORM.LT.POM .OR. (JC.EQ.1.AND.JU.EQ.1)) THEN NNC = NNC + 1 IF (NNC.GE.1) JC = 1 CALL MXVDIR(N,-RHO,GN,SN,SN) CALL MXDSDA(N,H,RHO) XNORM = XNORM + POM END IF 60 CONTINUE IF (XNORM.LE.TOLG) THEN IF (SNORM.LE.0.0D0) ITERM = 4 NTESX = NTESX + 1 IF (ITERS.GT.0 .AND. DF.LT.CON1*TOLF* + MAX(ABS(F),1.0D0)) ITERM = 4 IF (NTESX.GE.2 .AND. NNK.GT.1) ITERM = 4 ELSE NTESX = 0 END IF IF (ITERM.NE.0) GO TO 80 * * PREPARATION OF LINE SEARCH * IF (SNORM.GT.0.0D0) RMAX = XMAX/SNORM RMIN = 1.0D-10 CALL PYTRBS(NF,N,NC,X,IX,XO,XL,XU,G,GO,CF,CFD,IC,CL,CU,CG,CZ,SN,S, + RO,POM,FO,F,PO,P,RMAX,KBF,KBC,KREM,INEW) IF (RMAX.LE.RMIN) THEN R = 0.0D0 GO TO 70 END IF * * LINE SEARCH WITH DIRECTIONAL DERIVATIVES WHICH ALLOWS NULL STEPS * IF (MEX.EQ.0) THEN CALL PS1L07(NF,NA,MAL,X,G,S,XO,GO,AF,AG,AX,R,RP,FO,F,PO,RMIN, + RMAX,1.0D-4*XNORM,DF,ETA9,TOLF,JL,JE,NNV,NTESF, + MTESF,ITERS) ELSE CALL PS1L08(NF,NA,MAL,X,G,S,XO,AF,AG,AX,R,RP,FO,F,PO,P,RMIN, + RMAX,SNORM,XNORM,EPS1,EPS2,ETA,ETA9,JE,MOS,ITERS) END IF IF (KBC.GT.0 .OR. KBF.GT.0) THEN IF (F.EQ.FO .AND. R.GE.RMAX .AND. INEW.NE.0) THEN ITERS = 1 END IF END IF IF (MEX.EQ.0) THEN IF (JL.GT.0 .AND. ITERS.EQ.0) F = FO IF (JL.GT.0) THEN ITERM = 2 GO TO 80 END IF IF (JE.GT.0) NTESX = 0 ELSE NNV = NNV + 1 POM = DF IF (ABS(FO-F).GE.DF*1.0D-5) POM = ABS(FO-F) IF (ITERS.GT.0) DF = POM IF (POM.LE.TOLF*MAX(ABS(F),1.0D0) .OR. + FO.EQ.F .AND. (R.LT.RMAX.OR.INEW.EQ.0)) THEN NTESF = NTESF + 1 IF (NTESF.GE.MTESF) THEN F = FO ITERM = 2 GO TO 80 END IF ELSE NTESF = 0 END IF END IF CALL PYBUN1(NF,NA,MAL,X,G,F,AX,AG,AF,ITERS) IF (RP.LT.SQRT(ETA9)) GAM = (MAX(CON2,MIN(1.0D2,RP))+2.0D0*GAM)/ + 3.0D0 IRET = 0 IF (ITERS.EQ.0) THEN NNK = NNK + 1 IF (MEX.EQ.0) THEN ALFN = ABS((FO-F)/R+P) ELSE ALFN = MAX(ABS(FO-F+P*R),ETA* (SNORM*R)**MOS) END IF IF (NNK.EQ.1) THEN CALL PYAGB2(NF,N,IX,H,G,GP,GN,SN,CZ,S,ALFN,ALFV,KBF,KBC) ELSE CALL PYAGB1(NF,N,IX,H,G,GO,GP,GN,SN,CZ,S,GS,ALFN,ALFV,KBF, + KBC) END IF F = FO ELSE NNK = 0 IF (MEX.EQ.0) THEN RHO = 1.0D-8/NFV IF (GNORM.GT.0.0D0) RHO = RHO* + MIN(1.0D0/MIN(GNORM**2,1.0D3), + GNORM**2) END IF IF (GAM.GT.1.0D0) JR = JR + 1 IF (GAM.GT.1.0D1 .AND. NNV.GT.3 .AND. JR.GT.1) THEN * * MATRIX SCALING * NNV = 0 JR = 0 CALL MXDSMS(N,H,GAM) GAM = SQRT(GAM) IRET = 1 END IF END IF CALL PYTRBD(NF,N,X,IX,XO,G,GO,CZ,SN,R,F,FO,POM,PO,DMAX,ITERS,KBF, + KBC) POM = MXVSAB(N,GO) IF (IRET.GT.0) THEN IF (POM.NE.0.0D0) JE = 0 GO TO 70 END IF IF (MEX.EQ.0) THEN JU = 0 POM = MXVDOT(N,XO,GO) IF (POM.GT.1.0D-5*R*SNORM**2 .AND. + ABS(POM).GT.1.0D-6*MXVNOR(N,XO)*MXVNOR(N,GO)) THEN CALL PUDVI2(N,H,XO,GN,GO,S,POM,RHO,JC,JU,NNK,0,NIT) END IF ELSE IF (POM.EQ.0.0D0 .AND. ITERS.GT.0) THEN JE = JE + 1 IF (JE.GT.7) JE = 99 GO TO 70 ELSE JE = 0 END IF POM = MXVDOT(N,XO,GO) IF (POM.GT.R*RHO .AND. ABS(POM).GT. + 1.0D-6*MXVNOR(N,XO)*MXVNOR(N,GO)) THEN CALL PUDVI2(N,H,XO,GN,GO,S,POM,RHO,JC,JU,NNK,1,NIT) END IF END IF 70 CONTINUE IF (ITERS.NE.0 .OR. RMAX.LE.RMIN .AND. INEW.NE.0) THEN CALL PYADB4(NF,N,NC,X,IX,XL,XU,CF,CFD,IC,ICA,CL,CU,CG,CR,CZ,H, + S,R,EPS7,EPS9,GMAX,UMAX,KBF,KBC,INEW,IER,ITERM) END IF GO TO 40 80 GMAX = XNORM IF (IPRNT.GT.1 .OR. IPRNT.LT.0) WRITE (6, + FMT='(1X,''EXIT FROM PVAR :'')') IF (IPRNT.NE.0) WRITE (6,FMT= +'(1X,''NIT='',I5,2X,''NFV='',I5,2X,''NFG='',I5,2X, ''F ='', +D15.8,2X,''G ='',D11.4,2X,''ITERM='',I3)') NIT,NFV,NFG,F,GMAX, + ITERM IF (IPRNT.LT.0) WRITE (6,FMT='(1X,''X ='',5D15.7:/(4X,5D15.7))') + (X(I),I=1,NF) RETURN END * SUBROUTINE PA1MX2 ALL SYSTEMS 92/12/01 * PORTABILITY : ALL SYSTEMS * 92/12/01 LU : ORIGINAL VERSION * * PURPOSE : * COMPUTATION OF THE VALUE AND THE GRADIENT OF THE OBJECTIVE FUNCTION * WHICH IS DEFINED AS A MAXIMUM OF THE APPROXIMATED FUNCTIONS. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II NA NUMBER OF APPROXIMATED FUNCTIONS. * RI X(NF) VECTOR OF VARIABLES. * RO F VALUE OF THE OBJECTIVE FUNCTION. * RA FA VALUE OF THE APPROXIMATED FUNCTION. * RO AF(NA) VECTOR WHOSE ELEMENTS ARE VALUES OF THE * APPROXIMATED FUNCTIONS. * RA GA(NF) GRADIENT OF THE APPROXIMATED FUNCTION. * RO AG(NF*NA) MATRIX WHOSE COLUMNS ARE GRADIENTS OF THE * APPROXIMATED FUNCTIONS. * RO G(NF) GRADIENT OF THE OBJECTIVE FUNCTION. * II KD DEGREE OF REQUIRED DERVATIVES. * IU LD DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES. * II IEXT TYPE OF OBJECTIVE FUNCTION. IEXT<0-MAXIMUM OF POSITIVE * VALUES. IEXT=0-MAXIMUM OF ABSOLUTE VALUES. IEXT>0-MAXIMUM * OF NEGATIVE VALUES. * * SUBPROGRAMS USED : * SE FUN COMPUTATION OF THE VALUE OF THE APPROXIMATED FUNCTION. * SE DER COMPUTATION OF THE GRADIENT OF THE APPROXIMATED FUNCTION. * S MXVCOP COPYING OF A VECTOR. * S MXVNEG COPYING OF A VECTOR WITH CHANGE OF THE SIGN. * SUBROUTINE PA1MX2(NF,NA,X,F,FA,AF,GA,AG,G,KD,LD,IEXT) C .. Scalar Arguments .. DOUBLE PRECISION F,FA INTEGER IEXT,KD,LD,NA,NF C .. C .. Array Arguments .. DOUBLE PRECISION AF(*),AG(*),G(*),GA(*),X(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION FTEMP,FVAL INTEGER K,KA,KAP,L,NAG,NAV C .. C .. External Subroutines .. EXTERNAL DER,FUN,MXVCOP,MXVNEG C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. C .. Save statement .. SAVE NAV,NAG,KAP C .. IF (NIT.EQ.0) THEN NAV = 0 NAG = 0 END IF IF (KD.LE.LD) RETURN DO 20 KA = 1,NA IF (KD.LT.0) GO TO 20 IF (LD.GE.0) THEN FA = AF(KA) GO TO 10 ELSE NAV = NAV + 1 CALL FUN(NF,KA,X,FA) AF(KA) = FA END IF IF (IEXT.EQ.0 .AND. FA.GE.0.0D0 .OR. IEXT.LT.0) THEN FTEMP = FA K = 1 ELSE FTEMP = -FA K = -1 END IF IF (KA.EQ.1 .OR. FVAL.LT.FTEMP) THEN FVAL = FTEMP KAP = KA L = K END IF 10 IF (KD.LT.1) GO TO 20 NAG = NAG + 1 CALL DER(NF,KA,X,GA) CALL MXVCOP(NF,GA,AG((KA-1)*NF+1)) 20 CONTINUE IF (KD.GE.0 .AND. LD.LT.0) F = FVAL IF (KD.GE.1 .AND. LD.LT.1) THEN IF (L.GE.0) THEN CALL MXVCOP(NF,AG((KAP-1)*NF+1),G) ELSE CALL MXVNEG(NF,AG((KAP-1)*NF+1),G) END IF END IF NFV = NAV/NA NFG = NAG/NA LD = KD RETURN END * SUBROUTINE PF1HS1 ALL SYSTEMS 90/12/01 * PORTABILITY : ALL SYSTEMS * 90/12/01 LU : ORIGINAL VERSION * * PURPOSE : * NUMERICAL COMPUTATION OF THE HESSIAN MATRIX OF THE MODEL FUNCTION * USING ITS GRADIENTS. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * RI X(NF) VECTOR OF VARIABLES. * RO HF(M) HESSIAN MATRIX OF THE MODEL FUNCTION. * RI GF(NF) GRADIENT OF THE MODEL FUNCTION. * RA GO(NF) AUXILIARY VECTOR. * RI ETA1 PRECISION OF COMPUTED GRADIENTS. * * * SUBPROGRAMS USED : * SE FUNDER OBJECTIVE FUNCTION AND SUBGRADIENT EVALUATION. * S MXVCOP COPYING OF A VECTOR. * SUBROUTINE PF1HS1(NF,X,HF,GF,GO,ETA1) C .. Scalar Arguments .. DOUBLE PRECISION ETA1 INTEGER NF C .. C .. Array Arguments .. DOUBLE PRECISION GF(*),GO(*),HF(*),X(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION ETA,FTEMP,XSTEP,XTEMP INTEGER I,IJ,IVAR,J C .. C .. External Subroutines .. EXTERNAL FUNDER,MXVCOP C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX,MIN,SQRT C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. C .. Statement Functions .. INTEGER IND C .. C .. Statement Function definitions .. IND(I,J) = MAX(I,J)* (MAX(I,J)-1)/2 + MIN(I,J) C .. CALL MXVCOP(NF,GF,GO) ETA = SQRT(ETA1) DO 20 IVAR = 1,NF * * STEP SELECTION * XTEMP = X(IVAR) IF (XTEMP.GE.0.0D0) THEN XSTEP = ETA*MAX(ABS(XTEMP),1.0D0) ELSE XSTEP = -ETA*MAX(ABS(XTEMP),1.0D0) END IF X(IVAR) = XTEMP + XSTEP XSTEP = X(IVAR) - XTEMP CALL FUNDER(NF,X,FTEMP,GF) NFG = NFG + 1 * * NUMERICAL DIFFERENTIATION * DO 10 J = 1,NF IJ = IND(IVAR,J) IF (J.GE.IVAR) THEN HF(IJ) = (GF(J)-GO(J))/XSTEP ELSE HF(IJ) = 0.5D0* (HF(IJ)+ (GF(J)-GO(J))/XSTEP) END IF 10 CONTINUE X(IVAR) = XTEMP 20 CONTINUE CALL MXVCOP(NF,GO,GF) RETURN END * SUBROUTINE PDDXQ1 ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * DUAL RANGE SPACE QUADRATIC PROGRAMMING METHOD FOR MINIMAX * APPROXIMATION. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NA NUMBER OF LINEAR APPROXIMATED FUNCTIONS. * II NC NUMBER OF LINEAR CONSTRAINTS. * RI X(NF) VECTOR OF VARIABLES. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. * RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * RI AF(NA) VECTOR CONTAINING VALUES OF THE APPROXIMATED * FUNCTIONS. * RO AFD(NA) VECTOR CONTAINING INCREMENTS OF THE APPROXIMATED * FUNCTIONS. * II IA(NA) VECTOR CONTAINING TYPES OF DEVIATIONS. * IO IAA(NF+1) VECTOR CONTAINING INDICES OF ACTIVE FUNCTIONS. * RI AG(NF*NA) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * APPROXIMATED FUNCTIONS. * RO AR((NF+1)*(NF+2)/2) TRIANGULAR DECOMPOSITION OF KERNEL OF THE * ORTHOGONAL PROJECTION. * RO AZ(NF+1) VECTOR OF LAGRANGE MULTIPLIERS. * RI CF(NF) VECTOR CONTAINING VALUES OF THE CONSTRAINT FUNCTIONS. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * RI CL(NC) VECTOR CONTAINING LOWER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CU(NC) VECTOR CONTAINING UPPER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RO G(NF+1) GRADIENT OF THE LAGRANGIAN FUNCTION. * RU H(NF*(NF+1)/2) TRIANGULAR DECOMPOSITION OR INVERSION OF THE * HESSIAN MATRIX APPROXIMATION. * RO S(NF+1) DIRECTION VECTOR. * RI F VALUE OF THE OBJECTIVE FUNCTION. * II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS. * KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS. * II KBC SPECIFICATION OF LINEAR CONSTRAINTS. KBC=0-NO LINEAR * CONSTRAINTS. KBC=1-ONE SIDED LINEAR CONSTRAINTS. KBC=2=TWO * SIDED LINEAR CONSTRAINTS. * IU IDECF DECOMPOSITION INDICATOR. IDECF=0-NO DECOMPOSITION. * IDECF=1-GILL-MURRAY DECOMPOSITION. IDECF=9-INVERSION. * IDECF=10-DIAGONAL MATRIX. * RI ETA0 MACHINE PRECISION. * RI ETA2 TOLERANCE FOR POSITIVE DEFINITENESS OF THE HESSIAN MATRIX. * RI ETA9 MAXIMUM FOR REAL NUMBERS. * RI EPS7 TOLERANCE FOR LINEAR INDEPENDENCE OF CONSTRAINTS. * RI EPS9 TOLERANCE FOR ACTIVITY OF CONSTRAINTS. * RI TOLG TOLERANCE FOR THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RO UMAX MAXIMUM LAGRANGE MULTIPLIER. * RO GMAX MAXIMUM PARTIAL DERIVATIVE. * RO GNORM NORM OF THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RO SNORM NORM OF THE DIRECTION VECTOR. * RO XNORM VALUE OF LINEARIZED MINIMAX FUNCTION. * IO N DIMENSION OF MANIFOLD DEFINED BY ACTIVE CONSTRAINTS. * IO ITERQ TYPE OF FEASIBLE POINT. ITERQ=1-ARBITRARY FEASIBLE POINT. * ITERQ=2-OPTIMUM FEASIBLE POINT. ITERQ=-1 FEASIBLE POINT DOES * NOT EXISTS. ITERQ=-2 OPTIMUM FEASIBLE POINT DOES NOT EXISTS. * IO ITERD TYPE OF DIRECTION VECTOR. ITERD=1-CORRECT DIRECTION * VECTOR. ITERD=<0-FAILURE IN QUADRATIC PROGRAMMING. * IO ITERM CAUSE OF TERMINATION. * * SUBPROGRAMS USED : * S PLQDF1 DUAL RANGE SPACE QUADRATIC PROGRAMMING METHOD FOR * MINIMAX APPROXIMATION WITH LINEAR CONSTRAINTS. * RF MXVDOT DOT PRODUCT OF TWO VECTORS. * RF MXVMAX L-INFINITY NORM OF A VECTOR. * SUBROUTINE PDDXQ1(NF,NA,NC,X,IX,XL,XU,AF,AFD,IA,IAA,AG,AR,AZ,CF, + IC,CL,CU,CG,G,H,S,F,KBF,KBC,IDECF,ETA0,ETA2, + ETA9,EPS7,EPS9,TOLG,UMAX,GMAX,GNORM,SNORM,XNORM, + N,ITERQ,ITERD,ITERM) * * SPECIAL QUADRATIC PROGRAMMING SUBROUTINE * C .. Scalar Arguments .. DOUBLE PRECISION EPS7,EPS9,ETA0,ETA2,ETA9,F,GMAX,GNORM,SNORM,TOLG, + UMAX,XNORM INTEGER IDECF,ITERD,ITERM,ITERQ,KBC,KBF,N,NA,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION AF(*),AFD(*),AG(*),AR(*),AZ(*),CF(*),CG(*),CL(*), + CU(*),G(*),H(*),S(*),X(*),XL(*),XU(*) INTEGER IA(*),IAA(*),IC(*),IX(*) C .. C .. Local Scalars .. INTEGER MFP C .. C .. External Functions .. DOUBLE PRECISION MXVDOT,MXVMAX EXTERNAL MXVDOT,MXVMAX C .. C .. External Subroutines .. EXTERNAL PLQDF1 C .. C .. Intrinsic Functions .. INTRINSIC ABS,MIN,SQRT C .. MFP = 2 CALL PLQDF1(NF,NA,NC,X,IX,XL,XU,AF,AFD,IA,IAA,AG,AR,AZ,CF,IC,CL, + CU,CG,G,H,S,MFP,KBF,KBC,IDECF,ETA0,ETA2,ETA9,EPS7, + EPS9,XNORM,UMAX,GMAX,N,ITERQ) IF (ITERQ.LT.0) THEN ITERD = ITERQ - 10 RETURN END IF ITERD = 1 * * COMPUTATION OF VALUES FOR TERMINATION CRITERIA * GMAX = MXVMAX(NF,G) GNORM = SQRT(MXVDOT(NF,G,G)) SNORM = SQRT(MXVDOT(NF,S,S)) IF (GMAX.LE.1.0D-2*TOLG* (MIN(1.0D0,ABS(F)))) THEN ITERM = 4 END IF RETURN END * SUBROUTINE PDDBQ1 ALL SYSTEMS 96/12/01 * PORTABILITY : ALL SYSTEMS * 96/12/01 VL : ORIGINAL VERSION * * PURPOSE : * DUAL RANGE SPACE QUADRATIC PROGRAMMING METHOD FOR MINIMAX * APPROXIMATION AND BUNDLE UPDATING. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NA MAXIMUM BUNDLE DIMENSION. * II NC NUMBER OF LINEAR CONSTRAINTS. * RI X(NF) VECTOR OF VARIABLES. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. * RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * RU F COMPUTED VALUE OF THE OBJECTIVE FUNCTION. * RI FO PREVIOUS VALUE OF THE OBJECTIVE FUNCTION. * RU FP CURRENT MINIMUM VALUE OF THE OBJECTIVE FUNCTION. * RO FUB COMPARED VALUE OF THE OBJECTIVE FUNCTION. * RU AF(4*NA) VECTOR OF BUNDLE VALUES. * RO AFD(NA) VECTOR CONTAINING INCREMENTS OF BUNDLE FUNCTIONS. * IU IA(NA) VECTOR CONTAINING TYPES OF DEVIATIONS. * IO IAA(NF+1) VECTOR CONTAINING INDICES OF ACTIVE FUNCTIONS. * RU AG(NF*NA) MATRIX WHOSE COLUMNS ARE BUNDLE GRADIENTS. * RO AR((NF+1)*(NF+2)/2) TRIANGULAR DECOMPOSITION OF KERNEL OF THE * ORTHOGONAL PROJECTION. * RO AZ(NF+1) VECTOR OF LAGRANGE MULTIPLIERS. * RI CF(NF) VECTOR CONTAINING VALUES OF THE CONSTRAINT FUNCTIONS. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * RI CL(NC) VECTOR CONTAINING LOWER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CU(NC) VECTOR CONTAINING UPPER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RI G(NF) SUBGRADIENT OF THE OBJECTIVE FUNCTION. * RU H(NF) DIAGONAL MATRIX OF WEIGHT PARAMETERS. * RU S(NF+1) DIRECTION VECTOR. * RI XO(NF) INCREMENT VECTOR. * RU GO(NF+1) GRADIENT OF THE LAGRANGIAN FUNCTION. * RA XS(NF) AUXILIARY VECTOR. * RA GS(NF) AUXILIARY VECTOR. * RO P VALUE OF THE DIRECTIONAL DERIVATIVE. * RO R VALUE OF THE STEPSIZE PARAMETER. * RO RP VALUE OF THE STEPSIZE PARAMETER CORRESPONDING TO THE * CURRENT MINIMUM VALUE OF THE OBJECTIVE FUNCTION. * RU TO WEIGHT PARAMETER. * II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS. * KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS. * II KBC SPECIFICATION OF LINEAR CONSTRAINTS. KBC=0-NO LINEAR * CONSTRAINTS. KBC=1-ONE SIDED LINEAR CONSTRAINTS. KBC=2=TWO * SIDED LINEAR CONSTRAINTS. * IU IDECF DECOMPOSITION INDICATOR. IDECF=0-NO DECOMPOSITION. * IDECF=1-GILL-MURRAY DECOMPOSITION. IDECF=9-INVERSION. * IDECF=10-DIAGONAL MATRIX. * RI ETA0 MACHINE PRECISION. * RI ETA2 TOLERANCE FOR POSITIVE DEFINITENESS OF THE HESSIAN MATRIX. * RI ETA9 MAXIMUM FOR REAL NUMBERS. * RI EPS7 TOLERANCE FOR LINEAR INDEPENDENCE OF CONSTRAINTS. * RI EPS9 TOLERANCE FOR ACTIVITY OF CONSTRAINTS. * RI TOLF TOLERANCE FOR CHANGE OF FUNCTION VALUES. * RI TOLG TOLERANCE FOR THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RI ETA DISTANCE MEASURE PARAMETER. * RO UMAX MAXIMUM ABSOLUTE VALUE OF A NEGATIVE LAGRANGE MULTIPLIER. * RO GMAX MAXIMUM ABSOLUTE VALUE OF A PARTIAL DERIVATIVE. * RO GNORM NORM OF THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RO SNORM NORM OF THE DIRECTION VECTOR. * RA XNORM AUXILIARY VARIABLE. * IO N DIMENSION OF MANIFOLD DEFINED BY ACTIVE CONSTRAINTS. * IU MAL CURRENT BUNDLE DIMENSION. * II NIT ACTUAL NUMBER OF ITERATIONS. * II MOS WEIGHT UPDATING METHOD SPECIFICATION. MOS=1-QUADRATIC * INTERPOLATION (MES2=1) OR LOCAL MINIMUM LOCALIZATION (MES2=2). * MOS=2-QUASI-NEWTON CONDITION. * IU NTESF ACTUAL NUMBER OF TESTS ON FUNCTION DECREASE. * IU NTESX ACTUAL NUMBER OF TESTS ON STEPLENGTH. * IO ITERQ TYPE OF FEASIBLE POINT. ITERQ=1-ARBITRARY FEASIBLE POINT. * ITERQ=2-OPTIMUM FEASIBLE POINT. ITERQ=-1 FEASIBLE POINT DOES * NOT EXISTS. ITERQ=-2 OPTIMUM FEASIBLE POINT DOES NOT EXISTS. * IO ITERD TERMINATION INDICATOR. ITERD<0-BAD DECOMPOSITION. * ITERD=0-DESCENT DIRECTION. ITERD=1-NEWTON LIKE STEP. * ITERD=2-INEXACT NEWTON LIKE STEP. ITERD=3-BOUNDARY STEP. * ITERD=4-DIRECTION WITH THE NEGATIVE CURVATURE. * ITERD=5-MARQUARDT STEP. * IO ITERS TERMINATION INDICATOR. ITERS=0-ZERO STEP. ITERS=1-PERFECT * LINE SEARCH. ITERS=2 GOLDSTEIN STEPSIZE. ITERS=3-CURRY * STEPSIZE. ITERS=4-EXTENDED CURRY STEPSIZE. * ITERS=5-ARMIJO STEPSIZE. ITERS=6-FIRST STEPSIZE. * ITERS=7-MAXIMUM STEPSIZE. ITERS=8-UNBOUNDED FUNCTION. * ITERS=9-SHORT STEP. ITERS=10-ZERO STEP. * ITERS=-1-MRED REACHED. ITERS=-2-POSITIVE DIRECTIONAL * DERIVATIVE. ITERS=-3-ERROR IN INTERPOLATION. * IO ITERM CAUSE OF TERMINATION. * * SUBPROGRAMS USED : * S PLQDF1 DUAL RANGE SPACE QUADRATIC PROGRAMMING METHOD FOR MINIMAX * APPROXIMATION WITH LINEAR CONSTRAINTS. * S MXVDIR VECTOR AUGMENTED BY THE SCALED VECTOR. * RF MXVDOT DOT PRODUCT OF TWO VECTORS. * S MXVCOP COPYING OF A VECTOR. * S MXVSET INITIATION OF A VECTOR. * SUBROUTINE PDDBQ1(NF,NA,NC,X,IX,XL,XU,F,FO,FP,FUB,AF,AFD,IA,IAA, + AG,AR,AZ,CF,IC,CL,CU,CG,G,H,S,XO,GO,XS,GS,P,R, + RP,TO,KBF,KBC,IDECF,ETA0,ETA2,ETA9,EPS7,EPS9, + TOLF,TOLG,ETA,UMAX,GMAX,GNORM,SNORM,XNORM,N,MAL, + NIT,MOS,NTESF,NTESX,ITERQ,ITERD,ITERS,ITERM) * * INITIALIZATION * C .. Parameters .. DOUBLE PRECISION HALF,ONE,ZERO PARAMETER (HALF=5.0D-1,ONE=1.0D0,ZERO=0.0D0) C .. C .. Scalar Arguments .. DOUBLE PRECISION EPS7,EPS9,ETA,ETA0,ETA2,ETA9,F,FO,FP,FUB,GMAX, + GNORM,P,R,RP,SNORM,TO,TOLF,TOLG,UMAX,XNORM INTEGER IDECF,ITERD,ITERM,ITERQ,ITERS,KBC,KBF,MAL,MOS,N,NA,NC,NF, + NIT,NTESF,NTESX C .. C .. Array Arguments .. DOUBLE PRECISION AF(*),AFD(*),AG(*),AR(*),AZ(*),CF(*),CG(*),CL(*), + CU(*),G(*),GO(*),GS(*),H(*),S(*),X(*),XL(*), + XO(*),XS(*),XU(*) INTEGER IA(*),IAA(*),IC(*),IX(*) C .. C .. Local Scalars .. DOUBLE PRECISION DELF,FS,FU,PU,TOS,WK INTEGER I,IND,K,KA,L,MFP C .. C .. External Functions .. DOUBLE PRECISION MXVDOT,MXVMAX,MXVNM2 EXTERNAL MXVDOT,MXVMAX,MXVNM2 C .. C .. External Subroutines .. EXTERNAL MXVCOP,MXVDIR,MXVSET,PLQDF1 C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX,MIN,SQRT C .. C .. Save statement .. SAVE DELF,FU,PU,TOS,WK,IND C .. IF (NIT.LE.1) THEN CALL MXVCOP(NF,G,GO) CALL MXVCOP(NF,GO,AG(1)) CALL MXVSET(NF,ZERO,S) SNORM = ZERO RP = ZERO R = ZERO FP = F FU = ZERO PU = ZERO IA(1) = 2 MAL = 0 WK = ZERO IND = 0 TO = ONE TOS = ONE IDECF = 10 END IF * * MATRIX UPDATE * IF (MOS.EQ.2) THEN IF (IND.GE.1 .AND. ITERS.NE.9 .AND. NIT.GT.3) THEN WK = MXVDOT(NF,XS,XS) FS = (MXVDOT(NF,GO,XS)-MXVDOT(NF,GS,XS))/WK WK = MXVNM2(NF,GO,GS)/SQRT(WK) TOS = MIN(MAX(ABS(FS),1D-3),1D3) IF (FS.LT.WK*1D-3) TOS = MIN(MAX(WK,1D-3),1D4) IND = IND + 1 END IF TO = TOS IF (ITERS.EQ.5) THEN CALL MXVCOP(NF,XO,XS) CALL MXVCOP(NF,GO,GS) IND = 1 + MIN(1,IND) END IF END IF CALL MXVSET(NF,TO,H) * * BUNDLE VALUES UPDATE * FS = F IF (ITERS.GE.9) FS = FS - (R-RP)*P K = 1 DO 10 KA = 1,MAL AF(NA+NA+KA) = AF(NA+NA+KA) + RP*SNORM IF (IA(KA).GT.0) THEN ELSE IF (IA(KA).LT.0) THEN AFD(KA) = MXVDOT(NF,AG(K),S) END IF K = K + NF 10 CONTINUE CALL MXVDIR(MAL,RP,AFD,AF(NA+1),AF(NA+1)) PU = PU + RP*SNORM FU = FU + RP*MXVDOT(NF,AG,S) * * BUNDLE REDUCTION * DO 30 L = MAL,1,-1 IF (IA(L).NE.0) GO TO 30 K = (L-1)*NF + 1 DO 20 KA = L,MAL - 1 AF(NA+KA) = AF(NA+KA+1) AF(NA+NA+KA) = AF(NA+NA+KA+1) AF(NA*3+KA) = AF(NA*3+KA+1) IA(KA) = IA(KA+1) CALL MXVCOP(NF,AG(K+NF),AG(K)) K = K + NF 20 CONTINUE MAL = MAL - 1 30 CONTINUE IF (MAL.GE.NA) THEN K = NF + 1 DO 40 KA = 2,MAL - 1 AF(NA+KA) = AF(NA+KA+1) AF(NA+NA+KA) = AF(NA+NA+KA+1) AF(NA*3+KA) = AF(NA*3+KA+1) IA(KA) = IA(KA+1) CALL MXVCOP(NF,AG(K+NF),AG(K)) K = K + NF 40 CONTINUE MAL = MAL - 1 END IF * * BUNDLE COMPLETION * MAL = MAX(2,MAL+1) K = (MAL-1)*NF + 1 AF(NA+1) = FU AF(NA+MAL) = FS AF(NA+NA+1) = PU AF(NA+NA+MAL) = (R-RP)*SNORM AF(NA*3+MAL) = SQRT(MXVDOT(NF,G,G)) DO 50 KA = 1,MAL AF(KA) = -MAX(ABS(AF(NA+KA)-FP),ETA*AF(NA+NA+KA)**2) 50 CONTINUE CALL MXVCOP(NF,G,AG(K)) IA(MAL) = 2 * * MAIN STOPPING CRITERION * F = FP IF (ITERS.LE.0) F = FO IF (MOS.EQ.1) WK = HALF* (SNORM*TO)**2 + + 5D2*MAX(ABS(FU-FP),PU*PU)/ (ABS(FP)+1D-3) IF (MOS.EQ.2) WK = HALF*GNORM*SNORM + + 5D1*MAX(ABS(FU-FP),ETA*PU*PU)/ (ABS(FP)+1D-3) IF (NIT.LE.1) WK = ONE IF (WK.LE.TOLG) THEN ITERM = 4 NIT = NIT - 1 GO TO 100 END IF * * PREPARATION FOR QUADRATIC PROGRAMMING * IF (NTESX.GT.0 .AND. NTESX.LT.NTESF) NTESF = NTESX IF (NIT.LE.1) DELF = ONE IF (FO.NE.F) DELF = ABS(FO-F)/MAX(ABS(F),ONE) MFP = 2 60 CALL PLQDF1(NF,MAL,NC,X,IX,XL,XU,AF,AFD,IA,IAA,AG,AR,AZ,CF,IC,CL, + CU,CG,GO,H,S,MFP,KBF,KBC,IDECF,ETA0,ETA2,ETA9,EPS7, + EPS9,XNORM,UMAX,GMAX,N,ITERQ) IF (ITERQ.LT.0) THEN ITERD = -2 GO TO 80 END IF ITERD = 1 GMAX = MXVMAX(NF,GO) GNORM = SQRT(MXVDOT(NF,GO,GO)) SNORM = SQRT(MXVDOT(NF,S,S)) IF (DELF.LE.TOLF .OR. ABS(FO-F)/MAX(ABS(F),ONE).GT.ONE) THEN ELSE IF (GNORM.LT.TOLG*TOLG*MXVMAX(MAL-1,AF(NA*3+2))) THEN * * REDEFINE BUNDLE FOR TOO SMALL DIRECTION VECTOR * I = MAL DO 70 KA = MAL,1,-1 IF (IA(KA).LT.0) I = KA 70 CONTINUE IF (I.EQ.MAL) GO TO 80 IA(I) = 0 GO TO 60 END IF 80 CONTINUE * * AGGREGATION * FU = ZERO PU = ZERO DO 90 KA = 1,NF - N L = IAA(KA) IF (L.GT.NC) THEN L = L - NC IF (L.GT.0) FU = FU - AZ(KA)*AF(NA+L) IF (L.GT.0) PU = PU - AZ(KA)*AF(NA+NA+L) END IF 90 CONTINUE CALL MXVCOP(NF,GO,AG(1)) * * PREPARATION FOR UYTRXD.I - TEST VALUES DETERMINATION * 100 FUB = FP RETURN END * SUBROUTINE PDDBQ2 ALL SYSTEMS 96/12/01 * PORTABILITY : ALL SYSTEMS * 96/12/01 VL : ORIGINAL VERSION * * PURPOSE : * DUAL RANGE SPACE QUADRATIC PROGRAMMING METHOD FOR MINIMAX * APPROXIMATION AND BUNDLE UPDATING * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NA MAXIMUM BUNDLE DIMENSION. * II NC NUMBER OF LINEAR CONSTRAINTS. * RI X(NF) VECTOR OF VARIABLES. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. * RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * RU F COMPUTED VALUE OF THE OBJECTIVE FUNCTION. * RI FO PREVIOUS VALUE OF THE OBJECTIVE FUNCTION. * RU FP CURRENT MINIMUM VALUE OF THE OBJECTIVE FUNCTION. * RO FUB COMPARED VALUE OF THE OBJECTIVE FUNCTION. * RU AF(5*NA) VECTOR OF BUNDLE VALUES. * RO AFD(NA) VECTOR CONTAINING INCREMENTS OF BUNDLE FUNCTIONS. * IU IA(NA) VECTOR CONTAINING TYPES OF DEVIATIONS. * IO IAA(NF+1) VECTOR CONTAINING INDICES OF ACTIVE FUNCTIONS. * RU AG(NF*NA) MATRIX WHOSE COLUMNS ARE BUNDLE GRADIENTS. * RO AR((NF+1)*(NF+2)/2) TRIANGULAR DECOMPOSITION OF KERNEL OF THE * ORTHOGONAL PROJECTION. * RO AZ(NF+1) VECTOR OF LAGRANGE MULTIPLIERS. * RI CF(NF) VECTOR CONTAINING VALUES OF THE CONSTRAINT FUNCTIONS. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * RI CL(NC) VECTOR CONTAINING LOWER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CU(NC) VECTOR CONTAINING UPPER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RI G(NF) SUBGRADIENT OF THE OBJECTIVE FUNCTION. * RI H(NF*(NF+1)/2) AGGREGATE HESSIAN MATRIX. * RI HF(NF*(NF+1)/2) HESSIAN MATRIX OF THE OBJECTIVE FUNCTION. * RU AH(NF*(NF+1)/2*NA) FIELD CONTAINING BUNDLE HESSIAN MATRICES. * RU S(NF+1) DIRECTION VECTOR. * RU GO(NF+1) GRADIENT OF THE LAGRANGIAN FUNCTION. * RO P VALUE OF THE DIRECTIONAL DERIVATIVE. * RO R VALUE OF THE STEPSIZE PARAMETER. * RO RP VALUE OF THE STEPSIZE PARAMETER CORRESPONDING TO THE * CURRENT MINIMUM VALUE OF THE OBJECTIVE FUNCTION. * II MFP TYPE OF FEASIBLE POINT. MFP=1-ARBITRARY FEASIBLE POINT. * MFP=2-OPTIMUM FEASIBLE POINT. * II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS. * KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS. * II KBC SPECIFICATION OF LINEAR CONSTRAINTS. KBC=0-NO LINEAR * CONSTRAINTS. KBC=1-ONE SIDED LINEAR CONSTRAINTS. KBC=2=TWO * SIDED LINEAR CONSTRAINTS. * IU IDECF DECOMPOSITION INDICATOR. IDECF=0-NO DECOMPOSITION. * IDECF=1-GILL-MURRAY DECOMPOSITION. IDECF=9-INVERSION. * IDECF=10-DIAGONAL MATRIX. * RI ETA0 MACHINE PRECISION. * RI ETA2 TOLERANCE FOR POSITIVE DEFINITENESS OF THE HESSIAN MATRIX. * RI ETA9 MAXIMUM FOR REAL NUMBERS. * RI EPS7 TOLERANCE FOR LINEAR INDEPENDENCE OF CONSTRAINTS. * RI EPS9 TOLERANCE FOR ACTIVITY OF CONSTRAINTS. * RI TOLF TOLERANCE FOR CHANGE OF FUNCTION VALUES. * RI TOLG TOLERANCE FOR THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RI ETA DISTANCE MEASURE PARAMETER. * RO UMAX MAXIMUM ABSOLUTE VALUE OF A NEGATIVE LAGRANGE MULTIPLIER. * RO GMAX MAXIMUM ABSOLUTE VALUE OF A PARTIAL DERIVATIVE. * RO GNORM NORM OF THE GRADIENT OF THE LAGRANGIAN FUNCTION. * RO SNORM NORM OF THE DIRECTION VECTOR. * RA XNORM AUXILIARY VARIABLE. * IO N DIMENSION OF MANIFOLD DEFINED BY ACTIVE CONSTRAINTS. * IU MAL CURRENT BUNDLE DIMENSION. * II NIT ACTUAL NUMBER OF ITERATIONS. * II MOS EXPONENT FOR DISTANCE MEASURE. * IU NTESF ACTUAL NUMBER OF TESTS ON FUNCTION DECREASE. * IU NTESX ACTUAL NUMBER OF TESTS ON STEPLENGTH. * IO ITERQ TYPE OF FEASIBLE POINT. ITERQ=1-ARBITRARY FEASIBLE POINT. * ITERQ=2-OPTIMUM FEASIBLE POINT. ITERQ=-1 FEASIBLE POINT DOES * NOT EXISTS. ITERQ=-2 OPTIMUM FEASIBLE POINT DOES NOT EXISTS. * IO ITERD TERMINATION INDICATOR. ITERD<0-BAD DECOMPOSITION. * ITERD=0-DESCENT DIRECTION. ITERD=1-NEWTON LIKE STEP. * ITERD=2-INEXACT NEWTON LIKE STEP. ITERD=3-BOUNDARY STEP. * ITERD=4-DIRECTION WITH THE NEGATIVE CURVATURE. * ITERD=5-MARQUARDT STEP. * IO ITERS TERMINATION INDICATOR. ITERS=0-ZERO STEP. ITERS=1-PERFECT * LINE SEARCH. ITERS=2 GOLDSTEIN STEPSIZE. ITERS=3-CURRY * STEPSIZE. ITERS=4-EXTENDED CURRY STEPSIZE. * ITERS=5-ARMIJO STEPSIZE. ITERS=6-FIRST STEPSIZE. * ITERS=7-MAXIMUM STEPSIZE. ITERS=8-UNBOUNDED FUNCTION. * ITERS=9-SHORT STEP. ITERS=10-ZERO STEP. * ITERS=-1-MRED REACHED. ITERS=-2-POSITIVE DIRECTIONAL * DERIVATIVE. ITERS=-3-ERROR IN INTERPOLATION. * IO ITERM CAUSE OF TERMINATION. * * SUBPROGRAMS USED : * SE FUNDER OBJECTIVE FUNCTION AND SUBGRADIENT EVALUATION. * S PLQDF1 DUAL RANGE SPACE QUADRATIC PROGRAMMING METHOD FOR MINIMAX * APPROXIMATION WITH LINEAR CONSTRAINTS. * S MXPDGF GILL-MURRAY DECOMPOSITION OF A DENSE SYMMETRIC MATRIX. * S MXPDGB BACK SUBSTITUTION AFTER GILL-MURRAY DECOMPOSITION. * S MXDPRB BACK SUBSTITUTION AFTER CHOLESKI DECOMPOSITION. * S MXDSMM MATRIX VECTOR PRODUCT. * RF MXDSMQ VALUE OF A QUADRATIC FORM WITH A DENSE SYMMETRIC MATRIX. * S MXVDIR VECTOR AUGMENTED BY THE SCALED VECTOR. * RF MXVDOT DOT PRODUCT OF TWO VECTORS. * S MXVCOP COPYING OF A VECTOR. * S MXVINA ABSOLUTE VALUES OF ELEMENTS OF INTEGER VECTOR. * S MXVINV CHANGE OF INTEGER VECTOR AFTER CONSTRAINT ADDITION. * RF MXVMAX L-INFINITY NORM OF A VECTOR. * S MXVNEG COPYING OF A VECTOR WITH CHANGE OF THE SIGN. * S MXVSET INITIATION OF A VECTOR. * SUBROUTINE PDDBQ2(NF,NA,NC,X,IX,XL,XU,F,FO,FP,FUB,AF,AFD,IA,IAA, + AG,AR,AZ,CF,IC,CL,CU,CG,G,H,HF,AH,S,GO,P,R,RP, + KBF,KBC,IDECF,ETA0,ETA2,ETA9,EPS7,EPS9,TOLF, + TOLG,ETA,UMAX,GMAX,GNORM,SNORM,XNORM,N,MAL,NIT, + MOS,NTESF,NTESX,ITERQ,ITERD,ITERS,ITERM) C .. Parameters .. DOUBLE PRECISION HALF,ONE,ZERO PARAMETER (HALF=5D-1,ONE=1D0,ZERO=0D0) C .. C .. Scalar Arguments .. DOUBLE PRECISION EPS7,EPS9,ETA,ETA0,ETA2,ETA9,F,FO,FP,FUB,GMAX, + GNORM,P,R,RP,SNORM,TOLF,TOLG,UMAX,XNORM INTEGER IDECF,ITERD,ITERM,ITERQ,ITERS,KBC,KBF,MAL,MOS,N,NA,NC,NF, + NIT,NTESF,NTESX C .. C .. Array Arguments .. DOUBLE PRECISION AF(*),AFD(*),AG(*),AH(*),AR(*),AZ(*),CF(*),CG(*), + CL(*),CU(*),G(*),GO(*),H(*),HF(*),S(*),X(*), + XL(*),XU(*) INTEGER IA(*),IAA(*),IC(*),IX(*) C .. C .. Local Scalars .. DOUBLE PRECISION DELF,FS,FU,FV,PP,PU,PV,WK INTEGER I,IND,IPOC,J,K,KA,L,MFP,NFF LOGICAL LA,LQ C .. C .. External Functions .. DOUBLE PRECISION MXDSMQ,MXVDOT,MXVMAX EXTERNAL MXDSMQ,MXVDOT,MXVMAX C .. C .. External Subroutines .. EXTERNAL MXDSMM,MXVCOP,MXVDIR,MXVSET,PLQDF1 C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX,SQRT C .. C .. Save statement .. SAVE DELF,FS,FU,PU,PP,WK,IND,IPOC C .. NFF = NF* (NF+1)/2 I = NA*4 * * INITIALIZATION * IF (NIT.LE.1) THEN CALL MXVCOP(NF,G,GO) CALL MXVCOP(NF,GO,AG) CALL MXVCOP(NFF,HF,H) CALL MXVCOP(NFF,HF,AH) CALL MXVSET(NF,ZERO,S) AF(I+1) = ZERO GNORM = ZERO SNORM = ZERO RP = ZERO R = ZERO FP = F FU = ZERO PU = ZERO IA(1) = 2 MAL = 0 IPOC = 0 IND = 0 WK = ZERO END IF * * NULL STEPS COUNTER * IPOC = IPOC + 1 IF (ITERS.NE.10) IPOC = 0 LQ = IPOC .LE. 3 * * BUNDLE VALUES s, f LINEAR UPDATE * K = 1 DO 10 KA = 1,MAL AF(NA+NA+KA) = AF(NA+NA+KA) + RP*SNORM IF (IA(KA).GT.0) THEN ELSE IF (IA(KA).LT.0) THEN AFD(KA) = MXVDOT(NF,AG(K),S) END IF K = K + NF 10 CONTINUE CALL MXVDIR(MAL,RP,AFD,AF(NA+1),AF(NA+1)) PU = PU + RP*SNORM FU = FU + RP*MXVDOT(NF,AG,S) * * DAMPING PARAMETER ro (PP) DETERMINATION * FS = F PP = ONE IF (RP.NE.R) THEN FS = FS + (RP-R)*P FV = FS + HALF* (RP-R)**2*MXDSMQ(NF,HF,S,S) LA = (FV.GT.FS) .AND. (FV.GT.FP) IF (LA) PP = MAX(ZERO, (FP-FS)/ (FV-FS)) IF (LQ) FS = FS + PP* (FV-FS) ELSE IF (IND.GT.1) THEN PV = AF(NA+IND) FV = PV + HALF*R*R*MXDSMQ(NF,AH((IND-1)*NFF+1),S,S) LA = (FV.GT.PV) .AND. (FV.GT.FP) IF (LA) PP = MAX(ZERO, (FP-PV)/ (FV-PV)) END IF * * BUNDLE VALUES f QUADRATIC UPDATE * PV = MXDSMQ(NF,AH,S,S) CALL MXVCOP(NFF,H,AH) DO 20 KA = 1,MAL AF(NA+KA) = AF(NA+KA) + AF(I+KA)*HALF*RP*RP* + MXDSMQ(NF,AH(1+ (KA-1)*NFF),S,S) 20 CONTINUE IF (RP.EQ.R .AND. IND.GT.1) AF(I+IND) = PP * * FU CORRECTION - COMPUTATION WITH NEW AGGREGATE MATRIX * FU = FU + AF(I+1)*HALF*RP*RP* (MXDSMQ(NF,AH,S,S)* (ONE+WK)-WK*PV) * * BUNDLE REDUCTION * DO 40 L = MAL,1,-1 IF (IA(L).NE.0) GO TO 40 K = (L-1)*NF + 1 DO 30 KA = L,MAL - 1 AF(NA+KA) = AF(NA+KA+1) AF(NA+NA+KA) = AF(NA+NA+KA+1) AF(NA*3+KA) = AF(NA*3+KA+1) AF(I+KA) = AF(I+KA+1) IA(KA) = IA(KA+1) CALL MXVCOP(NF,AG(K+NF),AG(K)) CALL MXVCOP(NFF,AH(L*NFF+1),AH(L*NFF+1-NFF)) K = K + NF 30 CONTINUE IND = IND - 1 MAL = MAL - 1 40 CONTINUE IF (MAL.GE.NA) THEN K = 1 + NF L = 1 + NFF DO 50 KA = 2,MAL - 1 AF(NA+KA) = AF(NA+KA+1) AF(NA+NA+KA) = AF(NA+NA+KA+1) AF(NA*3+KA) = AF(NA*3+KA+1) AF(I+KA) = AF(I+KA+1) IA(KA) = IA(KA+1) CALL MXVCOP(NF,AG(K+NF),AG(K)) CALL MXVCOP(NFF,AH(L+NFF),AH(L)) K = K + NF L = L + NFF 50 CONTINUE IND = IND - 1 MAL = MAL - 1 END IF * * BUNDLE COMPLETION * MAL = MAX(2,MAL+1) K = (MAL-1)*NF + 1 L = (MAL-1)*NFF + 1 AF(NA+1) = FU AF(NA+MAL) = FS AF(NA+NA+1) = PU AF(NA+NA+MAL) = (R-RP)*SNORM AF(NA*3+MAL) = SQRT(MXVDOT(NF,G,G)) AF(I+1) = ONE DO 60 KA = 1,MAL AF(KA) = -MAX(ABS(AF(NA+KA)-FP),ETA*ABS(AF(NA+NA+KA))**MOS) 60 CONTINUE DO 70 KA = 0,MAL - 2 CALL MXDSMM(NF,AH(1+KA*NFF),S,AH(L)) CALL MXVDIR(NF,RP*AF(I+KA+1),AH(L),AG(1+KA*NF),AG(1+KA*NF)) 70 CONTINUE CALL MXVCOP(NF,G,AG(K)) IF (R.EQ.RP) THEN AF(I+MAL) = ONE IND = MAL ELSE AF(I+MAL) = PP IF (.NOT.LQ) AF(I+MAL) = ZERO CALL MXDSMM(NF,HF,S,AH(L)) CALL MXVDIR(NF, (RP-R)*AF(I+MAL),AH(L),AG(K),AG(K)) END IF CALL MXVCOP(NFF,HF,AH(L)) IA(MAL) = 2 * * MAIN STOPPING CRITERION - SEE ALSO UYFUT4.I * F = FP IF (ITERS.LE.0) F = FO WK = HALF*GNORM*SNORM + 5D1*MAX(ABS(FU-FP),ETA*PU*PU)/ + (ABS(FP)+1D-3) IF (NIT.LE.1) WK = ONE IF (WK.LE.TOLG) THEN ITERM = 4 NIT = NIT - 1 RETURN END IF CALL MXVCOP(NFF,H,HF) * * PREPARATION FOR QUADRATIC PROGRAMMING * IF (NTESX.GT.0 .AND. NTESX.LT.NTESF) NTESF = NTESX IF (NIT.LE.1) DELF = ONE IF (FO.NE.F) DELF = ABS(FO-F)/MAX(ABS(F),ONE) MFP = 2 80 CALL PLQDF1(NF,MAL,NC,X,IX,XL,XU,AF,AFD,IA,IAA,AG,AR,AZ,CF,IC,CL, + CU,CG,GO,HF,S,MFP,KBF,KBC,IDECF,ETA0,ETA2,ETA9,EPS7, + EPS9,XNORM,UMAX,GMAX,N,ITERQ) IF (ITERQ.LT.0) THEN ITERD = -2 GO TO 100 END IF ITERD = 1 GMAX = MXVMAX(NF,GO) GNORM = SQRT(MXVDOT(NF,GO,GO)) SNORM = SQRT(MXVDOT(NF,S,S)) IF (DELF.LE.TOLF .OR. ABS(FO-F)/MAX(ABS(F),ONE).GT.ONE) THEN ELSE IF (GNORM.LT.TOLG*TOLG*MXVMAX(MAL-1,AF(NA*3+2))) THEN * * REDEFINE BUNDLE FOR TOO SMALL DIRECTION VECTOR * J = MAL DO 90 KA = MAL,1,-1 IF (IA(KA).LT.0) J = KA 90 CONTINUE IF (J.EQ.MAL) GO TO 100 IA(J) = 0 GO TO 80 END IF 100 CONTINUE * * AGGREGATION * FU = ZERO PU = ZERO IF (NF.GT.N) CALL MXVSET(NFF,ZERO,H) K = 0 DO 110 KA = 1,NF - N L = IAA(KA) IF (L.GT.NC) THEN L = L - NC FU = FU - AZ(KA)*AF(NA+L) PU = PU - AZ(KA)*AF(NA+NA+L) CALL MXVDIR(NFF,-AZ(KA)*AF(I+L),AH((L-1)*NFF+1),H,H) IF (L.EQ.1) K = KA END IF 110 CONTINUE IDECF = 0 CALL MXVCOP(NF,GO,AG) * * CORRECTION FACTOR FOR FU (FIRST LAGRANGE MULTIPLIER, IF ACTIVE) * WK = ZERO IF (K.GT.0) WK = -AZ(K) * * PREPARATION FOR UYTRXD.I - TEST VALUES DETERMINATION * FUB = FP RETURN END * SUBROUTINE PLQDF1 ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * DUAL RANGE SPACE QUADRATIC PROGRAMMING METHOD FOR MINIMAX * APPROXIMATION WITH LINEAR CONSTRAINTS. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NA NUMBER OF LINEAR APPROXIMATED FUNCTIONS. * II NC NUMBER OF LINEAR CONSTRAINTS. * RI X(NF) VECTOR OF VARIABLES. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. * RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * RI AF(NA) VECTOR CONTAINING VALUES OF THE APPROXIMATED * FUNCTIONS. * RO AFD(NA) VECTOR CONTAINING INCREMENTS OF THE APPROXIMATED * FUNCTIONS. * II IA(NA) VECTOR CONTAINING TYPES OF DEVIATIONS. * IO IAA(NF+1) VECTOR CONTAINING INDICES OF ACTIVE FUNCTIONS. * RI AG(NF*NA) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * APPROXIMATED FUNCTIONS. * RO AR((NF+1)*(NF+2)/2) TRIANGULAR DECOMPOSITION OF KERNEL OF THE * ORTHOGONAL PROJECTION. * RO AZ(NF+1) VECTOR OF LAGRANGE MULTIPLIERS. * RI CF(NF) VECTOR CONTAINING VALUES OF THE CONSTRAINT FUNCTIONS. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * RI CL(NC) VECTOR CONTAINING LOWER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CU(NC) VECTOR CONTAINING UPPER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RO G(NF+1) GRADIENT OF THE LAGRANGIAN FUNCTION. * RU H(NF*(NF+1)/2) TRIANGULAR DECOMPOSITION OR INVERSION OF THE * HESSIAN MATRIX APPROXIMATION. * RO S(NF+1) DIRECTION VECTOR. * II MFP TYPE OF FEASIBLE POINT. MFP=1-ARBITRARY FEASIBLE POINT. * MFP=2-OPTIMUM FEASIBLE POINT. MFP=3-REPEATED SOLUTION. * II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS. * KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS. * II KBC SPECIFICATION OF LINEAR CONSTRAINTS. KBC=0-NO LINEAR * CONSTRAINTS. KBC=1-ONE SIDED LINEAR CONSTRAINTS. KBC=2=TWO * SIDED LINEAR CONSTRAINTS. * IU IDECF DECOMPOSITION INDICATOR. IDECF=0-NO DECOMPOSITION. * IDECF=1-GILL-MURRAY DECOMPOSITION. IDECF=9-INVERSION. * IDECF=10-DIAGONAL MATRIX. * RI ETA0 MACHINE PRECISION. * RI ETA2 TOLERANCE FOR POSITIVE DEFINITENESS OF THE HESSIAN MATRIX. * RI ETA9 MAXIMUM FOR REAL NUMBERS. * RI EPS7 TOLERANCE FOR LINEAR INDEPENDENCE OF CONSTRAINTS. * RI EPS9 TOLERANCE FOR ACTIVITY OF CONSTRAINTS. * RO XNORM VALUE OF LINEARIZED MINIMAX FUNCTION. * RO UMAX MAXIMUM ABSOLUTE VALUE OF A NEGATIVE LAGRANGE MULTIPLIER. * RO GMAX MAXIMUM ABSOLUTE VALUE OF A PARTIAL DERIVATIVE. * IO N DIMENSION OF MANIFOLD DEFINED BY ACTIVE CONSTRAINTS. * IO ITERQ TYPE OF FEASIBLE POINT. ITERQ=1-ARBITRARY FEASIBLE POINT. * ITERQ=2-OPTIMUM FEASIBLE POINT. ITERQ=-1 FEASIBLE POINT DOES * NOT EXISTS. ITERQ=-2 OPTIMUM FEASIBLE POINT DOES NOT EXISTS. * * SUBPROGRAMS USED : * S PLMINA DETERMINATION OF THE NEW ACTIVE FUNCTION. * S PLMINL DETERMINATION OF THE NEW ACTIVE LINEAR CONSTRAINT. * S PLMINS DETERMINATION OF THE NEW ACTIVE SIMPLE BOUND. * S PLMINT DETERMINATION OF THE NEW ACTIVE TRUST REGION BOUND. * S PLADF1 CONSTRAINT ADDITION. * S PLRMF0 CONSTRAINT DELETION. * S MXPDGF GILL-MURRAY DECOMPOSITION OF A DENSE SYMMETRIC MATRIX. * S MXPDGB BACK SUBSTITUTION AFTER GILL-MURRAY DECOMPOSITION. * S MXDPRB BACK SUBSTITUTION AFTER CHOLESKI DECOMPOSITION. * S MXDSMM MATRIX VECTOR PRODUCT. * S MXVDIR VECTOR AUGMENTED BY THE SCALED VECTOR. * RF MXVDOT DOT PRODUCT OF TWO VECTORS. * S MXVCOP COPYING OF A VECTOR. * S MXVINA ABSOLUTE VALUES OF ELEMENTS OF INTEGER VECTOR. * S MXVINV CHANGE OF INTEGER VECTOR AFTER CONSTRAINT ADDITION. * S MXVNEG COPYING OF A VECTOR WITH CHANGE OF THE SIGN. * S MXVSET INITIATION OF A VECTOR. * * L.LUKSAN: DUAL METHOD FOR SOLVING A SPECIAL PROBLEM OF QUADRATIC * PROGRAMMING AS A SUBPROBLEM AT LINEARLY CONSTRAINED NONLINEAR MINIMAX * APPROXIMATION. kYBERNETIKA 20 (1984) 445-457. * SUBROUTINE PLQDF1(NF,NA,NC,X,IX,XL,XU,AF,AFD,IA,IAA,AG,AR,AZ,CF, + IC,CL,CU,CG,G,H,S,MFP,KBF,KBC,IDECF,ETA0,ETA2, + ETA9,EPS7,EPS9,XNORM,UMAX,GMAX,N,ITERQ) C .. Scalar Arguments .. DOUBLE PRECISION EPS7,EPS9,ETA0,ETA2,ETA9,GMAX,UMAX,XNORM INTEGER IDECF,ITERQ,KBC,KBF,MFP,N,NA,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION AF(*),AFD(*),AG(*),AR(*),AZ(*),CF(*),CG(*),CL(*), + CU(*),G(*),H(*),S(*),X(*),XL(*),XU(*) INTEGER IA(*),IAA(*),IC(*),IX(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION BET,CON,E,GAM,PAR,SNORM,STEP,STEP1,STEP2,T,TEMP INTEGER I,IER,INEW,INF,IOLD,J,K,KA,KC,KNEW,KOLD,KREM,L,NAA,NAR C .. C .. External Functions .. DOUBLE PRECISION MXVDOT,MXVMAX EXTERNAL MXVDOT,MXVMAX C .. C .. External Subroutines .. EXTERNAL MXDPGB,MXDPGF,MXDPRB,MXDSMM,MXVCOP,MXVDIR,MXVINA,MXVINV, + MXVMUL,MXVNEG,MXVSET,PLADF1,PLDLAG,PLMINA,PLMINL,PLMINS, + PLRMF0 C .. C .. Intrinsic Functions .. INTRINSIC ABS,MIN,SIGN C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. T = 1.0D0 CON = ETA9 IF (IDECF.LT.0) IDECF = 1 IF (IDECF.EQ.0) THEN * * GILL-MURRAY DECOMPOSITION * TEMP = ETA2 CALL MXDPGF(NF,H,INF,TEMP,STEP) NDECF = NDECF + 1 IDECF = 1 END IF IF (IDECF.GE.2 .AND. IDECF.LE.8) THEN ITERQ = -10 RETURN END IF * * INITIATION * NRED = 0 IF (MFP.EQ.3) GO TO 10 N = NF NAA = 0 NAR = 0 XNORM = -ETA9 CALL MXVINA(NA,IA) IF (KBF.GT.0) CALL MXVINA(NF,IX) IF (KBC.GT.0) CALL MXVINA(NC,IC) * * DIRECTION DETERMINATION * 10 CALL MXVSET(NF,0.0D0,S) DO 20 J = 1,NAA L = IAA(J) IF (L.GT.NC) THEN L = L - NC CALL MXVDIR(NF,AZ(J),AG((L-1)*NF+1),S,S) ELSE IF (L.GT.0) THEN CALL MXVDIR(NF,AZ(J),CG((L-1)*NF+1),S,S) ELSE L = -L S(L) = S(L) + AZ(J) END IF 20 CONTINUE CALL MXVCOP(NF,S,G) IF (NAA.GT.0) THEN IF (IDECF.EQ.1) THEN CALL MXDPGB(NF,H,S,0) ELSE IF (IDECF.EQ.9) THEN CALL MXDSMM(NF,H,G,S) ELSE CALL MXVMUL(NF,H,S,S,-1) END IF END IF * * INITIAL MINIMAX VARIABLE * IF (NAA.EQ.1) THEN TEMP = AF(INEW-NC) + MXVDOT(NF,AG((INEW-NC-1)*NF+1),S) XNORM = -SIGN(1,KNEW)*TEMP END IF * * CHECK OF FEASIBILITY * INEW = 0 PAR = 0.0D0 CALL PLMINA(NF,NA,NC,AF,AFD,IA,AG,S,INEW,KNEW,EPS9,XNORM,PAR) IF (NAA.GT.0) THEN CALL PLMINL(NF,NC,CF,IC,CL,CU,CG,S,KBC,INEW,KNEW,EPS9,PAR) CALL PLMINS(NF,IX,X,XL,XU,S,KBF,INEW,KNEW,EPS9,PAR) END IF IF (INEW.EQ.0) THEN * * SOLUTION ACHIEVED * CALL MXVNEG(NF,G,G) ITERQ = 2 RETURN ELSE SNORM = 0.0D0 END IF 30 IER = 0 * * STEPSIZE DETERMINATION * CALL PLADF1(NF,NC,IA,IAA,AG,AR,CG,H,S,G,IDECF,N,INEW,KNEW,IER, + EPS7,GMAX,UMAX,E,T) CALL PLDLAG(NF,NC,IA,IAA,S,N,KOLD) IF (KOLD.EQ.0) THEN * * ZERO STEPSIZE * STEP1 = 0.0D0 STEP = STEP1 SNORM = SIGN(1,KNEW) XNORM = XNORM - PAR ELSE * * PRIMAL STEPSIZE * CALL MXDPRB(NAA,AR,S,1) BET = E - MXVDOT(NAA,S,G) GAM = BET/MXVDOT(NAA,S,S) UMAX = BET*GAM + UMAX IF (UMAX.LE.EPS7*GMAX) THEN STEP1 = CON ELSE STEP1 = -PAR/UMAX END IF * * DUAL STEPSIZE * CALL MXDPRB(NAA,AR,S,-1) CALL MXDPRB(NAA,AR,G,-1) CALL MXVDIR(NAA,GAM,S,G,G) IF (KNEW.LT.0) CALL MXVNEG(NAA,G,G) STEP = MXVMAX(NAA,G) IOLD = 0 STEP2 = CON DO 40 J = 1,NAA L = IAA(J) IF (L.GT.NC) THEN L = L - NC K = IA(L) ELSE IF (L.GT.0) THEN K = IC(L) ELSE L = -L K = IX(L) END IF IF (K.LE.-5) THEN ELSE IF ((K.EQ.-1.OR.K.EQ.-3.) .AND. G(J).LE.0.0D0) THEN ELSE IF ((K.EQ.-2.OR.K.EQ.-4.) .AND. G(J).GE.0.0D0) THEN ELSE IF (ABS(G(J)).LE.ETA0*STEP) THEN ELSE TEMP = AZ(J)/G(J) IF (STEP2.GT.TEMP) THEN IOLD = J STEP2 = TEMP END IF END IF 40 CONTINUE * * FINAL STEPSIZE * STEP = MIN(STEP1,STEP2) IF (STEP.GE.CON) THEN * * FEASIBLE SOLUTION DOES NOT EXIST * ITERQ = -1 RETURN END IF * * NEW LAGRANGE MULTIPLIERS * CALL MXVDIR(NAA,-STEP,G,AZ,AZ) SNORM = SNORM + SIGN(1,KNEW)*STEP XNORM = XNORM + SIGN(1,KNEW)*STEP*GAM PAR = PAR - (STEP/STEP1)*PAR END IF IF (STEP.EQ.STEP1) THEN IF (N.LT.0) THEN * * IMPOSSIBLE SITUATION * ITERQ = -5 RETURN END IF * * CONSTRAINT ADDITION * IF (IER.EQ.0) THEN N = N - 1 NAA = NAA + 1 NAR = NAR + NAA AZ(NAA) = SNORM END IF IF (INEW.GT.NC) THEN KA = INEW - NC CALL MXVINV(IA,KA,KNEW) ELSE IF (INEW.GT.0) THEN KC = INEW CALL MXVINV(IC,KC,KNEW) ELSE IF (ABS(KNEW).EQ.1) THEN I = -INEW CALL MXVINV(IX,I,KNEW) ELSE I = -INEW IF (KNEW.GT.0) IX(I) = -3 IF (KNEW.LT.0) IX(I) = -4 END IF NRED = NRED + 1 NADD = NADD + 1 GO TO 10 ELSE * * CONSTRAINT DELETION * DO 50 J = IOLD,NAA - 1 AZ(J) = AZ(J+1) 50 CONTINUE CALL PLRMF0(NF,NC,IX,IA,IAA,AR,IC,G,N,IOLD,KREM,IER) NAR = NAR - NAA NAA = NAA - 1 CALL MXVINA(NA,IA) IF (KBC.GT.0) CALL MXVINA(NC,IC) IF (KBF.GT.0) CALL MXVINA(NF,IX) DO 60 J = 1,NAA L = IAA(J) IF (L.GT.NC) THEN L = L - NC IA(L) = -IA(L) ELSE IF (L.GT.0) THEN IC(L) = -IC(L) ELSE L = -L IX(L) = -IX(L) END IF 60 CONTINUE GO TO 30 END IF END * SUBROUTINE PLMINA ALL SYSTEMS 90/12/01 * PORTABILITY : ALL SYSTEMS * 90/12/01 LU : ORIGINAL VERSION * * PURPOSE : * DETERMINATION OF THE NEW ACTIVE FUNCTION. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II NA NUMBER OF CURRENT LINEAR APPROXIMATED FUNCTIONS. * II NC NUMBER OF CURRENT LINEAR CONSTRAINTS. * RI AF(NA) VECTOR CONTAINING VALUES OF THE APPROXIMATED * FUNCTIONS. * RO AFD(NA) VECTOR CONTAINING INCREMENTS OF THE APPROXIMATED * FUNCTIONS. * II IA(NA) VECTOR CONTAINING TYPES OF DEVIATIONS. * RI AG(NF*NA) VECTOR CONTAINING SCALING PARAMETERS. * RI S(NF) DIRECTION VECTOR. * IO INEW INDEX OF THE NEW ACTIVE FUNCTION. * IO KNEW SIGNUM OF THE NEW ACTIVE GRADIENT. * RI EPS9 TOLERANCE FOR ACTIVE FUNCTIONS. * RO XNORM VALUE OF LINEARIZED MINIMAX FUNCTION. * RA PAR AUXILIARY VARIABLE. * * SUBPROGRAMS USED : * RF MXVDOT DOT PRODUCT OF TWO VECTORS. * SUBROUTINE PLMINA(NF,NA,NC,AF,AFD,IA,AG,S,INEW,KNEW,EPS9,XNORM, + PAR) C .. Scalar Arguments .. DOUBLE PRECISION EPS9,PAR,XNORM INTEGER INEW,KNEW,NA,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION AF(*),AFD(*),AG(*),S(*) INTEGER IA(*) C .. C .. Local Scalars .. DOUBLE PRECISION POM,TEMP INTEGER JCG,KA C .. C .. External Functions .. DOUBLE PRECISION MXVDOT EXTERNAL MXVDOT C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX,MIN C .. JCG = 1 DO 10 KA = 1,NA IF (IA(KA).GT.0) THEN TEMP = MXVDOT(NF,AG(JCG),S) AFD(KA) = TEMP TEMP = AF(KA) + TEMP IF (IA(KA).EQ.1 .OR. IA(KA).GE.3) THEN POM = XNORM + TEMP IF (POM.LT.MIN(PAR,-EPS9*MAX(ABS(XNORM),1.0D0))) THEN INEW = KA + NC KNEW = 1 PAR = POM END IF END IF IF (IA(KA).EQ.2 .OR. IA(KA).GE.3) THEN POM = XNORM - TEMP IF (POM.LT.MIN(PAR,-EPS9*MAX(ABS(XNORM),1.0D0))) THEN INEW = KA + NC KNEW = -1 PAR = POM END IF END IF END IF JCG = JCG + NF 10 CONTINUE RETURN END * SUBROUTINE PLMINL ALL SYSTEMS 90/12/01 * PORTABILITY : ALL SYSTEMS * 90/12/01 LU : ORIGINAL VERSION * * PURPOSE : * DETERMINATION OF THE NEW ACTIVE LINEAR CONSTRAINT. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II NC NUMBER OF CONSTRAINTS. * RI CF(NC) VECTOR CONTAINING VALUES OF THE CONSTRAINT FUNCTIONS. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * RI CL(NC) VECTOR CONTAINING LOWER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CU(NC) VECTOR CONTAINING UPPER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RI S(NF) DIRECTION VECTOR. * II KBC SPECIFICATION OF LINEAR CONSTRAINTS. KBC=0-NO LINEAR * CONSTRAINTS. KBC=1-ONE SIDED LINEAR CONSTRAINTS. KBC=2=TWO * SIDED LINEAR CONSTRAINTS. * IO INEW INDEX OF THE NEW ACTIVE CONSTRAINT. * IO KNEW SIGNUM OF THE NEW ACTIVE NORMAL. * RI EPS9 TOLERANCE FOR ACTIVE CONSTRAINTS. * RA PAR AUXILIARY VARIABLE. * * SUBPROGRAMS USED : * RF MXVDOT DOT PRODUCT OF TWO VECTORS. * SUBROUTINE PLMINL(NF,NC,CF,IC,CL,CU,CG,S,KBC,INEW,KNEW,EPS9,PAR) C .. Scalar Arguments .. DOUBLE PRECISION EPS9,PAR INTEGER INEW,KBC,KNEW,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION CF(*),CG(*),CL(*),CU(*),S(*) INTEGER IC(*) C .. C .. Local Scalars .. DOUBLE PRECISION POM,TEMP INTEGER JCG,KC C .. C .. External Functions .. DOUBLE PRECISION MXVDOT EXTERNAL MXVDOT C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX,MIN C .. IF (KBC.GT.0) THEN JCG = 1 DO 10 KC = 1,NC IF (IC(KC).GT.0) THEN TEMP = CF(KC) + MXVDOT(NF,CG(JCG),S) IF (IC(KC).EQ.1 .OR. IC(KC).GE.3) THEN POM = TEMP - CL(KC) IF (POM.LT.MIN(PAR,-EPS9*MAX(ABS(CL(KC)), + 1.0D0))) THEN INEW = KC KNEW = 1 PAR = POM END IF END IF IF (IC(KC).EQ.2 .OR. IC(KC).GE.3) THEN POM = CU(KC) - TEMP IF (POM.LT.MIN(PAR,-EPS9*MAX(ABS(CU(KC)), + 1.0D0))) THEN INEW = KC KNEW = -1 PAR = POM END IF END IF END IF JCG = JCG + NF 10 CONTINUE END IF RETURN END * SUBROUTINE PLMINS ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * DETERMINATION OF THE NEW ACTIVE SIMPLE BOUND. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. * RI XO(NF) SAVED VECTOR OF VARIABLES. * RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * RI S(NF) DIRECTION VECTOR. * II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS. * KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS. * IO INEW INDEX OF THE NEW ACTIVE CONSTRAINT. * IO KNEW SIGNUM OF THE NEW NORMAL. * RI EPS9 TOLERANCE FOR ACTIVE CONSTRAINTS. * RA PAR AUXILIARY VARIABLE. * SUBROUTINE PLMINS(NF,IX,XO,XL,XU,S,KBF,INEW,KNEW,EPS9,PAR) C .. Scalar Arguments .. DOUBLE PRECISION EPS9,PAR INTEGER INEW,KBF,KNEW,NF C .. C .. Array Arguments .. DOUBLE PRECISION S(*),XL(*),XO(*),XU(*) INTEGER IX(*) C .. C .. Local Scalars .. DOUBLE PRECISION POM,TEMP INTEGER I C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX,MIN C .. IF (KBF.GT.0) THEN DO 10 I = 1,NF IF (IX(I).GT.0) THEN TEMP = 1.0D0 IF (IX(I).EQ.1 .OR. IX(I).GE.3) THEN POM = XO(I) + S(I)*TEMP - XL(I) IF (POM.LT.MIN(PAR,-EPS9*MAX(ABS(XL(I)), + TEMP))) THEN INEW = -I KNEW = 1 PAR = POM END IF END IF IF (IX(I).EQ.2 .OR. IX(I).GE.3) THEN POM = XU(I) - S(I)*TEMP - XO(I) IF (POM.LT.MIN(PAR,-EPS9*MAX(ABS(XU(I)), + TEMP))) THEN INEW = -I KNEW = -1 PAR = POM END IF END IF END IF 10 CONTINUE END IF RETURN END * SUBROUTINE PLDLAG ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * VECTOR OF LAGRANGE MULTIPLIERS FOR DUAL QP METHOD IS DETERMINED. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II NC NUMBER OF LINEARIZED CONSTRAINTS. * II IA(NA) VECTOR CONTAINING TYPES OF DEVIATIONS. * II IAA(NF+1) VECTOR CONTAINING INDICES OF ACTIVE FUNCTIONS. * RO AZ(NF+1) OUTPUT VECTOR. * II N ACTUAL NUMBER OF VARIABLES. * IA KOLD AUXILIARY VARIABLE. * SUBROUTINE PLDLAG(NF,NC,IA,IAA,AZ,N,KOLD) C .. Scalar Arguments .. INTEGER KOLD,N,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION AZ(*) INTEGER IA(*),IAA(*) C .. C .. Local Scalars .. DOUBLE PRECISION TEMP INTEGER J,L,NAA C .. NAA = NF - N KOLD = 0 DO 10 J = 1,NAA L = IAA(J) IF (L.GT.NC) THEN L = L - NC TEMP = 1.0D0 IF (IA(L).EQ.-2 .OR. IA(L).EQ.-4) TEMP = -TEMP AZ(J) = TEMP KOLD = 1 ELSE AZ(J) = 0.0D0 END IF 10 CONTINUE RETURN END * SUBROUTINE PLADF1 ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * TRIANGULAR DECOMPOSITION OF KERNEL OF THE GENERAL PROJECTION * IS UPDATED AFTER FUNCTION OR CONSTRAINT ADDITION. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II NC NUMBER OF LINEARIZED CONSTRAINTS. * II IA(NA) VECTOR CONTAINING TYPES OF DEVIATIONS. * IU IAA(NF+1) VECTOR CONTAINING INDICES OF ACTIVE FUNCTIONS. * RI AG(NF*NA) MATRIX WHOSE COLUMNS ARE GRADIENTS OF THE LINEAR * APPROXIMATED FUNCTIONS. * RU AR((NF+1)*(NF+2)/2) TRIANGULAR DECOMPOSITION OF KERNEL OF * THE ORTHOGONAL PROJECTION. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RI H(NF*(NF+1)/2) TRIANGULAR DECOMPOSITION OR INVERSION OF THE * HESSIAN MATRIX APPROXIMATION. * RA S(NF+1) AUXILIARY VECTOR. * RO G(NF+1) VECTOR USED IN THE DUAL RANGE SPACE QUADRATIC * PROGRAMMING METHOD. * IU IDECF DECOMPOSITION INDICATOR. IDECF=0-NO DECOMPOSITION. * IDECF=1-GILL-MURRAY DECOMPOSITION. IDECF=9-INVERSION. * IDECF=10-DIAGONAL MATRIX. * IU N ACTUAL NUMBER OF VARIABLES. * II INEW INDEX OF THE NEW ACTIVE CONSTRAINT. * II KNEW SIGNUM OF THE NEW ACTIVE GRADIENT. * IO IER ERROR INDICATOR. * RI EPS7 TOLERANCE FOR LINEAR INDEPENDENCE OF CONSTRAINTS. * RO GMAX MAXIMUM ABSOLUTE VALUE OF A PARTIAL DERIVATIVE. * RO UMAX MAXIMUM ABSOLUTE VALUE OF A NEGATIVE LAGRANGE MULTIPLIER. * RO E AUXILIARY VARIABLE. * RI T AUXILIARY VARIABLE. * * SUBPROGRAMS USED : * S MXPDGB BACK SUBSTITUTION AFTER GILL-MURRAY DECOMPOSITION. * S MXDPRB BACK SUBSTITUTION AFTER CHOLESKI DECOMPOSITION. * S MXDSMM MATRIX-VECTOR PRODUCT. * S MXDSMV COPYING OF A ROW OF DENSE SYMMETRIC MATRIX. * S MXVCOP COPYING OF A VECTOR. * RF MXVDOT DOT PRODUCT OF TWO VECTORS. * SUBROUTINE PLADF1(NF,NC,IA,IAA,AG,AR,CG,H,S,G,IDECF,N,INEW,KNEW, + IER,EPS7,GMAX,UMAX,E,T) C .. Scalar Arguments .. DOUBLE PRECISION E,EPS7,GMAX,T,UMAX INTEGER IDECF,IER,INEW,KNEW,N,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION AG(*),AR(*),CG(*),G(*),H(*),S(*) INTEGER IA(*),IAA(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION POM,TEMP INTEGER J,JAG,JOB,K,L,NAA,NAR C .. C .. External Functions .. DOUBLE PRECISION MXVDOT EXTERNAL MXVDOT C .. C .. External Subroutines .. EXTERNAL MXDPGB,MXDPRB,MXDSMM,MXDSMV,MXVCOP,MXVMUL,MXVSET C .. C .. Intrinsic Functions .. INTRINSIC SIGN,SQRT C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. JOB = 1 E = 0.0D0 IF (INEW.GT.NC) E = SIGN(1,KNEW) IER = 0 IF (JOB.EQ.0 .AND. N.LT.0) IER = 2 IF (INEW.EQ.0) IER = 3 IF (IDECF.GE.2 .AND. IDECF.LE.8) IER = -2 IF (IER.NE.0) RETURN NAA = NF - N NAR = NAA* (NAA+1)/2 IF (INEW.GT.NC) THEN JAG = (INEW-NC-1)*NF + 1 IF (IDECF.EQ.1) THEN CALL MXVCOP(NF,AG(JAG),S) CALL MXDPGB(NF,H,S,0) ELSE IF (IDECF.EQ.9) THEN CALL MXDSMM(NF,H,AG(JAG),S) ELSE CALL MXVCOP(NF,AG(JAG),S) CALL MXVMUL(NF,H,S,S,-1) END IF GMAX = MXVDOT(NF,AG(JAG),S) + T ELSE IF (INEW.GT.0) THEN JAG = (INEW-1)*NF + 1 IF (IDECF.EQ.1) THEN CALL MXVCOP(NF,CG(JAG),S) CALL MXDPGB(NF,H,S,0) ELSE IF (IDECF.EQ.9) THEN CALL MXDSMM(NF,H,CG(JAG),S) ELSE CALL MXVCOP(NF,CG(JAG),S) CALL MXVMUL(NF,H,S,S,-1) END IF GMAX = MXVDOT(NF,CG(JAG),S) ELSE K = -INEW IF (IDECF.EQ.1) THEN CALL MXVSET(NF,0.0D0,S) S(K) = 1.0D0 CALL MXDPGB(NF,H,S,0) ELSE IF (IDECF.EQ.9) THEN CALL MXDSMV(NF,H,S,K) ELSE CALL MXVSET(NF,0.0D0,S) S(K) = 1.0D0/H(K) END IF GMAX = S(K) END IF IF (NAA.GT.0) THEN POM = T*E DO 10 J = 1,NAA L = IAA(J) IF (L.GT.NC) THEN L = L - NC G(J) = MXVDOT(NF,AG((L-1)*NF+1),S) IF (INEW.GT.NC) THEN TEMP = POM IF (IA(L).EQ.-2 .OR. IA(L).EQ.-4) TEMP = -TEMP G(J) = G(J) + TEMP END IF ELSE IF (L.GT.0) THEN G(J) = MXVDOT(NF,CG((L-1)*NF+1),S) ELSE L = -L G(J) = S(L) END IF 10 CONTINUE END IF IF (N.LT.0) THEN CALL MXDPRB(NAA,AR,G,1) UMAX = 0.0D0 IER = 2 RETURN ELSE IF (NAA.EQ.0) THEN UMAX = GMAX ELSE CALL MXDPRB(NAA,AR,G,1) UMAX = GMAX - MXVDOT(NAA,G,G) CALL MXVCOP(NAA,G,AR(NAR+1)) END IF IF (UMAX.LE.EPS7*GMAX) THEN IER = 1 RETURN ELSE NAA = NAA + 1 NAR = NAR + NAA IAA(NAA) = INEW AR(NAR) = SQRT(UMAX) IF (JOB.EQ.0) THEN N = N - 1 NADD = NADD + 1 END IF END IF RETURN END * SUBROUTINE PLRMF0 ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * OPERATIONS AFTER CONSTRAINT DELETION. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II NC NUMBER OF CONSTRAINTS. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. * II IA(NA) VECTOR CONTAINING TYPES OF DEVIATIONS. * IU IAA(NF+1) VECTOR CONTAINING INDICES OF ACTIVE FUNCTIONS. * RU AR((NF+1)*(NF+2)/2) TRIANGULAR DECOMPOSITION OF KERNEL OF THE * ORTHOGONAL PROJECTION. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * RA S(NF+1) AUXILIARY VECTOR. * II N ACTUAL NUMBER OF VARIABLES. * II IOLD INDEX OF THE OLD ACTIVE CONSTRAINT. * IO KREM AUXILIARY VARIABLE. * IO IER ERROR INDICATOR. * * SUBPROGRAMS USED : * S PLRMR0 CORRECTION OF KERNEL OF THE ORTHOGONAL PROJECTION * AFTER CONSTRAINT DELETION. * SUBROUTINE PLRMF0(NF,NC,IX,IA,IAA,AR,IC,S,N,IOLD,KREM,IER) C .. Scalar Arguments .. INTEGER IER,IOLD,KREM,N,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION AR(*),S(*) INTEGER IA(*),IAA(*),IC(*),IX(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. INTEGER L C .. C .. External Subroutines .. EXTERNAL PLRMR0 C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. CALL PLRMR0(NF,IAA,AR,S,N,IOLD,KREM,IER) N = N + 1 NREM = NREM + 1 L = IAA(NF-N+1) IF (L.GT.NC) THEN L = L - NC IA(L) = -IA(L) ELSE IF (L.GT.0) THEN IC(L) = -IC(L) ELSE L = -L IX(L) = -IX(L) END IF RETURN END * SUBROUTINE PLRMR0 ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * TRIANGULAR DECOMPOSITION OF KERNEL OF THE ORTHOGONAL PROJECTION IS * UPDATED AFTER CONSTRAINT DELETION. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * IU ICA(NF) VECTOR CONTAINING INDICES OF ACTIVE CONSTRAINTS. * RU CR(NF*(NF+1)/2) TRIANGULAR DECOMPOSITION OF KERNEL OF THE * ORTHOGONAL PROJECTION. * RA G(NF) AUXILIARY VECTOR. * II N ACTUAL NUMBER OF VARIABLES. * II IOLD INDEX OF THE OLD ACTIVE CONSTRAINT. * IO KREM AUXILIARY VARIABLE. * IO IER ERROR INDICATOR. * * SUBPROGRAMS USED : * S MXVCOP COPYING OF A VECTOR. * S MXVORT DETERMINATION OF AN ELEMENTARY ORTHOGONAL MATRIX FOR * PLANE ROTATION. * S MXVROT PLANE ROTATION OF A VECTOR. * S MXVSET INITIATION OF A VECTOR. * SUBROUTINE PLRMR0(NF,ICA,CR,G,N,IOLD,KREM,IER) C .. Scalar Arguments .. INTEGER IER,IOLD,KREM,N,NF C .. C .. Array Arguments .. DOUBLE PRECISION CR(*),G(*) INTEGER ICA(*) C .. C .. Local Scalars .. DOUBLE PRECISION CK,CL INTEGER I,J,K,KC,L,NCA C .. C .. External Subroutines .. EXTERNAL MXVCOP,MXVORT,MXVROT,MXVSET C .. NCA = NF - N IF (IOLD.LT.NCA) THEN K = IOLD* (IOLD-1)/2 KC = ICA(IOLD) CALL MXVCOP(IOLD,CR(K+1),G) CALL MXVSET(NCA-IOLD,0.0D0,G(IOLD+1)) K = K + IOLD DO 20 I = IOLD + 1,NCA K = K + I CALL MXVORT(CR(K-1),CR(K),CK,CL,IER) CALL MXVROT(G(I-1),G(I),CK,CL,IER) L = K DO 10 J = I,NCA - 1 L = L + J CALL MXVROT(CR(L-1),CR(L),CK,CL,IER) 10 CONTINUE 20 CONTINUE K = IOLD* (IOLD-1)/2 DO 30 I = IOLD,NCA - 1 L = K + I ICA(I) = ICA(I+1) CALL MXVCOP(I,CR(L+1),CR(K+1)) K = L 30 CONTINUE ICA(NCA) = KC CALL MXVCOP(NCA,G,CR(K+1)) END IF KREM = 1 RETURN END * SUBROUTINE PLADB0 ALL SYSTEMS 97/12/01 * PORTABILITY : ALL SYSTEMS * 97/12/01 LU : ORIGINAL VERSION * * PURPOSE : * NEW LINEAR CONSTRAINT OR A NEW SIMPLE BOUND IS ADDED TO THE * ACTIVE SET. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * IU N ACTUAL NUMBER OF VARIABLES. * IU ICA(NF) VECTOR CONTAINING INDICES OF ACTIVE CONSTRAINTS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RU CR(NF*(NF+1)/2) TRIANGULAR DECOMPOSITION OF KERNEL OF THE * ORTHOGONAL PROJECTION. * RU CZ(NF*NF) MATRIX WHOSE COLUMNS ARE BASIC VECTORS FROM THE * CURRENT REDUCED SUBSPACE. * RA S(NF) AUXILIARY VECTOR. * RI EPS7 TOLERANCE FOR LINEAR INDEPENDENCE OF CONSTRAINTS. * RO GMAX MAXIMUM ABSOLUTE VALUE OF A PARTIAL DERIVATIVE. * RO UMAX MAXIMUM ABSOLUTE VALUE OF A NEGATIVE LAGRANGE MULTIPLIER. * II INEW INDEX OF THE NEW ACTIVE CONSTRAINT. * IU NADD NUMBER OF CONSTRAINT ADDITIONS. * IO IER ERROR INDICATOR. * * SUBPROGRAMS USED : * S PLADR0 CORRECTION OF KERNEL OF THE ORTHOGONAL PROJECTION * AFTER CONSTRAINT ADDITION. * S MXDRMM PREMULTIPLICATION OF A VECTOR BY A ROWWISE STORED DENSE * RECTANGULAR MATRIX. * S MXDRMV COPY OF THE SELECTED COLUMN OF A ROWWISE STORED DENSE * RECTANGULAR MATRIX. * S MXDRGR PLANE ROTATION OF A TRANSPOSED DENSE RECTANGULAR MATRIX. * S MXVORT DETERMINATION OF AN ELEMENTARY ORTHOGONAL MATRIX FOR * PLANE ROTATION. * SUBROUTINE PLADB0(NF,N,ICA,CG,CR,CZ,S,EPS7,GMAX,UMAX,INEW,NADD, + IER) C .. Scalar Arguments .. DOUBLE PRECISION EPS7,GMAX,UMAX INTEGER IER,INEW,N,NADD,NF C .. C .. Array Arguments .. DOUBLE PRECISION CG(*),CR(*),CZ(*),S(*) INTEGER ICA(*) C .. C .. Local Scalars .. DOUBLE PRECISION CK,CL INTEGER K,L,N1 C .. C .. External Subroutines .. EXTERNAL MXDRGR,MXDRMM,MXDRMV,MXVORT,PLADR0 C .. CALL PLADR0(NF,N,ICA,CG,CR,S,EPS7,GMAX,UMAX,INEW,NADD,IER) IF (IER.NE.0) RETURN IF (N.GT.0) THEN N1 = N + 1 IF (INEW.GT.0) THEN CALL MXDRMM(NF,N1,CZ,CG((INEW-1)*NF+1),S) ELSE CALL MXDRMV(NF,N1,CZ,S,-INEW) END IF DO 10 L = 1,N K = L + 1 CALL MXVORT(S(K),S(L),CK,CL,IER) CALL MXDRGR(NF,CZ,K,L,CK,CL,IER) IF (IER.LT.0) RETURN 10 CONTINUE END IF IER = 0 RETURN END * SUBROUTINE PLADB4 ALL SYSTEMS 97/12/01 * PORTABILITY : ALL SYSTEMS * 97/12/01 LU : ORIGINAL VERSION * * PURPOSE : * NEW LINEAR CONSTRAINT OR A NEW SIMPLE BOUND IS ADDED TO THE ACTIVE * SET. TRANSFORMED HESSIAN MATRIX APPROXIMATION OR ITS INVERSION * IS UPDATED. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * IU N ACTUAL NUMBER OF VARIABLES. * IU ICA(NF) VECTOR CONTAINING INDICES OF ACTIVE CONSTRAINTS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RU CR(NF*(NF+1)/2) TRIANGULAR DECOMPOSITION OF KERNEL OF THE * ORTHOGONAL PROJECTION. * RU CZ(NF*NF) MATRIX WHOSE COLUMNS ARE BASIC VECTORS FROM THE * CURRENT REDUCED SUBSPACE. * RU H(NF*(NF+1)/2) TRANSFORMED HESSIAN MATRIX APPROXIMATION OR * ITS INVERSION. * RA S(NF) AUXILIARY VECTOR. * RI EPS7 TOLERANCE FOR LINEAR INDEPENDENCE OF CONSTRAINTS. * RO GMAX MAXIMUM ABSOLUTE VALUE OF A PARTIAL DERIVATIVE. * RO UMAX MAXIMUM ABSOLUTE VALUE OF A NEGATIVE LAGRANGE MULTIPLIER. * IU IDECF DECOMPOSITION INDICATOR. IDECF=0-NO DECOMPOSITION. * IDECF=1-GILL-MURRAY DECOMPOSITION. IDECF=9-INVERSION. * IDECF=10-DIAGONAL MATRIX. * II INEW INDEX OF THE NEW ACTIVE CONSTRAINT. * IU NADD NUMBER OF CONSTRAINT ADDITIONS. * IO IER ERROR INDICATOR. * * SUBPROGRAMS USED : * S PLADR0 CORRECTION OF KERNEL OF THE ORTHOGONAL PROJECTION * AFTER CONSTRAINT ADDITION. * S MXDRMM PREMULTIPLICATION OF A VECTOR BY A ROWWISE STORED DENSE * RECTANGULAR MATRIX. * S MXDRMV COPY OF THE SELECTED COLUMN OF A ROWWISE STORED DENSE * RECTANGULAR MATRIX. * S MXDRGR PLANE ROTATION OF A TRANSPOSED DENSE RECTANGULAR MATRIX. * RECTANGULAR MATRIX. * S MXDSMR PLANE ROTATION OF A DENSE SYMMETRIC MATRIX. * S MXVORT DETERMINATION OF AN ELEMENTARY ORTHOGONAL MATRIX FOR * PLANE ROTATION. * SUBROUTINE PLADB4(NF,N,ICA,CG,CR,CZ,H,S,EPS7,GMAX,UMAX,IDECF,INEW, + NADD,IER) C .. Scalar Arguments .. DOUBLE PRECISION EPS7,GMAX,UMAX INTEGER IDECF,IER,INEW,N,NADD,NF C .. C .. Array Arguments .. DOUBLE PRECISION CG(*),CR(*),CZ(*),H(*),S(*) INTEGER ICA(*) C .. C .. Local Scalars .. DOUBLE PRECISION CK,CL INTEGER I,J,K,L,N1 C .. C .. External Subroutines .. EXTERNAL MXDRGR,MXDRMM,MXDRMV,MXDSMR,MXVORT,PLADR0 C .. IF (IDECF.NE.0 .AND. IDECF.NE.9) THEN IER = -2 RETURN END IF CALL PLADR0(NF,N,ICA,CG,CR,S,EPS7,GMAX,UMAX,INEW,NADD,IER) IF (IER.NE.0) RETURN IF (N.GT.0) THEN N1 = N + 1 IF (INEW.GT.0) THEN CALL MXDRMM(NF,N1,CZ,CG((INEW-1)*NF+1),S) ELSE CALL MXDRMV(NF,N1,CZ,S,-INEW) END IF DO 10 L = 1,N K = L + 1 CALL MXVORT(S(K),S(L),CK,CL,IER) CALL MXDRGR(NF,CZ,K,L,CK,CL,IER) CALL MXDSMR(N1,H,K,L,CK,CL,IER) IF (IER.LT.0) RETURN 10 CONTINUE IF (IDECF.EQ.9) THEN L = N* (N+1)/2 IF (H(L+N1).NE.0.0D0) THEN CL = 1.0D0/H(L+N1) K = 0 DO 30 I = 1,N CK = CL*H(L+I) DO 20 J = 1,I K = K + 1 H(K) = H(K) - CK*H(L+J) 20 CONTINUE 30 CONTINUE END IF END IF END IF IER = 0 RETURN END * SUBROUTINE PLADR0 ALL SYSTEMS 97/12/01 * PORTABILITY : ALL SYSTEMS * 97/12/01 LU : ORIGINAL VERSION * * PURPOSE : * TRIANGULAR DECOMPOSITION OF KERNEL OF THE ORTHOGONAL PROJECTION * IS UPDATED AFTER CONSTRAINT ADDITION. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * IU N ACTUAL NUMBER OF VARIABLES. * IU ICA(NF) VECTOR CONTAINING INDICES OF ACTIVE CONSTRAINTS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RU CR(NF*(NF+1)/2) TRIANGULAR DECOMPOSITION OF KERNEL OF THE * ORTHOGONAL PROJECTION. * RA S(NF) AUXILIARY VECTOR. * RI EPS7 TOLERANCE FOR LINEAR INDEPENDENCE OF CONSTRAINTS. * RO GMAX MAXIMUM ABSOLUTE VALUE OF A PARTIAL DERIVATIVE. * RO UMAX MAXIMUM ABSOLUTE VALUE OF A NEGATIVE LAGRANGE MULTIPLIER. * II INEW INDEX OF THE NEW ACTIVE CONSTRAINT. * IU NADD NUMBER OF CONSTRAINT ADDITIONS. * IO IER ERROR INDICATOR. * * SUBPROGRAMS USED : * S MXSPRB SPARSE BACK SUBSTITUTION. * S MXVCOP COPYING OF A VECTOR. * RF MXVDOT DOT PRODUCT OF TWO VECTORS. * SUBROUTINE PLADR0(NF,N,ICA,CG,CR,S,EPS7,GMAX,UMAX,INEW,NADD,IER) C .. Scalar Arguments .. DOUBLE PRECISION EPS7,GMAX,UMAX INTEGER IER,INEW,N,NADD,NF C .. C .. Array Arguments .. DOUBLE PRECISION CG(*),CR(*),S(*) INTEGER ICA(*) C .. C .. Local Scalars .. INTEGER I,J,K,L,NCA,NCR C .. C .. External Functions .. DOUBLE PRECISION MXVDOT EXTERNAL MXVDOT C .. C .. External Subroutines .. EXTERNAL MXDPRB,MXVCOP C .. C .. Intrinsic Functions .. INTRINSIC SQRT C .. IER = 0 IF (N.LE.0) IER = 2 IF (INEW.EQ.0) IER = 3 IF (IER.NE.0) RETURN NCA = NF - N NCR = NCA* (NCA+1)/2 IF (INEW.GT.0) THEN CALL MXVCOP(NF,CG((INEW-1)*NF+1),S) GMAX = MXVDOT(NF,CG((INEW-1)*NF+1),S) DO 10 J = 1,NCA L = ICA(J) IF (L.GT.0) THEN CR(NCR+J) = MXVDOT(NF,CG((L-1)*NF+1),S) ELSE I = -L CR(NCR+J) = S(I) END IF 10 CONTINUE ELSE K = -INEW GMAX = 1.0D0 DO 20 J = 1,NCA L = ICA(J) IF (L.GT.0) THEN CR(NCR+J) = CG((L-1)*NF+K)*GMAX ELSE CR(NCR+J) = 0.0D0 END IF 20 CONTINUE END IF IF (NCA.EQ.0) THEN UMAX = GMAX ELSE CALL MXDPRB(NCA,CR,CR(NCR+1),1) UMAX = GMAX - MXVDOT(NCA,CR(NCR+1),CR(NCR+1)) END IF IF (UMAX.LE.EPS7*GMAX) THEN IER = 1 RETURN ELSE N = N - 1 NCA = NCA + 1 NCR = NCR + NCA ICA(NCA) = INEW CR(NCR) = SQRT(UMAX) NADD = NADD + 1 END IF RETURN END * SUBROUTINE PLDIRL ALL SYSTEMS 97/12/01 * PORTABILITY : ALL SYSTEMS * 97/12/01 LU : ORIGINAL VERSION * * PURPOSE : * DETERMINATION OF THE NEW VALUES OF THE CONSTRAINT FUNCTIONS. * * PARAMETERS : * II NC NUMBER OF CONSTRAINTS. * RU CF(NF) VECTOR CONTAINING VALUES OF THE CONSTRAINT FUNCTIONS. * RI CFD(NF) VECTOR CONTAINING INCREMENTS OF THE CONSTRAINT * FUNCTIONS. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * RI STEP CURRENT STEPSIZE. * II KBC SPECIFICATION OF LINEAR CONSTRAINTS. KBC=0-NO LINEAR * CONSTRAINTS. KBC=1-ONE SIDED LINEAR CONSTRAINTS. KBC=2=TWO * SIDED LINEAR CONSTRAINTS. * SUBROUTINE PLDIRL(NC,CF,CFD,IC,STEP,KBC) C .. Scalar Arguments .. DOUBLE PRECISION STEP INTEGER KBC,NC C .. C .. Array Arguments .. DOUBLE PRECISION CF(*),CFD(*) INTEGER IC(*) C .. C .. Local Scalars .. INTEGER KC C .. IF (KBC.GT.0) THEN DO 10 KC = 1,NC IF (IC(KC).GE.0 .AND. IC(KC).LE.10) THEN CF(KC) = CF(KC) + STEP*CFD(KC) ELSE IF (IC(KC).LT.-10) THEN CF(KC) = CF(KC) + STEP*CFD(KC) END IF 10 CONTINUE END IF RETURN END * SUBROUTINE PLDIRS ALL SYSTEMS 97/12/01 * PORTABILITY : ALL SYSTEMS * 97/12/01 LU : ORIGINAL VERSION * * PURPOSE : * DETERMINATION OF THE NEW VECTOR OF VARIABLES. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * RU X(NF) VECTOR OF VARIABLES. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. * RI S(NF) DIRECTION VECTOR. * RI STEP CURRENT STEPSIZE. * II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS. * KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS. * SUBROUTINE PLDIRS(NF,X,IX,S,STEP,KBF) C .. Scalar Arguments .. DOUBLE PRECISION STEP INTEGER KBF,NF C .. C .. Array Arguments .. DOUBLE PRECISION S(*),X(*) INTEGER IX(*) C .. C .. Local Scalars .. INTEGER I C .. DO 10 I = 1,NF IF (KBF.LE.0) THEN X(I) = X(I) + STEP*S(I) ELSE IF (IX(I).GE.0 .AND. IX(I).LE.10) THEN X(I) = X(I) + STEP*S(I) ELSE IF (IX(I).LT.-10) THEN X(I) = X(I) + STEP*S(I) END IF 10 CONTINUE RETURN END * SUBROUTINE PLINIT ALL SYSTEMS 97/12/01 * PORTABILITY : ALL SYSTEMS * 97/12/01 LU : ORIGINAL VERSION * * PURPOSE : * DETERMINATION OF THE INITIAL POINT WHICH SATISFIES SIMPLE BOUNDS. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * RU X(NF) VECTOR OF VARIABLES. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. * RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * RI EPS9 TOLERANCE FOR ACTIVE CONSTRAINTS. * IO INEW INDEX OF THE NEW ACTIVE CONSTRAINT. * IO IND INDICATOR. IF IND.NE.0 THEN TRUST REGION BOUNDS CANNOT * BE SATISFIED. * * SUBPROGRAMS USED : * S PLNEWS TEST ON ACTIVITY OF A GIVEN SIMPLE BOUND. * SUBROUTINE PLINIT(NF,X,IX,XL,XU,EPS9,KBF,INEW,IND) C .. Scalar Arguments .. DOUBLE PRECISION EPS9 INTEGER IND,INEW,KBF,NF C .. C .. Array Arguments .. DOUBLE PRECISION X(*),XL(*),XU(*) INTEGER IX(*) C .. C .. Local Scalars .. INTEGER I C .. C .. External Subroutines .. EXTERNAL PLNEWS C .. IND = 0 IF (KBF.GT.0) THEN DO 10 I = 1,NF CALL PLNEWS(X,IX,XL,XU,EPS9,I,INEW) IF (IX(I).LT.5) THEN ELSE IF (IX(I).EQ.5) THEN IX(I) = -5 ELSE IF (IX(I).EQ.11 .OR. IX(I).EQ.13) THEN X(I) = XL(I) IX(I) = 10 - IX(I) ELSE IF (IX(I).EQ.12 .OR. IX(I).EQ.14) THEN X(I) = XU(I) IX(I) = 10 - IX(I) END IF 10 CONTINUE END IF RETURN END * SUBROUTINE PLLPB1 ALL SYSTEMS 97/12/01 * PORTABILITY : ALL SYSTEMS * 97/12/01 LU : ORIGINAL VERSION * * PURPOSE : * DETERMINATION OF THE INITIAL FEASIBLE POINT AND THE LINEAR PROGRAMMING * SUBROUTINE. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NC NUMBER OF LINEAR CONSTRAINTS. * RU X(NF) VECTOR OF VARIABLES. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. * RO XO(NF) SAVED VECTOR OF VARIABLES. * RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * RU CF(NF) VECTOR CONTAINING VALUES OF THE CONSTRAINT FUNCTIONS. * RA CFD(NF) VECTOR CONTAINING INCREMENTS OF THE CONSTRAINT * FUNCTIONS. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * IO ICA(NF) VECTOR CONTAINING INDICES OF ACTIVE CONSTRAINTS. * RI CL(NC) VECTOR CONTAINING LOWER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CU(NC) VECTOR CONTAINING UPPER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RO CR(NF*(NF+1)/2) TRIANGULAR DECOMPOSITION OF KERNEL OF THE * ORTHOGONAL PROJECTION. * RO CZ(NF*NF) MATRIX WHOSE COLUMNS ARE BASIC VECTORS FROM THE * CURRENT REDUCED SUBSPACE. * RI G(NF) GRADIENT OF THE OBJECTIVE FUNCTION. * RO GO(NF) SAVED GRADIENT OF THE OBJECTIVE FUNCTION. * RA S(NF) DIRECTION VECTOR. * II MFP TYPE OF FEASIBLE POINT. MFP=1-ARBITRARY FEASIBLE POINT. * MFP=2-OPTIMUM FEASIBLE POINT. MFP=3-REPEATED SOLUTION. * II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS. * KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS. * II KBC SPECIFICATION OF LINEAR CONSTRAINTS. KBC=0-NO LINEAR * CONSTRAINTS. KBC=1-ONE SIDED LINEAR CONSTRAINTS. KBC=2=TWO * SIDED LINEAR CONSTRAINTS. * RI ETA9 MAXIMUM FOR REAL NUMBERS. * RI EPS7 TOLERANCE FOR LINEAR INDEPENDENCE OF CONSTRAINTS. * RI EPS9 TOLERANCE FOR ACTIVITY OF CONSTRAINTS. * RO UMAX MAXIMUM ABSOLUTE VALUE OF A NEGATIVE LAGRANGE MULTIPLIER. * RO GMAX MAXIMUM ABSOLUTE VALUE OF A PARTIAL DERIVATIVE. * IO N DIMENSION OF THE MANIFOLD DEFINED BY ACTIVE CONSTRAINTS. * IO ITERL TYPE OF FEASIBLE POINT. ITERL=1-ARBITRARY FEASIBLE POINT. * ITERL=2-OPTIMUM FEASIBLE POINT. ITERL=-1 FEASIBLE POINT DOES * NOT EXISTS. ITERL=-2 OPTIMUM FEASIBLE POINT DOES NOT EXISTS. * * SUBPROGRAMS USED : * S PLINIT DETERMINATION OF INITIAL POINT SATISFYING SIMPLE BOUNDS. * S PLMAXL MAXIMUM STEPSIZE USING LINEAR CONSTRAINTS. * S PLMAXS MAXIMUM STEPSIZE USING SIMPLE BOUNDS. * S PLMAXT MAXIMUM STEPSIZE USING TRUST REGION BOUNDS. * S PLNEWL IDENTIFICATION OF ACTIVE LINEAR CONSTRAINTS. * S PLNEWS IDENTIFICATION OF ACTIVE SIMPLE BOUNDS. * S PLNEWT IDENTIFICATION OF ACTIVE TRUST REGION BOUNDS. * S PLDIRL NEW VALUES OF CONSTRAINT FUNCTIONS. * S PLDIRS NEW VALUES OF VARIABLES. * S PLSETC INITIAL VALUES OF CONSTRAINT FUNCTIONS. * S PLSETG DETERMINATION OF THE FIRST PHASE GRADIENT VECTOR. * S PLTRBG DETERMINATION OF LAGRANGE MULTIPLIERS AND COMPUTATION * S PLADB0 CONSTRAINT ADDITION. * S PLRMB0 CONSTRAINT DELETION. * S MXDCMM PREMULTIPLICATION OF A VECTOR BY A DENSE RECTANGULAR * MATRIX STORED BY COLUMNS. * S MXDRMM PREMULTIPLICATION OF A VECTOR BY A DENSE RECTANGULAR * MATRIX STORED BY ROWS. * S MXDSMI DETERMINATION OF THE INITIAL UNIT DENSE SYMMETRIC * MATRIX. * S MXVCOP COPYING OF A VECTOR. * S MXVINA ABSOLUTE VALUES OF ELEMENTS OF AN INTEGER VECTOR. * S MXVINC UPDATE OF AN INTEGER VECTOR. * S MXVIND CHANGE OF THE INTEGER VECTOR FOR CONSTRAINT ADDITION. * S MXVINT CHANGE OF THE INTEGER VECTOR FOR TRUST REGION BOUND * ADDITION. * S MXVMUL DIAGONAL PREMULTIPLICATION OF A VECTOR. * S MXVNEG COPYING OF A VECTOR WITH CHANGE OF THE SIGN. * S MXVSET INITIATION OF A VECTOR. * SUBROUTINE PLLPB1(NF,NC,X,IX,XO,XL,XU,CF,CFD,IC,ICA,CL,CU,CG,CR, + CZ,G,GO,S,MFP,KBF,KBC,ETA9,EPS7,EPS9,UMAX,GMAX, + N,ITERL) C .. Scalar Arguments .. DOUBLE PRECISION EPS7,EPS9,ETA9,GMAX,UMAX INTEGER ITERL,KBC,KBF,MFP,N,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION CF(*),CFD(*),CG(*),CL(*),CR(*),CU(*),CZ(*),G(*), + GO(*),S(*),X(*),XL(*),XO(*),XU(*) INTEGER IC(*),ICA(*),IX(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION CON,DMAX,POM INTEGER I,IER,INEW,IOLD,IPOM,K,KC,KREM,NCA,NCR,NCZ C .. C .. External Subroutines .. EXTERNAL MXDCMM,MXDRMM,MXDSMI,MXVCOP,MXVINA,MXVIND,MXVNEG,MXVSET, + PLADB0,PLDIRL,PLDIRS,PLINIT,PLMAXL,PLMAXS,PLNEWL,PLNEWS, + PLRMB0,PLSETC,PLSETG,PLTRBG C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. CON = ETA9 * * INITIATION * CALL MXVCOP(NF,X,XO) IPOM = 0 NRED = 0 KREM = 0 ITERL = 1 DMAX = 0.0D0 IF (MFP.EQ.3) GO TO 40 IF (KBF.GT.0) CALL MXVINA(NF,IX) * * SHIFT OF VARIABLES FOR SATISFYING SIMPLE BOUNDS * CALL PLINIT(NF,X,IX,XL,XU,EPS9,KBF,INEW,ITERL) IF (ITERL.LT.0) THEN GO TO 60 END IF N = 0 NCA = 0 NCZ = 0 DO 10 I = 1,NF IF (KBF.GT.0 .AND. IX(I).LT.0) THEN NCA = NCA + 1 ICA(NCA) = -I ELSE N = N + 1 CALL MXVSET(NF,0.0D0,CZ(NCZ+1)) CZ(NCZ+I) = 1.0D0 NCZ = NCZ + NF END IF 10 CONTINUE CALL MXDSMI(NCA,CR) IF (NC.GT.0) THEN CALL MXDRMM(NF,NC,CG,X,CF) * * ADDITION OF ACTIVE CONSTRAINTS AND INITIAL CHECK OF FEASIBILITY * CALL MXVINA(NC,IC) IF (NF.GT.N) CALL PLSETC(NF,NC,X,XO,CF,IC,CG,S) DO 20 KC = 1,NC IF (IC(KC).NE.0) THEN INEW = 0 CALL PLNEWL(KC,CF,IC,CL,CU,EPS9,INEW) CALL PLADB0(NF,N,ICA,CG,CR,CZ,S,EPS7,GMAX,UMAX,INEW, + NADD,IER) CALL MXVIND(IC,KC,IER) IF (IC(KC).LT.-10) IPOM = 1 END IF 20 CONTINUE END IF 30 IF (IPOM.EQ.1) THEN * * CHECK OF FEASIBILITY AND UPDATE OF THE FIRST PHASE OBJECTIVE * FUNCTION * CALL PLSETG(NF,NC,IC,CG,GO,INEW) IF (INEW.EQ.0) IPOM = 0 END IF IF (IPOM.EQ.0 .AND. ITERL.EQ.0) THEN * * FEASIBILITY ACHIEVED * ITERL = 1 CALL MXVCOP(NF,G,GO) IF (MFP.EQ.1) GO TO 60 END IF * * LAGRANGE MULTIPLIERS AND REDUCED GRADIENT DETERMINATION * 40 CALL PLTRBG(NF,N,NC,IX,IC,ICA,CG,CR,CZ,GO,S,EPS7,GMAX,UMAX,IOLD) INEW = 0 IF (GMAX.EQ.0.0D0) THEN * * OPTIMUM ON A LINEAR MANIFOLD OBTAINED * IF (IOLD.EQ.0) THEN IF (IPOM.EQ.0) THEN * * OPTIMAL SOLUTION ACHIEVED * ITERL = 2 GO TO 60 ELSE IPOM = 0 DO 50 KC = 1,NC IF (IC(KC).LT.-10) THEN INEW = 0 CALL PLNEWL(KC,CF,IC,CL,CU,EPS9,INEW) IF (IC(KC).LT.-10) IPOM = 1 END IF 50 CONTINUE IF (IPOM.EQ.0) THEN * * OPTIMAL SOLUTION ACHIEVED * CALL MXVCOP(NF,GO,G) ITERL = 2 GO TO 60 ELSE * * FEASIBLE SOLUTION DOES NOT EXIST * CALL MXVCOP(NF,GO,G) ITERL = -1 GO TO 60 END IF END IF ELSE * * CONSTRAINT DELETION * CALL PLRMB0(NF,N,ICA,CG,CR,CZ,GO,S,IOLD,KREM,NREM,IER) KC = ICA(NF-N+1) IF (KC.GT.0) THEN IC(KC) = -IC(KC) ELSE K = -KC IX(K) = -IX(K) END IF DMAX = 0.0D0 GO TO 40 END IF ELSE * * DIRECTION DETERMINATION * NCA = NF - N NCR = NCA* (NCA+1)/2 CALL MXDCMM(NF,N,CZ,S,CR(NCR+1)) CALL MXVNEG(NF,CR(NCR+1),S) * * STEPSIZE SELECTION * POM = CON CALL PLMAXL(NF,NC,CF,CFD,IC,CL,CU,CG,S,POM,KBC,KREM,INEW) CALL PLMAXS(NF,X,IX,XL,XU,S,POM,KBF,KREM,INEW) IF (INEW.EQ.0) THEN IF (IPOM.EQ.0) THEN * * BOUNDED SOLUTION DOES NOT EXIST * ITERL = -2 ELSE * * FEASIBLE SOLUTION DOES NOT EXIST * ITERL = -3 END IF GO TO 60 ELSE * * STEP REALIZATION * CALL PLDIRS(NF,X,IX,S,POM,KBF) CALL PLDIRL(NC,CF,CFD,IC,POM,KBC) * * CONSTRAINT ADDITION * IF (INEW.GT.0) THEN KC = INEW INEW = 0 CALL PLNEWL(KC,CF,IC,CL,CU,EPS9,INEW) CALL PLADB0(NF,N,ICA,CG,CR,CZ,S,EPS7,GMAX,UMAX,INEW, + NADD,IER) CALL MXVIND(IC,KC,IER) ELSE IF (INEW+NF.GE.0) THEN I = -INEW INEW = 0 CALL PLNEWS(X,IX,XL,XU,EPS9,I,INEW) CALL PLADB0(NF,N,ICA,CG,CR,CZ,S,EPS7,GMAX,UMAX,INEW, + NADD,IER) CALL MXVIND(IX,I,IER) END IF DMAX = POM IF (DMAX.GT.0.0D0) NRED = NRED + 1 GO TO 30 END IF END IF 60 CONTINUE RETURN END * SUBROUTINE PLLPB2 ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * DETERMINATION OF THE INITIAL FEASIBLE POINT AND THE LINEAR PROGRAMMING * SUBROUTINE. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NC NUMBER OF LINEAR CONSTRAINTS. * RI X(NF) VECTOR OF VARIABLES. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. * RO XO(NF) SAVED VECTOR OF VARIABLES. * RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * RI CF(NF) VECTOR CONTAINING VALUES OF THE CONSTRAINT FUNCYIONS. * RO CFD(NF) VECTOR CONTAINING INCREMENTS OF THE CONSTRAINT * FUNCTIONS. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * II ICA(NF) VECTOR CONTAINING INDICES OF ACTIVE CONSTRAINTS. * RI CL(NC) VECTOR CONTAINING LOWER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CU(NC) VECTOR CONTAINING UPPER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RI CR(NF*(NF+1)/2) TRIANGULAR DECOMPOSITION OF KERNEL OF THE * ORTHOGONAL PROJECTION. * RO CZ(NF) VECTOR OF LAGRANGE MULTIPLIERS. * RI G(NF) GRADIENT OF THE OBJECTIVE FUNCTION. * RO GO(NF) SAVED GRADIENT OF THE OBJECTIVE FUNCTION. * RI S(NF) DIRECTION VECTOR. * II MFP TYPE OF FEASIBLE POINT. MFP=1-ARBITRARY FEASIBLE POINT. * MFP=2-OPTIMUM FEASIBLE POINT. MFP=3-REPEATED SOLUTION. * II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS. * KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS. * II KBC SPECIFICATION OF LINEAR CONSTRAINTS. KBC=0-NO LINEAR * CONSTRAINTS. KBC=1-ONE SIDED LINEAR CONSTRAINTS. KBC=2=TWO * SIDED LINEAR CONSTRAINTS. * RI ETA9 MAXIMUM FOR REAL NUMBERS. * RI EPS7 TOLERANCE FOR LINEAR INDEPENDENCE OF CONSTRAINTS. * RI EPS9 TOLERANCE FOR ACTIVITY OF CONSTRAINTS. * RO UMAX MAXIMUM ABSOLUTE VALUE OF A NEGATIVE LAGRANGE MULTIPLIER. * RO GMAX MAXIMUM ABSOLUTE VALUE OF A PARTIAL DERIVATIVE. * IO N DIMENSION OF THE MANIFOLD DEFINED BY ACTIVE CONSTRAINTS. * IO ITERL TYPE OF FEASIBLE POINT. ITERL=1-ARBITRARY FEASIBLE POINT. * ITERL=2-OPTIMUM FEASIBLE POINT. ITERL=-1 FEASIBLE POINT DOES * NOT EXISTS. ITERL=-2 OPTIMUM FEASIBLE POINT DOES NOT EXISTS. * * SUBPROGRAMS USED : * S PLINIT DETERMINATION OF INITIAL POINT SATISFYING SIMPLE BOUNDS. * S PLMAXL MAXIMUM STEPSIZE USING LINEAR CONSTRAINTS. * S PLMAXS MAXIMUM STEPSIZE USING SIMPLE BOUNDS. * S PLMAXT MAXIMUM STEPSIZE USING TRUST REGION BOUNDS. * S PLNEWL IDENTIFICATION OF ACTIVE LINEAR CONSTRAINTS. * S PLNEWS IDENTIFICATION OF ACTIVE SIMPLE BOUNDS. * S PLNEWT IDENTIFICATION OF ACTIVE TRUST REGION BOUNDS. * S PLDIRL NEW VALUES OF CONSTRAINT FUNCTIONS. * S PLDIRS NEW VALUES OF VARIABLES. * S PLSETC INITIAL VALUES OF CONSTRAINT FUNCTIONS. * S PLSETG DETERMINATION OF THE FIRST PHASE GRADIENT VECTOR. * S PLGLAG GRADIENT OF THE LAGRANGIAN FUNCTION IS DETERMINED. * S PLSLAG NEGATIVE PROJECTED GRADIENT IS DETERMINED. * S PLTLAG THE OPTIMUM LAGRANGE MULTIPLIER IS DETERMINED. * S PLVLAG AN AUXILIARY VECTOR IS DETERMINED. * S PLADR0 CONSTRAINT ADDITION. * S PLRMF0 CONSTRAINT DELETION. * S MXDPRB BACK SUBSTITUTION AFTER CHOLESKI DECOMPOSITION. * S MXDSMI DETERMINATION OF THE INITIAL UNIT DENSE SYMMETRIC * MATRIX. * S MXVCOP COPYING OF A VECTOR. * S MXVDIF DIFFERENCE OF TWO VECTORS. * S MXVINA ABSOLUTE VALUES OF ELEMENTS OF AN INTEGER VECTOR. * S MXVINC UPDATE OF AN INTEGER VECTOR. * S MXVIND CHANGE OF THE INTEGER VECTOR FOR CONSTRAINT ADDITION. * S MXVINT CHANGE OF THE INTEGER VECTOR FOR TRUST REGION BOUND * ADDITION. * S MXVMUL DIAGONAL PREMULTIPLICATION OF A VECTOR. * S MXVNEG COPYING OF A VECTOR WITH CHANGE OF THE SIGN. * S MXVSET INITIATION OF A VECTOR. * SUBROUTINE PLLPB2(NF,NC,X,IX,XO,XL,XU,CF,CFD,IC,ICA,CL,CU,CG,CR, + CZ,G,GO,S,MFP,KBF,KBC,ETA9,EPS7,EPS9,UMAX,GMAX, + N,ITERL) C .. Scalar Arguments .. DOUBLE PRECISION EPS7,EPS9,ETA9,GMAX,UMAX INTEGER ITERL,KBC,KBF,MFP,N,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION CF(*),CFD(*),CG(*),CL(*),CR(*),CU(*),CZ(*),G(*), + GO(*),S(*),X(*),XL(*),XO(*),XU(*) INTEGER IC(*),ICA(*),IX(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION CON,DMAX,POM INTEGER I,IER,INEW,IOLD,IPOM,KC,KREM,MODE C .. C .. External Subroutines .. EXTERNAL MXDPRB,MXDSMI,MXVCOP,MXVINA,MXVIND,MXVNEG,PLADR0,PLDIRL, + PLDIRS,PLINIT,PLMAXL,PLMAXS,PLNEWL,PLNEWS,PLRMF0,PLSETC, + PLSETG,PLSLAG,PLTLAG,PLVLAG C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. CON = ETA9 * * INITIATION * CALL MXVCOP(NF,X,XO) CALL MXVCOP(NF,G,GO) IPOM = 0 NRED = 0 KREM = 0 ITERL = 1 DMAX = 0.0D0 IF (MFP.EQ.3) GO TO 40 IF (KBF.GT.0) CALL MXVINA(NF,IX) * * SHIFT OF VARIABLES FOR SATISFYING SIMPLE BOUNDS * CALL PLINIT(NF,X,IX,XL,XU,EPS9,KBF,INEW,ITERL) IF (ITERL.LT.0) THEN GO TO 60 END IF N = NF DO 10 I = 1,NF IF (KBF.GT.0 .AND. IX(I).LT.0) THEN N = N - 1 ICA(NF-N) = -I END IF 10 CONTINUE CALL MXDSMI(NF-N,CR) IF (NC.GT.0) THEN * * ADDITION OF ACTIVE CONSTRAINTS AND INITIAL CHECK OF FEASIBILITY * CALL MXVINA(NC,IC) IF (NF.GT.N) CALL PLSETC(NF,NC,X,XO,CF,IC,CG,S) DO 20 KC = 1,NC IF (IC(KC).NE.0) THEN INEW = 0 CALL PLNEWL(KC,CF,IC,CL,CU,EPS9,INEW) CALL PLADR0(NF,N,ICA,CG,CR,S,EPS7,GMAX,UMAX,INEW,NADD, + IER) CALL MXVIND(IC,KC,IER) IF (IC(KC).LT.-10) IPOM = 1 END IF 20 CONTINUE END IF 30 IF (IPOM.EQ.1) THEN * * CHECK OF FEASIBILITY AND UPDATE OF THE FIRST PHASE OBJECTIVE * FUNCTION * CALL PLSETG(NF,NC,IC,CG,G,INEW) IF (INEW.EQ.0) IPOM = 0 END IF IF (IPOM.EQ.0 .AND. ITERL.EQ.0) THEN * * FEASIBILITY ACHIEVED * ITERL = 1 CALL MXVCOP(NF,GO,G) IF (MFP.EQ.1) GO TO 60 END IF * * LAGRANGE MULTIPLIERS DETERMINATION * 40 IF (NF.GT.N) THEN CALL PLVLAG(NF,N,NC,ICA,CG,CG,G,CZ) CALL MXDPRB(NF-N,CR,CZ,0) CALL PLTLAG(NF,N,NC,IX,IC,ICA,CZ,IC,EPS7,UMAX,IOLD) ELSE IOLD = 0 UMAX = 0.0D0 END IF * * PROJECTED GRADIENT DETERMINATION * IF (N.GT.0) THEN CALL MXVNEG(NF,G,S) CALL PLSLAG(NF,N,NC,ICA,CG,CZ,CG,S,EPS7,GMAX) ELSE GMAX = 0.0D0 END IF MODE = 1 - IPOM INEW = 0 IF (GMAX.EQ.0.0D0) THEN * * OPTIMUM ON A LINEAR MANIFOLD OBTAINED * IF (IOLD.EQ.0) THEN IF (IPOM.EQ.0) THEN * * OPTIMAL SOLUTION ACHIEVED * ITERL = 2 GO TO 60 ELSE IPOM = 0 DO 50 KC = 1,NC IF (IC(KC).LT.-10) THEN INEW = 0 CALL PLNEWL(KC,CF,IC,CL,CU,EPS9,INEW) IF (IC(KC).LT.-10) IPOM = 1 END IF 50 CONTINUE IF (IPOM.EQ.0) THEN * * OPTIMAL SOLUTION ACHIEVED * CALL MXVCOP(NF,GO,G) ITERL = 2 GO TO 60 ELSE * * FEASIBLE SOLUTION DOES NOT EXIST * CALL MXVCOP(NF,GO,G) ITERL = -1 GO TO 60 END IF END IF ELSE * * CONSTRAINT DELETION * CALL PLRMF0(NF,NC,IX,IC,ICA,CR,IC,S,N,IOLD,KREM,IER) DMAX = 0.0D0 GO TO 40 END IF ELSE * * STEPSIZE SELECTION * POM = CON CALL PLMAXL(NF,NC,CF,CFD,IC,CL,CU,CG,S,POM,KBC,KREM,INEW) CALL PLMAXS(NF,X,IX,XL,XU,S,POM,KBF,KREM,INEW) IF (INEW.EQ.0) THEN IF (IPOM.EQ.0) THEN * * BOUNDED SOLUTION DOES NOT EXIST * ITERL = -2 ELSE * * FEASIBLE SOLUTION DOES NOT EXIST * ITERL = -3 END IF GO TO 60 ELSE * * STEP REALIZATION * CALL PLDIRS(NF,X,IX,S,POM,KBF) CALL PLDIRL(NC,CF,CFD,IC,POM,KBC) * * CONSTRAINT ADDITION * IF (INEW.GT.0) THEN KC = INEW INEW = 0 CALL PLNEWL(KC,CF,IC,CL,CU,EPS9,INEW) CALL PLADR0(NF,N,ICA,CG,CR,S,EPS7,GMAX,UMAX,INEW,NADD, + IER) CALL MXVIND(IC,KC,IER) ELSE IF (INEW+NF.GE.0) THEN I = -INEW INEW = 0 CALL PLNEWS(X,IX,XL,XU,EPS9,I,INEW) CALL PLADR0(NF,N,ICA,CG,CR,S,EPS7,GMAX,UMAX,INEW,NADD, + IER) CALL MXVIND(IX,I,IER) END IF DMAX = POM NRED = NRED + 1 GO TO 30 END IF END IF 60 CONTINUE RETURN END * SUBROUTINE PLMAXL ALL SYSTEMS 97/12/01 * PORTABILITY : ALL SYSTEMS * 97/12/01 LU : ORIGINAL VERSION * * PURPOSE : * DETERMINATION OF THE MAXIMUM STEPSIZE USING LINEAR CONSTRAINTS. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II NC NUMBER OF CURRENT LINEAR CONSTRAINTS. * RI CF(NF) VECTOR CONTAINING VALUES OF THE CONSTRAINT FUNCYIONS. * RO CFD(NF) VECTOR CONTAINING INCREMENTS OF THE CONSTRAINT * FUNCTIONS. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * RI CL(NC) VECTOR CONTAINING LOWER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CU(NC) VECTOR CONTAINING UPPER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RI S(NF) DIRECTION VECTOR. * RO STEP MAXIMUM STEPSIZE. * II KBC SPECIFICATION OF LINEAR CONSTRAINTS. KBC=0-NO LINEAR * CONSTRAINTS. KBC=1-ONE SIDED LINEAR CONSTRAINTS. KBC=2=TWO * SIDED LINEAR CONSTRAINTS. * II KREM INDICATION OF LINEARLY DEPENDENT GRADIENTS. * IO INEW INDEX OF THE NEW ACTIVE FUNCTION. * * SUBPROGRAMS USED : * RF MXVDOT DOT PRODUCT OF TWO VECTORS. * SUBROUTINE PLMAXL(NF,NC,CF,CFD,IC,CL,CU,CG,S,STEP,KBC,KREM,INEW) C .. Scalar Arguments .. DOUBLE PRECISION STEP INTEGER INEW,KBC,KREM,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION CF(*),CFD(*),CG(*),CL(*),CU(*),S(*) INTEGER IC(*) C .. C .. Local Scalars .. DOUBLE PRECISION TEMP INTEGER JCG,KC C .. C .. External Functions .. DOUBLE PRECISION MXVDOT EXTERNAL MXVDOT C .. IF (KBC.GT.0) THEN JCG = 1 DO 10 KC = 1,NC IF (KREM.GT.0 .AND. IC(KC).GT.10) IC(KC) = IC(KC) - 10 IF (IC(KC).GT.0 .AND. IC(KC).LE.10) THEN TEMP = MXVDOT(NF,CG(JCG),S) CFD(KC) = TEMP IF (TEMP.LT.0.0D0) THEN IF (IC(KC).EQ.1 .OR. IC(KC).GE.3) THEN TEMP = (CL(KC)-CF(KC))/TEMP IF (TEMP.LE.STEP) THEN INEW = KC STEP = TEMP END IF END IF ELSE IF (TEMP.GT.0.0D0) THEN IF (IC(KC).EQ.2 .OR. IC(KC).GE.3) THEN TEMP = (CU(KC)-CF(KC))/TEMP IF (TEMP.LE.STEP) THEN INEW = KC STEP = TEMP END IF END IF END IF ELSE IF (IC(KC).LT.-10) THEN TEMP = MXVDOT(NF,CG(JCG),S) CFD(KC) = TEMP IF (TEMP.GT.0.0D0) THEN IF (IC(KC).EQ.-11 .OR. IC(KC).EQ.-13 .OR. + IC(KC).EQ.-15) THEN TEMP = (CL(KC)-CF(KC))/TEMP IF (TEMP.LE.STEP) THEN INEW = KC STEP = TEMP END IF END IF ELSE IF (TEMP.LT.0.0D0) THEN IF (IC(KC).EQ.-12 .OR. IC(KC).EQ.-14 .OR. + IC(KC).EQ.-16) THEN TEMP = (CU(KC)-CF(KC))/TEMP IF (TEMP.LE.STEP) THEN INEW = KC STEP = TEMP END IF END IF END IF END IF JCG = JCG + NF 10 CONTINUE END IF RETURN END * SUBROUTINE PLMAXS ALL SYSTEMS 97/12/01 * PORTABILITY : ALL SYSTEMS * 97/12/01 LU : ORIGINAL VERSION * * PURPOSE : * DETERMINATION OF THE MAXIMUM STEPSIZE USING THE SIMPLE BOUNDS * FOR VARIABLES. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * RI X(NF) VECTOR OF VARIABLES. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. * RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * RI S(NF) DIRECTION VECTOR. * RO STEP MAXIMUM STEPSIZE. * II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS. * KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS. * IO KREM INDICATION OF LINEARLY DEPENDENT GRADIENTS. * IO INEW INDEX OF THE NEW ACTIVE CONSTRAINT. * SUBROUTINE PLMAXS(NF,X,IX,XL,XU,S,STEP,KBF,KREM,INEW) C .. Scalar Arguments .. DOUBLE PRECISION STEP INTEGER INEW,KBF,KREM,NF C .. C .. Array Arguments .. DOUBLE PRECISION S(*),X(*),XL(*),XU(*) INTEGER IX(*) C .. C .. Local Scalars .. DOUBLE PRECISION TEMP INTEGER I C .. IF (KBF.GT.0) THEN DO 10 I = 1,NF IF (KREM.GT.0 .AND. IX(I).GT.10) IX(I) = IX(I) - 10 IF (IX(I).GT.0 .AND. IX(I).LE.10) THEN IF (S(I).LT.0.0D0) THEN IF (IX(I).EQ.1 .OR. IX(I).GE.3) THEN TEMP = (XL(I)-X(I))/S(I) IF (TEMP.LE.STEP) THEN INEW = -I STEP = TEMP END IF END IF ELSE IF (S(I).GT.0.0D0) THEN IF (IX(I).EQ.2 .OR. IX(I).GE.3) THEN TEMP = (XU(I)-X(I))/S(I) IF (TEMP.LE.STEP) THEN INEW = -I STEP = TEMP END IF END IF END IF END IF 10 CONTINUE END IF KREM = 0 RETURN END * SUBROUTINE PLNEWL ALL SYSTEMS 97/12/01 * PORTABILITY : ALL SYSTEMS * 97/12/01 LU : ORIGINAL VERSION * * PURPOSE : * TEST ON ACTIVITY OF A GIVEN LINEAR CONSTRAINT. * * PARAMETERS : * II KC INDEX OF A GIVEN CONSTRAINT. * RI CF(NC) VECTOR CONTAINING VALUES OF THE CONSTRAINT FUNCTIONS. * IU IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * RI CL(NC) VECTOR CONTAINING LOWER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CU(NC) VECTOR CONTAINING UPPER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI EPS9 TOLERANCE FOR ACTIVE CONSTRAINTS. * IO INEW INDEX OF THE NEW ACTIVE CONSTRAINT. * SUBROUTINE PLNEWL(KC,CF,IC,CL,CU,EPS9,INEW) C .. Scalar Arguments .. DOUBLE PRECISION EPS9 INTEGER INEW,KC C .. C .. Array Arguments .. DOUBLE PRECISION CF(*),CL(*),CU(*) INTEGER IC(*) C .. C .. Local Scalars .. DOUBLE PRECISION TEMP C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX C .. IF (IC(KC).LT.-10) IC(KC) = -IC(KC) - 10 IF (IC(KC).LE.0) THEN ELSE IF (IC(KC).EQ.1) THEN TEMP = EPS9*MAX(ABS(CL(KC)),1.0D0) IF (CF(KC).GT.CL(KC)+TEMP) THEN ELSE IF (CF(KC).GE.CL(KC)-TEMP) THEN IC(KC) = 11 INEW = KC ELSE IC(KC) = -11 END IF ELSE IF (IC(KC).EQ.2) THEN TEMP = EPS9*MAX(ABS(CU(KC)),1.0D0) IF (CF(KC).LT.CU(KC)-TEMP) THEN ELSE IF (CF(KC).LE.CU(KC)+TEMP) THEN IC(KC) = 12 INEW = KC ELSE IC(KC) = -12 END IF ELSE IF (IC(KC).EQ.3 .OR. IC(KC).EQ.4) THEN TEMP = EPS9*MAX(ABS(CL(KC)),1.0D0) IF (CF(KC).GT.CL(KC)+TEMP) THEN TEMP = EPS9*MAX(ABS(CU(KC)),1.0D0) IF (CF(KC).LT.CU(KC)-TEMP) THEN ELSE IF (CF(KC).LE.CU(KC)+TEMP) THEN IC(KC) = 14 INEW = KC ELSE IC(KC) = -14 END IF ELSE IF (CF(KC).GE.CL(KC)-TEMP) THEN IC(KC) = 13 INEW = KC ELSE IC(KC) = -13 END IF ELSE IF (IC(KC).EQ.5 .OR. IC(KC).EQ.6) THEN TEMP = EPS9*MAX(ABS(CL(KC)),1.0D0) IF (CF(KC).GT.CL(KC)+TEMP) THEN TEMP = EPS9*MAX(ABS(CU(KC)),1.0D0) IF (CF(KC).LT.CU(KC)-TEMP) THEN ELSE IF (CF(KC).LE.CU(KC)+TEMP) THEN IC(KC) = 16 INEW = KC ELSE IC(KC) = -16 END IF ELSE IF (CF(KC).GE.CL(KC)-TEMP) THEN IC(KC) = 15 INEW = KC ELSE IC(KC) = -15 END IF END IF RETURN END * SUBROUTINE PLNEWS ALL SYSTEMS 97/12/01 * PORTABILITY : ALL SYSTEMS * 97/12/01 LU : ORIGINAL VERSION * * PURPOSE : * TEST ON ACTIVITY OF A GIVEN SIMPLE BOUND. * * PARAMETERS : * RI X(NF) VECTOR OF VARIABLES. * IU IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. * RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * RI EPS9 TOLERANCE FOR ACTIVE CONSTRAINTS. * II I INDEX OF TESTED SIMPLE BOUND. * IO INEW INDEX OF THE NEW ACTIVE CONSTRAINT. * SUBROUTINE PLNEWS(X,IX,XL,XU,EPS9,I,INEW) C .. Scalar Arguments .. DOUBLE PRECISION EPS9 INTEGER I,INEW C .. C .. Array Arguments .. DOUBLE PRECISION X(*),XL(*),XU(*) INTEGER IX(*) C .. C .. Local Scalars .. DOUBLE PRECISION TEMP C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX C .. TEMP = 1.0D0 IF (IX(I).LE.0) THEN ELSE IF (IX(I).EQ.1) THEN IF (X(I).LE.XL(I)+EPS9*MAX(ABS(XL(I)),TEMP)) THEN IX(I) = 11 INEW = -I END IF ELSE IF (IX(I).EQ.2) THEN IF (X(I).GE.XU(I)-EPS9*MAX(ABS(XU(I)),TEMP)) THEN IX(I) = 12 INEW = -I END IF ELSE IF (IX(I).EQ.3 .OR. IX(I).EQ.4) THEN IF (X(I).LE.XL(I)+EPS9*MAX(ABS(XL(I)),TEMP)) THEN IX(I) = 13 INEW = -I END IF IF (X(I).GE.XU(I)-EPS9*MAX(ABS(XU(I)),TEMP)) THEN IX(I) = 14 INEW = -I END IF END IF RETURN END * SUBROUTINE PLRMB0 ALL SYSTEMS 92/12/01 * PORTABILITY : ALL SYSTEMS * 92/12/01 LU : ORIGINAL VERSION * * PURPOSE : * OLD LINEAR CONSTRAINT OR AN OLD SIMPLE BOUND IS REMOVED FROM THE * ACTIVE SET. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II N ACTUAL NUMBER OF VARIABLES. * II ICA(NF) VECTOR CONTAINING INDICES OF ACTIVE CONSTRAINTS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RU CR(NF*(NF+1)/2) TRIANGULAR DECOMPOSITION OF KERNEL OF THE * ORTHOGONAL PROJECTION. * RU CZ(NF*NF) MATRIX WHOSE COLUMNS ARE BASIC VECTORS FROM THE * CURRENT REDUCED SUBSPACE. * RI G(NF) GRADIENT OF THE OBJECTIVE FUNCTION. * RU GN(NF) TRANSFORMED GRADIENT OF THE OBJECTIVE FUNCTION. * II IOLD INDEX OF THE OLD ACTIVE CONSTRAINT. * IO KREM AUXILIARY VARIABLE. * IU NREM NUMBER OF CONSTRAINT DELETION. * IO IER ERROR INDICATOR. * * SUBPROGRAMS USED : * S PLRMR0 CORRECTION OF KERNEL OF THE ORTHOGONAL PROJECTION * AFTER CONSTRAINT DELETION. * S MXDPRB BACK SUBSTITUTION. * S MXVCOP COPYING OF A VECTOR. * S MXVDIR VECTOR AUGMENTED BY THE SCALED VECTOR. * RF MXVDOT DOT PRODUCT OF TWO VECTORS. * S MXVMUL DIAGONAL PREMULTIPLICATION OF A VECTOR. * S MXVSET INITIATION OF A VECTOR. * SUBROUTINE PLRMB0(NF,N,ICA,CG,CR,CZ,G,GN,IOLD,KREM,NREM,IER) C .. Scalar Arguments .. INTEGER IER,IOLD,KREM,N,NF,NREM C .. C .. Array Arguments .. DOUBLE PRECISION CG(*),CR(*),CZ(*),G(*),GN(*) INTEGER ICA(*) C .. C .. Local Scalars .. INTEGER I,J,KC,NCA,NCR,NCZ C .. C .. External Functions .. DOUBLE PRECISION MXVDOT EXTERNAL MXVDOT C .. C .. External Subroutines .. EXTERNAL MXDPRB,MXVCOP,MXVDIR,MXVSET,PLRMR0 C .. IER = 0 IF (N.EQ.NF) IER = 2 IF (IOLD.EQ.0) IER = 3 IF (IER.NE.0) RETURN NCA = NF - N NCR = NCA* (NCA-1)/2 NCZ = N*NF CALL PLRMR0(NF,ICA,CR,CZ(NCZ+1),N,IOLD,KREM,IER) CALL MXVSET(NCA,0.0D0,CZ(NCZ+1)) CZ(NCZ+NCA) = 1.0D0 CALL MXDPRB(NCA,CR,CZ(NCZ+1),-1) CALL MXVCOP(NCA,CZ(NCZ+1),CR(NCR+1)) N = N + 1 CALL MXVSET(NF,0.0D0,CZ(NCZ+1)) DO 10 J = 1,NCA KC = ICA(J) IF (KC.GT.0) THEN CALL MXVDIR(NF,CR(NCR+J),CG((KC-1)*NF+1),CZ(NCZ+1), + CZ(NCZ+1)) ELSE I = -KC CZ(NCZ+I) = CZ(NCZ+I) + CR(NCR+J) END IF 10 CONTINUE GN(N) = MXVDOT(NF,CZ(NCZ+1),G) NREM = NREM + 1 IER = 0 RETURN END * SUBROUTINE PLSETC ALL SYSTEMS 97/12/01 * PORTABILITY : ALL SYSTEMS * 97/12/01 LU : ORIGINAL VERSION * * PURPOSE : * DETERMINATION OF INITIAL VALUES OF THE CONSTRAINT FUNCTIONS. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * II NC NUMBER OF CURRENT LINEAR CONSTRAINTS. * RI X(NF) VECTOR OF VARIABLES. * RI XO(NF) SAVED VECTOR OF VARIABLES. * RU CF(NF) VECTOR CONTAINING VALUES OF THE CONSTRAINT FUNCYIONS. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * RI CG(NF*MCL) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RA S(NF) AUXILIARY VECTOR. * * SUBPROGRAMS USED : * S MXVDIF DIFFERENCE OF TWO VECTORS. * RF MXVDOT DOT PRODUCT OF TWO VECTORS. * S MXVMUL DIAGONAL PREMULTIPLICATION OF A VECTOR. * SUBROUTINE PLSETC(NF,NC,X,XO,CF,IC,CG,S) C .. Scalar Arguments .. INTEGER NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION CF(*),CG(*),S(*),X(*),XO(*) INTEGER IC(*) C .. C .. Local Scalars .. INTEGER JCG,KC C .. C .. External Functions .. DOUBLE PRECISION MXVDOT EXTERNAL MXVDOT C .. C .. External Subroutines .. EXTERNAL MXVDIF C .. CALL MXVDIF(NF,X,XO,S) JCG = 0 DO 10 KC = 1,NC IF (IC(KC).NE.0) CF(KC) = CF(KC) + MXVDOT(NF,S,CG(JCG+1)) JCG = JCG + NF 10 CONTINUE RETURN END * SUBROUTINE PLSETG ALL SYSTEMS 97/12/01 * PORTABILITY : ALL SYSTEMS * 97/12/01 LU : ORIGINAL VERSION * * PURPOSE : * GRADIENT DETERMINATION IN THE FIRST PHASE OF LP SUBROUTINE. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II NC NUMBER OF CONSTRAINTS. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RO G(NF) GRADIENT OF THE OBJECTIVE FUNCTION. * IO INEW INDEX OF THE NEW ACTIVE CONSTRAINT. * * SUBPROGRAMS USED : * S MXVDIR VECTOR AUGMENTED BY THE SCALED VECTOR. * S MXVSET INITIATION OF A VECTOR. * SUBROUTINE PLSETG(NF,NC,IC,CG,G,INEW) C .. Scalar Arguments .. INTEGER INEW,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION CG(*),G(*) INTEGER IC(*) C .. C .. Local Scalars .. INTEGER KC C .. C .. External Subroutines .. EXTERNAL MXVDIR,MXVSET C .. CALL MXVSET(NF,0.0D0,G) INEW = 0 DO 10 KC = 1,NC IF (IC(KC).GE.-10) THEN ELSE IF (IC(KC).EQ.-11 .OR. IC(KC).EQ.-13 .OR. + IC(KC).EQ.-15) THEN CALL MXVDIR(NF,-1.0D0,CG((KC-1)*NF+1),G,G) INEW = 1 ELSE IF (IC(KC).EQ.-12 .OR. IC(KC).EQ.-14 .OR. + IC(KC).EQ.-16) THEN CALL MXVDIR(NF,1.0D0,CG((KC-1)*NF+1),G,G) INEW = 1 END IF 10 CONTINUE RETURN END * SUBROUTINE PLGLAG ALL SYSTEMS 97/12/01 * PORTABILITY : ALL SYSTEMS * 97/12/01 LU : ORIGINAL VERSION * * PURPOSE : * GRADIENT OF THE LAGRANGIAN FUNCTION IS DETERMINED. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II N ACTUAL NUMBER OF VARIABLES. * II NC NUMBER OF LINEARIZED CONSTRAINTS. * II IAA(NF+1) VECTOR CONTAINING INDICES OF ACTIVE FUNCTIONS. * RI AG(NF*NC) MATRIX WHOSE COLUMNS ARE GRADIENTS OF THE LINEAR * APPROXIMATED FUNCTIONS. * RO AZ(NF+1) VECTOR OF LAGRANGE MPLTIPLIERS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RU G(NF) GRADIENT OF THE LAGRANGIAN FUNCTION. * * SUBPROGRAMS USED : * S MXVDIR VECTOR AUGMENTED BY THE SCALED VECTOR. * SUBROUTINE PLGLAG(NF,N,NC,IAA,AG,AZ,CG,G) C .. Scalar Arguments .. INTEGER N,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION AG(*),AZ(*),CG(*),G(*) INTEGER IAA(*) C .. C .. Local Scalars .. INTEGER J,L,NAA C .. C .. External Subroutines .. EXTERNAL MXVDIR C .. NAA = NF - N DO 10 J = 1,NAA L = IAA(J) IF (L.GT.NC) THEN L = L - NC CALL MXVDIR(NF,-AZ(J),AG((L-1)*NF+1),G,G) ELSE IF (L.GT.0) THEN CALL MXVDIR(NF,-AZ(J),CG((L-1)*NF+1),G,G) ELSE L = -L G(L) = G(L) - AZ(J) END IF 10 CONTINUE RETURN END * SUBROUTINE PLSLAG ALL SYSTEMS 97/12/01 * PORTABILITY : ALL SYSTEMS * 97/12/01 LU : ORIGINAL VERSION * * PURPOSE : * NEGATIVE PROJECTED GRADIENT IS DETERMINED USING LAGRANGE MULTIPLIERS. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II N ACTUAL NUMBER OF VARIABLES. * II NC NUMBER OF LINEARIZED CONSTRAINTS. * II IAA(NF+1) VECTOR CONTAINING INDICES OF ACTIVE FUNCTIONS. * RI AG(NF*NC) MATRIX WHOSE COLUMNS ARE GRADIENTS OF THE LINEAR * APPROXIMATED FUNCTIONS. * RO AZ(NF+1) VECTOR OF LAGRANGE MULTIPLIERS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RO S(NF) NEGATIVE PROJECTED GRADIENT OF THE QUADRATIC FUNCTION. * RI EPS7 TOLERANCE FOR LINEAR AND QUADRATIC PROGRAMMING. * RO GMAX NORM OF THE TRANSFORMED GRADIENT. * * SUBPROGRAMS USED : * S UXVDIR VECTOR AUGMENTED BY THE SCALED VECTOR. * RF UXVMAX L-INFINITY NORM OF A VECTOR. * SUBROUTINE PLSLAG(NF,N,NC,IAA,AG,AZ,CG,S,EPS7,GMAX) C .. Scalar Arguments .. DOUBLE PRECISION EPS7,GMAX INTEGER N,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION AG(*),AZ(*),CG(*),S(*) INTEGER IAA(*) C .. C .. Local Scalars .. INTEGER J,L,NAA C .. C .. External Functions .. DOUBLE PRECISION MXVMAX EXTERNAL MXVMAX C .. C .. External Subroutines .. EXTERNAL MXVDIR C .. NAA = NF - N DO 10 J = 1,NAA L = IAA(J) IF (L.GT.NC) THEN L = L - NC CALL MXVDIR(NF,AZ(J),AG((L-1)*NF+1),S,S) ELSE IF (L.GT.0) THEN CALL MXVDIR(NF,AZ(J),CG((L-1)*NF+1),S,S) ELSE L = -L S(L) = S(L) + AZ(J) END IF 10 CONTINUE GMAX = MXVMAX(NF,S) IF (GMAX.LE.EPS7) GMAX = 0.0D0 RETURN END * SUBROUTINE PLTLAG ALL SYSTEMS 97/12/01 * PORTABILITY : ALL SYSTEMS * 97/12/01 LU : ORIGINAL VERSION * * PURPOSE : * MAXIMUM ABSOLUTE VALUE OF THE NEGATIVE LAGRANGE MULTIPLIER IS * COMPUTED. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II N ACTUAL NUMBER OF VARIABLES. * II NC NUMBER OF LINEARIZED CONSTRAINTS. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. * II IA(NA) VECTOR CONTAINING TYPES OF DEVIATIONS. * II IAA(NF+1) VECTOR CONTAINING INDICES OF ACTIVE FUNCTIONS. * RI AZ(NF+1) VECTOR OF LAGRANGE MULTIPLIERS. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * RI EPS7 TOLERANCE FOR LINEAR AND QUADRATIC PROGRAMMING. * RO UMAX MAXIMUM ABSOLUTE VALUE OF THE NEGATIVE LAGRANGE MULTIPLIER. * IO IOLD INDEX OF THE REMOVED CONSTRAINT. * SUBROUTINE PLTLAG(NF,N,NC,IX,IA,IAA,AZ,IC,EPS7,UMAX,IOLD) C .. Scalar Arguments .. DOUBLE PRECISION EPS7,UMAX INTEGER IOLD,N,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION AZ(*) INTEGER IA(*),IAA(*),IC(*),IX(*) C .. C .. Local Scalars .. DOUBLE PRECISION TEMP INTEGER J,K,L,NAA C .. C .. Intrinsic Functions .. INTRINSIC ABS C .. IOLD = 0 UMAX = 0.0D0 NAA = NF - N DO 10 J = 1,NAA TEMP = AZ(J) L = IAA(J) IF (L.GT.NC) THEN L = L - NC K = IA(L) ELSE IF (L.GT.0) THEN K = IC(L) ELSE L = -L K = IX(L) END IF IF (K.LE.-5) THEN ELSE IF ((K.EQ.-1.OR.K.EQ.-3) .AND. UMAX+TEMP.GE.0.0D0) THEN ELSE IF ((K.EQ.-2.OR.K.EQ.-4) .AND. UMAX-TEMP.GE.0.0D0) THEN ELSE IOLD = J UMAX = ABS(TEMP) END IF 10 CONTINUE IF (UMAX.LE.EPS7) IOLD = 0 RETURN END * SUBROUTINE PLTRBG ALL SYSTEMS 97/12/01 * PORTABILITY : ALL SYSTEMS * 97/12/01 LU : ORIGINAL VERSION * * PURPOSE : * GRADIENT OF THE OBJECTIVE FUNCTION IS SCALED AND REDUCED. LAGRANGE * MULTIPLIERS ARE DETERMINED. TEST VALUES GMAX AND UMAX ARE COMPUTED. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II N ACTUAL NUMBER OF VARIABLES. * II NC NUMBER OF CURRENT LINEAR CONSTRAINTS. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * II ICA(NF) VECTOR CONTAINING INDICES OF ACTIVE CONSTRAINTS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RI CR(NF*(NF+1)/2) TRIANGULAR DECOMPOSITION OF KERNEL OF THE * ORTHOGONAL PROJECTION. * RU CZ(NF*NF) MATRIX WHOSE COLUMNS ARE BASIC VECTORS FROM THE * CURRENT REDUCED SUBSPACE. VECTOR CZ(1,NF) CONTAINS LAGRANGE * MULTIPLIERS BEING DETERMINED. * RI G(NF) GRADIENT OF THE OBJECTIVE FUNCTION. * RO GN(NF) TRANSFORMED GRADIENT OF THE OBJECTIVE FUNCTION IF IT IS * NONZERO. * RI EPS7 TOLERANCE FOR LINEAR AND QUADRATIC PROGRAMMING. * RO GMAX NORM OF THE TRANSFORMED GRADIENT. * RO UMAX MAXIMUM ABSOLUTE VALUE OF THE NEGATIVE LAGRANGE MULTIPLIER. * IO IOLD INDEX OF THE REMOVED CONSTRAINT. * * SUBPROGRAMS USED : * S PLVLAG GRADIENT IS PREMULTIPLIED BY THE MATRIX WHOSE COLUMNS * ARE NORMALS OF THE ACTIVE CONSTRAINTS. * S PLTLAG COMPUTATION OF THE MAXIMUM ABSOLUTE VALUE OF THE NEGATIVE * LAGRANGE MULTIPLIER. * S MXDRMM PREMULTIPLICATION OF A VECTOR BY A ROWWISE STORED DENSE * RECTANGULAR MATRIX. * S MXDPRB BACK SUBSTITUTION AFTER A CHOLESKI DECOMPOSITION. * RF MXVMAX L-INFINITY NORM OF A VECTOR. * S MXVSET INITIATION OF A VECTOR. * SUBROUTINE PLTRBG(NF,N,NC,IX,IC,ICA,CG,CR,CZ,G,GN,EPS7,GMAX,UMAX, + IOLD) C .. Scalar Arguments .. DOUBLE PRECISION EPS7,GMAX,UMAX INTEGER IOLD,N,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION CG(*),CR(*),CZ(*),G(*),GN(*) INTEGER IC(*),ICA(*),IX(*) C .. C .. Local Scalars .. INTEGER NCA,NCZ C .. C .. External Functions .. DOUBLE PRECISION MXVMAX EXTERNAL MXVMAX C .. C .. External Subroutines .. EXTERNAL MXDPRB,MXDRMM,MXVSET,PLTLAG,PLVLAG C .. GMAX = 0.0D0 IF (N.GT.0) THEN CALL MXDRMM(NF,N,CZ,G,GN) GMAX = MXVMAX(N,GN) END IF IF (NF.GT.N .AND. GMAX.LE.EPS7) THEN NCA = NF - N NCZ = N*NF CALL PLVLAG(NF,N,NC,ICA,CG,CG,G,CZ(NCZ+1)) CALL MXDPRB(NCA,CR,CZ(NCZ+1),0) CALL PLTLAG(NF,N,NC,IX,IC,ICA,CZ(NCZ+1),IC,EPS7,UMAX,IOLD) IF (UMAX.LE.EPS7) IOLD = 0 CALL MXVSET(N,0.0D0,GN) GMAX = 0.0D0 ELSE IOLD = 0 UMAX = 0.0D0 END IF RETURN END * SUBROUTINE PLVLAG ALL SYSTEMS 97/12/01 * PORTABILITY : ALL SYSTEMS * 97/12/01 LU : ORIGINAL VERSION * * PURPOSE : * GRADIENT OF THE OBJECTIVE FUNCTION IS PREMULTIPLIED BY TRANSPOSE * OF THE MATRIX WHOSE COLUMNS ARE NORMALS OF CURRENT ACTIVE CONSTRAINTS * AND GRADIENTS OF CURRENT ACTIVE FUNCTIONS. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II N ACTUAL NUMBER OF VARIABLES. * II NC NUMBER OF LINEARIZED CONSTRAINTS. * II IAA(NF+1) VECTOR CONTAINING INDICES OF ACTIVE FUNCTIONS. * RI AG(NF*NA) VECTOR CONTAINING SCALING PARAMETERS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RI G(NF) GRADIENT OF THE OBJECTIVE FUNCTION. * RO GN(NF+1) OUTPUT VECTOR. * * SUBPROGRAMS USED : * RF MXVDOT DOT PRODUCT OF TWO VECTORS. * SUBROUTINE PLVLAG(NF,N,NC,IAA,AG,CG,G,GN) C .. Scalar Arguments .. INTEGER N,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION AG(*),CG(*),G(*),GN(*) INTEGER IAA(*) C .. C .. Local Scalars .. INTEGER J,L,NAA C .. C .. External Functions .. DOUBLE PRECISION MXVDOT EXTERNAL MXVDOT C .. NAA = NF - N DO 10 J = 1,NAA L = IAA(J) IF (L.GT.NC) THEN L = L - NC GN(J) = MXVDOT(NF,AG((L-1)*NF+1),G) ELSE IF (L.GT.0) THEN GN(J) = MXVDOT(NF,CG((L-1)*NF+1),G) ELSE L = -L GN(J) = G(L) END IF 10 CONTINUE RETURN END * SUBROUTINE PUDBG1 ALL SYSTEMS 92/12/01 * PORTABILITY : ALL SYSTEMS * 92/12/01 LU : ORIGINAL VERSION * * PURPOSE : * VARIABLE METRIC UPDATE OF A DENSE SYMMETRIC POSITIVE DEFINITE MATRIX * USING THE FACTORIZATION B=L*D*TRANS(L). * * PARAMETERS : * II N ACTUAL NUMBER OF VARIABLES. * RU H(M) FACTORIZATION B=L*D*TRANS(L) OF A POSITIVE * DEFINITE APPROXIMATION OF THE HESSIAN MATRIX. * RI G(NF) GRADIENT OF THE OBJECTIVE FUNCTION. * RA S(NF) AUXILIARY VECTOR. * RU XO(NF) VECTORS OF VARIABLES DIFFERENCE. * RI GO(NF) GRADIENTS DIFFERENCE. * RI R VALUE OF THE STEPSIZE PARAMETER. * RI PO OLD VALUE OF THE DIRECTIONAL DERIVATIVE. * II NIT ACTUAL NUMBER OF ITERATIONS. * II KIT NUMBER OF THE ITERATION AFTER LAST RESTART. * IO ITERH TERMINATION INDICATOR. ITERH<0-BAD DECOMPOSITION. * ITERH=0-SUCCESSFUL UPDATE. ITERH>0-NONPOSITIVE PARAMETERS. * II MET SELECTION OF SELF SCALING. MET=1-SELF SCALING SUPPRESSED. * MET=2 INITIAL SELF SCALING. * II MOD CORRECTION IF THE NEGATIVE CURVATURE OCCURS. * MOD=1-CORRECTION SUPPRESSED. MOD=2-POWELL'S CORRECTION. * * SUBPROGRAMS USED : * S MXDPGU CORRECTION OF A DENSE SYMMETRIC POSITIVE DEFINITE * MATRIX IN THE FACTORED FORM B=L*D*TRANS(L). * S MXDPGS SCALING OF A DENSE SYMMETRIC POSITIVE DEFINITE MATRIX * IN THE FACTORED FORM B=L*D*TRANS(L). * S MXVDIF DIFFERENCE OF TWO VECTORS. * RF MXVDOT DOT PRODUCT OF VECTORS. * S MXVSCL SCALING OF A VECTOR. * * METHOD : * BFGS VARIABLE METRIC METHOD. * SUBROUTINE PUDBG1(N,H,G,S,XO,GO,R,PO,NIT,KIT,ITERH,MET,MOD) C .. Scalar Arguments .. DOUBLE PRECISION PO,R INTEGER ITERH,KIT,MET,MOD,N,NIT C .. C .. Array Arguments .. DOUBLE PRECISION G(*),GO(*),H(*),S(*),XO(*) C .. C .. Local Scalars .. DOUBLE PRECISION A,B,C,DIS,GAM,PAR LOGICAL L1,L3 C .. C .. External Functions .. DOUBLE PRECISION MXDPGP,MXVDOT EXTERNAL MXDPGP,MXVDOT C .. C .. External Subroutines .. EXTERNAL MXDPGB,MXDPGS,MXDPGU,MXVCOP,MXVDIF,MXVDIR,MXVSCL C .. L1 = MET .GE. 3 .OR. MET .EQ. 2 .AND. NIT .EQ. KIT L3 = .NOT. L1 * * DETERMINATION OF THE PARAMETERS B, C * B = MXVDOT(N,XO,GO) A = 0.0D0 IF (L1) THEN CALL MXVCOP(N,GO,S) CALL MXDPGB(N,H,S,1) A = MXDPGP(N,H,S,S) IF (A.LE.0.0D0) THEN ITERH = 1 RETURN END IF END IF CALL MXVDIF(N,GO,G,S) CALL MXVSCL(N,R,S,S) C = -R*PO IF (C.LE.0.0D0) THEN ITERH = 3 RETURN END IF IF (MOD.GT.1) THEN IF (B.LE.1.0D-4*C) THEN * * POWELL'S CORRECTION * DIS = (1.0D0-0.1D0)*C/ (C-B) CALL MXVDIF(N,GO,S,GO) CALL MXVDIR(N,DIS,GO,S,GO) B = C + DIS* (B-C) IF (L1) A = C + 2.0D0* (1.0D0-DIS)* (B-C) + DIS*DIS* (A-C) END IF ELSE IF (B.LE.1.0D-4*C) THEN ITERH = 2 RETURN END IF END IF IF (L1) THEN * * DETERMINATION OF THE PARAMETER GAM (SELF SCALING) * PAR = C/B GAM = PAR IF (MET.GT.1) THEN IF (NIT.NE.KIT) THEN L3 = GAM .LT. 0.5D0 .OR. GAM .GT. 4.0D0 END IF END IF END IF IF (L3) THEN GAM = 1.0D0 PAR = GAM END IF * * BFGS UPDATE * CALL MXDPGU(N,H,PAR/B,GO,XO) CALL MXDPGU(N,H,-1.0D0/C,S,XO) ITERH = 0 IF (GAM.EQ.1.0D0) RETURN CALL MXDPGS(N,H,1.0D0/GAM) RETURN END * SUBROUTINE PUDVI2 ALL SYSTEMS 99/12/01 * PORTABILITY : ALL SYSTEMS * 99/12/01 VL : ORIGINAL VERSION * * PURPOSE : * NONSMOOTH VARIABLE METRIC UPDATE OF THE INVERSE HESSIAN MATRIX. * * PARAMETERS : * II N ACTUAL NUMBER OF VARIABLES. * RU H(N*(N+1)/2) POSITIVE DEFINITE APPROXIMATION OF THE INVERSE * HESSIAN MATRIX. * RI S(N) DIRECTION VECTOR. * RI GV(N) AGGREGATED SUBGRADIENT OF THE OBJECTIVE FUNCTION. * RU U(N) DIFFERENCE OF CURRENT AND PREVIOUS GRADIENTS. * RA V(N) AUXILIARY VECTOR. * RI T VALUE OF THE STEPSIZE PARAMETER. * RI Z DOT PRODUCT OF VECTORS S, U. * RI RO CORRECTION PARAMETER. * II JC CORRECTION INDICATOR. * II JU UPDATING INDICATOR. * II NNK CONSECUTIVE NULL STEPS COUNTER. * II JOB TYPE OF MINIMIZATION. JOB=0 - CONVEX MINIMIZATION. * JOB=1 - NONCONVEX MINIMIZATION. * * COMMON DATA : * * SUBPROGRAMS USED : * S MXDSMM MULTIPLICATION OF A DENSE SYMMETRIC MATRIX BY A VECTOR. * S MXDSMU UPDATE OF A DENSE SYMMETRIC MATRIX. * S MXVDIR VECTOR AUGMENTED BY THE SCALED VECTOR. * RF MXVDEL SQUARED NORM OF A SHIFTED VECTOR. * RF MXVDOT DOT PRODUCT OF VECTORS. * S MXVLIN LINEAR COMBINATION OF TWO VECTORS. * SUBROUTINE PUDVI2(N,H,S,GV,U,V,Z,RO,JC,JU,NNK,JOB,NIT) C .. Scalar Arguments .. DOUBLE PRECISION RO,Z INTEGER JC,JOB,JU,N,NIT,NNK C .. C .. Array Arguments .. DOUBLE PRECISION GV(*),H(*),S(*),U(*),V(*) C .. C .. Local Scalars .. DOUBLE PRECISION GAM,P,P1,P2,P3,Q,W INTEGER I,J,L LOGICAL LB,LR C .. C .. External Functions .. DOUBLE PRECISION MXVDEL,MXVDOT EXTERNAL MXVDEL,MXVDOT C .. C .. External Subroutines .. EXTERNAL MXDSMM,MXDSMU,MXVDIF,MXVLIN C .. C .. Intrinsic Functions .. INTRINSIC MAX,MIN C .. IF (JOB.GT.0) JU = 0 IF (Z.LE.0.0D0) RETURN CALL MXDSMM(N,H,U,V) W = MXVDOT(N,U,V) GAM = 1.0D0 IF (NIT.EQ.1) THEN Q = 1.0D0 IF (W.NE.0.0D0) Q = Z/W IF ((Q-2.5D-1)* (Q-3.0D0).GT.0.0D0) GAM = MIN(3.0D0, + MAX(2.0D-2,Q)) END IF P1 = MXVDEL(N,-1.0D0,S,V) P2 = MXVDOT(N,GV,V) - MXVDOT(N,GV,S) P3 = MXVDOT(N,GV,GV) P = W - Z LB = NNK .EQ. 0 LR = NNK .NE. 0 .AND. P2 .LT. 0.0D0 IF (JC.EQ.1 .AND. (P1.LT.RO*P*N.OR.P2*P2.LT.RO*P*P3)) LR = .FALSE. IF (LB) THEN CALL MXVLIN(N,1.0D0/Z,V,-0.5D0* (1.0D0/GAM+W/Z)/Z,S,U) L = 1 IF (JOB.GT.0) JU = 1 DO 20 I = 1,N DO 10 J = 1,I H(L) = (H(L)-U(I)*S(J)-S(I)*U(J))*GAM L = L + 1 10 CONTINUE 20 CONTINUE ELSE IF (LR) THEN CALL MXVDIF(N,V,S,U) JU = 1 CALL MXDSMU(N,H,-1.0D0/P,U) END IF RETURN END * SUBROUTINE PS0LA2 ALL SYSTEMS 94/12/01 * PORTABILITY : ALL SYSTEMS * 94/12/01 LU : ORIGINAL VERSION * * PURPOSE : * EXTENDED LINE SEARCH WITHOUT DIRECTIONAL DERIVATIVES. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II NA NUMBER OF APPROXIMATED FUNCTIONS. * RU X(NF) VECTOR OF VARIABLES. * RI XO(NF) OLD VECTOR OF VARIABLES. * RI S(NF) DIRECTION VECTOR. * RO R VALUE OF THE STEPSIZE PARAMETER. * RO RO PREVIOUS VALUE OF THE STEPSIZE PARAMETER. * RO F VALUE OF THE OBJECTIVE FUNCTION. * RI FO INITIAL VALUE OF THE OBJECTIVE FUNCTION. * RI PO INITIAL VALUE OF THE DIRECTIONAL DERIVATIVE. * RI RMIN MINIMUM VALUE OF THE STEPSIZE PARAMETER. * RI RMAX MAXIMUM VALUE OF THE STEPSIZE PARAMETER. * RI FMIN LOWER BOUND FOR VALUE OF THE OBJECTIVE FUNCTION. * RI FMAX UPPER BOUND FOR VALUE OF THE OBJECTIVE FUNCTION. * RA FA VALUE OF THE APPROXIMATED FUNCTION. * RO AF(NA) VECTOR WHOSE ELEMENTS ARE VALUES OF THE * APPROXIMATED FUNCTIONS. * RA GA(NF) GRADIENT OF THE APPROXIMATED FUNCTION. * RO AG(NF*NA) MATRIX WHOSE COLUMNS ARE GRADIENTS OF THE * APPROXIMATED FUNCTIONS. * RO G(NF) GRADIENT OF THE OBJECTIVE FUNCTION. * II KD DEGREE OF REQUIRED DERVATIVES. * IU LD DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES. * II IEXT TYPE OF OBJECTIVE FUNCTION. IEXT<0-MAXIMUM OF POSITIVE * VALUES. IEXT=0-MAXIMUM OF ABSOLUTE VALUES. IEXT>0-MAXIMUM * OF NEGATIVE VALUES. * II NIT ACTUAL NUMBER OF ITERATIONS. * II KIT NUMBER OF THE ITERATION AFTER LAST RESTART. * RI TOLS TERMINATION TOLERANCE FOR LINE SEARCH (IN TEST ON THE * CHANGE OF THE FUNCTION VALUE). * II MES METHOD SELECTION. MES=1-BISECTION. MES=2-TWO POINT * QUADRATIC INTERPOLATION. MES=3-THREE POINT QUADRATIC * INTERPOLATION. * IO NRED ACTUAL NUMBER OF EXTRAPOLATIONS OR INTERPOLATIONS. * II MRED MAXIMUM NUMBER OF EXTRAPOLATIONS OR INTERPOLATIONS. * IO ITERS TERMINATION INDICATOR. ITERS=0-ZERO STEP. ITERS=1-PERFECT * LINE SEARCH. ITERS=2 GOLDSTEIN STEPSIZE. ITERS=3-CURRY * STEPSIZE. ITERS=4-EXTENDED CURRY STEPSIZE. * ITERS=5-ARMIJO STEPSIZE. ITERS=6-FIRST STEPSIZE. * ITERS=7-MAXIMUM STEPSIZE. ITERS=8-UNBOUNDED FUNCTION. * ITERS=-1-MRED REACHED. ITERS=-2-POSITIVE DIRECTIONAL * DERIVATIVE. ITERS=-3-ERROR IN INTERPOLATION. * * SUBPROGRAM USED : * S UA1MX2 COMPUTATION OF THE VALUE AND THE GRADIENT OF THE * OBJECTIVE FUNCTION WHICH IS DEFINED AS A MAXIMUM OF THE * APPROXIMATED FUNCTIONS. * S PNINT3 EXTRAPOLATION OR INTERPOLATION WITHOUT DIRECTIONAL * DERIVATIVES. * S MXVDIR VECTOR AUGMENTED BY THE SCALED VECTOR. * * METHOD : * SAFEGUARDED EXTRAPOLATION AND INTERPOLATION WITH EXTENDED TERMINATION * CRITERIA. * SUBROUTINE PS0LA2(NF,NA,X,XO,S,R,RO,F,FO,PO,RMIN,RMAX,FMIN,FMAX, + FA,AF,GA,AG,G,KD,LD,IEXT,NIT,KIT,TOLS,MES,NRED, + MRED,ITERS) C .. Scalar Arguments .. DOUBLE PRECISION F,FA,FMAX,FMIN,FO,PO,R,RMAX,RMIN,RO,TOLS INTEGER IEXT,ITERS,KD,KIT,LD,MES,MRED,NA,NF,NIT,NRED C .. C .. Array Arguments .. DOUBLE PRECISION AF(*),AG(*),G(*),GA(*),S(*),X(*),XO(*) C .. C .. Local Scalars .. DOUBLE PRECISION FI,FL,FU,RI,RL,RU INTEGER MERR,MODE,MTYP LOGICAL L1,L2,L3 C .. C .. External Subroutines .. EXTERNAL MXVDIR,PA1MX2,PNINT3 C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX,MIN C .. IF (PO.GE.0.0D0) THEN R = 0.0D0 ITERS = -2 RETURN END IF IF (RMAX.LE.0.0D0) THEN ITERS = 0 RETURN END IF * * INITIAL STEPSIZE SELECTION * R = 1.0D0 R = MAX(R,RMIN) R = MIN(R,RMAX) MODE = 0 RU = 0.0D0 FU = FO RI = 0.0D0 FI = FO * * NEW STEPSIZE SELECTION (EXTRAPOLATION OR INTERPOLATION) * 10 CALL PNINT3(RO,RL,RU,RI,FO,FL,FU,FI,PO,R,MODE,MTYP,MERR) IF (MERR.GT.0) THEN ITERS = -MERR RETURN ELSE IF (MODE.EQ.1) THEN NRED = NRED - 1 R = MIN(R,RMAX) ELSE IF (MODE.EQ.2) THEN NRED = NRED + 1 END IF * * COMPUTATION OF THE NEW FUNCTION VALUE * KD = 0 LD = -1 CALL MXVDIR(NF,R,S,XO,X) CALL PA1MX2(NF,NA,X,F,FA,AF,GA,AG,G,KD,LD,IEXT) KD = 1 IF (F.LE.FMIN) THEN ITERS = 7 RETURN ELSE L1 = R .LE. RMIN .AND. NIT .NE. KIT L2 = R .GE. RMAX L3 = F - FO .LE. TOLS*R*PO .OR. F - FMIN .LE. (FO-FMIN)/1.0D1 END IF * * TEST ON TERMINATION * IF (L1 .AND. .NOT.L3) THEN ITERS = 0 RETURN ELSE IF (L2 .AND. .NOT.F.GE.FU) THEN ITERS = 7 RETURN ELSE IF (L3) THEN ITERS = 5 RETURN ELSE IF (ABS(NRED).GE.MRED) THEN ITERS = -1 RETURN ELSE MODE = MAX(MODE,1) MTYP = ABS(MES) IF (F.GE.FMAX) MTYP = 1 END IF IF (MODE.EQ.1) THEN * * INTERVAL CHANGE AFTER EXTRAPOLATION * RL = RI FL = FI RI = RU FI = FU RU = R FU = F IF (F.GE.FI) THEN NRED = 0 MODE = 2 END IF * * INTERVAL CHANGE AFTER INTERPOLATION * ELSE IF (R.LE.RI) THEN IF (F.LE.FI) THEN RU = RI FU = FI RI = R FI = F ELSE RL = R FL = F END IF ELSE IF (F.LE.FI) THEN RL = RI FL = FI RI = R FI = F ELSE RU = R FU = F END IF END IF GO TO 10 END * SUBROUTINE PS1L05 ALL SYSTEMS 94/12/01 * PORTABILITY : ALL SYSTEMS * 94/12/01 VL : ORIGINAL VERSION * * PURPOSE : * SPECIAL LINE SEARCH WITH DIRECTIONAL DERIVATIVES FOR BUNDLE METHODS. * * PARAMETERS : * II NF NUMBER OF VARIABLES. * RU X(NF) VECTOR OF VARIABLES. * RI XO(NF) OLD VECTOR OF VARIABLES. * RU S(NF+1) DIRECTION VECTOR. * RO R VALUE OF THE STEPSIZE PARAMETER. * RO RP PREVIOUS VALUE OF THE STEPSIZE PARAMETER. * RO F VALUE OF THE OBJECTIVE FUNCTION. * RI FO PREVIOUS VALUE OF THE OBJECTIVE FUNCTION. * RU FP CURRENT MINIMUM VALUE OF THE OBJECTIVE FUNCTION. * RO P VALUE OF THE DIRECTIONAL DERIVATIVE. * RI PO INITIAL VALUE OF THE DIRECTIONAL DERIVATIVE. * RO PP PREVIOUS VALUE OF THE DIRECTIONAL DERIVATIVE. * RU TO WEIGHT PARAMETER * RU G(NF+1) SUBGRADIENT OF THE OBJECTIVE FUNCTION. * RO SNORM NORM OF THE DIRECTION VECTOR. * RI RMIN MINIMUM VALUE OF THE STEPSIZE PARAMETER * RI RMAX MAXIMUM VALUE OF THE STEPSIZE PARAMETER * RI FMIN LOWER BOUND FOR VALUE OF THE OBJECTIVE FUNCTION. * RI FMAX UPPER BOUND FOR VALUE OF THE OBJECTIVE FUNCTION. * RI TOLS LINE SEARCH PARAMETER (IN TEST ON THE DECREASE * OF THE FUNCTION VALUE). * RI TOLP LINE SEARCH PARAMETER (IN TERMINATION CONDITION * FOR NULL AND SHORT STEPS). * RI ETA DISTANCE MEASURE PARAMETER. * II MES INTERPOLATION METHOD SELECTION. MES=1-BISECTION. * MES=2-QUADRATIC INTERPOLATION (WITH ONE DIRECTIONAL * DERIVATIVE). MES=3-QUADRATIC INTERPOLATION (WITH TWO * DIRECTIONAL DERIVATIVES). MES=4-CUBIC INTERPOLATION. * MES=5-CONIC INTERPOLATION. * II MES2 WEIGHT UPDATING METHOD SELECTION. MES2=1-QUADRATIC * INTERPOLATION. MES2=2-LOCAL MINIMUM LOCALIZATION. * IO ITERS TERMINATION INDICATOR. ITERS=0-ZERO STEP. ITERS=1-PERFECT * LINE SEARCH. ITERS=2 GOLDSTEIN STEPSIZE. ITERS=3-CURRY * STEPSIZE. ITERS=4-EXTENDED CURRY STEPSIZE. * ITERS=5-ARMIJO STEPSIZE. ITERS=6-FIRST STEPSIZE. * ITERS=7-MAXIMUM STEPSIZE. ITERS=8-UNBOUNDED FUNCTION. * ITERS=9-SHORT STEP. ITERS=10-ZERO STEP. * ITERS=-1-MRED REACHED. ITERS=-2-POSITIVE DIRECTIONAL * DERIVATIVE. ITERS=-3-ERROR IN INTERPOLATION. * * SUBPROGRAM USED : * SE FUNDER OBJECTIVE FUNCTION AND SUBGRADIENT EVALUATION. * S PNINT1 EXTRAPOLATION OR INTERPOLATION WITH DIRECTIONAL * DERIVATIVES. * S MXVDIR VECTOR AUGMENTED BY THE SCALED VECTOR. * * METHOD : * SAFEGUARDED EXTRAPOLATION AND INTERPOLATION WITH SPECIAL TERMINATION * CRITERIA. * SUBROUTINE PS1L05(NF,X,XO,S,R,RP,F,FO,FP,P,PO,PP,TO,G,SNORM,RMIN, + RMAX,FMIN,FMAX,TOLS,TOLP,ETA,MES,MES2,ITERS) C .. Parameters .. DOUBLE PRECISION CON1 PARAMETER (CON1=2D-3) C .. C .. Scalar Arguments .. DOUBLE PRECISION ETA,F,FMAX,FMIN,FO,FP,P,PO,PP,R,RMAX,RMIN,RP, + SNORM,TO,TOLP,TOLS INTEGER ITERS,MES,MES2,NF C .. C .. Array Arguments .. DOUBLE PRECISION G(*),S(*),X(*),XO(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION FAUX,FL,FU,PL,PU,RL,RTEMP,RU,TOAUX,TOP,TOP1,TOP2, + TOPB,TOPC INTEGER IPOC,IPOCM,IPOCN,MERR,MODE,MTYP LOGICAL L3,L5,M0,M3,M4 C .. C .. External Functions .. DOUBLE PRECISION MXVDOT EXTERNAL MXVDOT C .. C .. External Subroutines .. EXTERNAL FUNDER,MXVDIR,PNINT1 C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX,MIN C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. C .. Save statement .. SAVE IPOC,M4,TOP,TOP1,TOP2,TOAUX,FAUX,IPOCN,IPOCM C .. IF (NIT.LE.1) THEN IPOC = 0 IPOCN = 0 TOAUX = 1.0D0 END IF IF (NIT.EQ.NIT/5*5+1) THEN FAUX = 0.0D0 IPOCM = IPOCN END IF M4 = RP .EQ. R IF (.NOT.M4) PP = P IF (RMAX.LE.0.0D0) THEN ITERS = 0 GO TO 40 END IF NRED = 0 * * INITIAL STEPSIZE SELECTION * RTEMP = FMIN - F RP = 0.0D0 FP = FO R = 1.0D0 R = MIN(MAX(R,RMIN),RMAX) MODE = 0 MTYP = 10 RL = 0.0D0 FL = FO PL = PO RU = 0.0D0 FU = FO PU = PO * * NEW STEPSIZE SELECTION (EXTRAPOLATION OR INTERPOLATION) * 10 IF (RL.EQ.0.0D0) THEN MTYP = MIN(MTYP,2) PL = PP CALL PNINT1(RL,RU,FL,FU,PL,PU,R,MODE,MTYP,MERR) ELSE MERR = 0 R = 0.5D0* (RU+RL) END IF IF (MERR.GT.0) THEN ITERS = -MERR GO TO 40 ELSE IF (MODE.EQ.1) THEN NRED = NRED - 1 R = MIN(R,RMAX) ELSE IF (MODE.EQ.2) THEN NRED = NRED + 1 END IF * * NEW FUNCTION VALUE AND NEW DIRECTIONAL DERIVATIVE * CALL MXVDIR(NF,R,S,XO,X) CALL FUNDER(NF,X,F,G) NFV = NFV + 1 NFG = NFG + 1 P = MXVDOT(NF,G,S) IF (F.LE.FMIN) THEN ITERS = 7 GO TO 40 END IF L3 = (F-FO.LE.TOLS*R*PO) .OR. (F.LE.FO-1.0D0) MODE = MAX(MODE,1) IF (MODE.EQ.1) THEN * * INTERVAL CHANGE AFTER EXTRAPOLATION * TOP2 = 2.0D0* (P*R+FO-F)/ (R*SNORM)**2 TOP = TOP2 TOP1 = -1.0D0 IF (M4) TOP1 = 2.0D0* (F-FO-PP*R)/ (R*SNORM)**2 IF (TOP.LT.-CON1) THEN TOP = TOP1 ELSE IF (TOP1.GE.-CON1) TOP = MIN(TOP1,TOP) END IF IF (MES2.EQ.2 .AND. PP.LT.0.0D0) THEN IF (P.GE.0.0D0) TOP = MIN(TOP,TO/R* (1.0D0-P/PP)) IF (P.LT.0.0D0) TOP = MIN(TOP,TO/ (1.0D0+1.0D1*P/PP)) END IF M0 = M4 .OR. IPOC .GE. 6 .OR. L3 RL = RU FL = FU PL = PU RU = R FU = F PU = P IF (.NOT.L3) THEN NRED = 0 MODE = 2 END IF ELSE * * INTERVAL CHANGE AFTER INTERPOLATION * TOPB = 2.0D0* (P*R+FO-F)/ (R*SNORM)**2 TOPC = 2.0D0* (FU-F-P* (RU-R))/ ((RU-R)*SNORM)**2 IF (TOPB.LT.-CON1) THEN TOP = TOPC ELSE IF (TOPC.GE.-CON1) TOP = MIN(TOPB,TOPC) IF (TOPC.LT.-CON1) TOP = TOPB END IF IF (L3) THEN RL = R FL = F PL = P ELSE RU = R FU = F PU = P END IF END IF * * TEST ON TERMINATION * IF (F.LT.FP) THEN RP = R FP = F END IF RTEMP = MAX(ABS(FP-F+P* (R-RP)),ETA* ((R-RP)*SNORM)**2) M3 = P - RTEMP .GE. TOLP*PO L5 = RL .EQ. 0.0D0 MTYP = 1 IF (L5) MTYP = MES IF (F.GE.FMAX) MTYP = 1 IF (MODE.EQ.1 .AND. L3) L5 = .FALSE. IF (L3 .AND. RP.GT.RMIN) GO TO 30 IF (M3 .AND. (R.LT.1D0.OR. (IPOC.LE.6.AND.NIT.GT.1))) GO TO 20 IF (M3 .AND. .NOT.M0) GO TO 20 IF (RU-RL.GE.RMIN) GO TO 10 20 IF (RP.EQ.0.0D0) THEN ITERS = 10 IPOC = IPOC + 1 ELSE ITERS = 9 IPOC = 0 END IF GO TO 40 30 ITERS = 5 IPOC = 0 IF (MODE.EQ.1) IPOCN = IPOCN + 1 R = RP F = FP 40 CONTINUE * * WEIGHT UPDATING * FAUX = MAX(FAUX,F-FP) IF (NIT.EQ.NIT/5*5 .AND. MES2.EQ.2) THEN IF (IPOCN-IPOCM.GE.4) THEN TOAUX = MAX(TOAUX/1.75D0,CON1) ELSE IF (IPOCN.EQ.IPOCM .AND. FAUX.GE.-R*PO .AND. + NIT.GT.10) THEN TOAUX = MIN(TOAUX*1.25D0,1.0D0/CON1) END IF END IF TOP = TOP*TOAUX RU = (TOP+CON1*1D-1)* (TOP*CON1*1D-2-1.0D0) IF (M0 .AND. RU.LE.0.0D0 .AND. MES2.EQ. + 1) TO = MIN(MAX(TOP,CON1,TO/1.0D1),1.0D0/CON1,TO*1.0D1) IF (M0 .AND. RU.LE.0.0D0 .AND. MES2.EQ. + 2) TO = MIN(MAX(TOP,CON1/1.0D1,TO/1.0D1),1.0D0/CON1,TO*1.0D1) RETURN END * SUBROUTINE PS1L07 ALL SYSTEMS 99/12/01 * PORTABILITY : ALL SYSTEMS * 99/12/01 VL : ORIGINAL VERSION * * PURPOSE : * SPECIAL LINE SEARCH FOR NONSMOOTH CONVEX VARIABLE METRIC METHOD. * * PARAMETERS : * II N ACTUAL NUMBER OF VARIABLES. * II MA DECLARED NUMBER OF LINEAR APPROXIMATED FUNCTIONS * II MAL CURRENT NUMBER OF LINEAR APPROXIMATED FUNCTIONS. * RU X(N) VECTOR OF VARIABLES. * RO G(N) SUBGRADIENT OF THE OBJECTIVE FUNCTION. * RI S(N) DIRECTION VECTOR. * RU U(N) PREVIOUS VECTOR OF VARIABLES. * RI V(N) PREVIOUS SUBGRADIENT OF THE OBJECTIVE FUNCTION. * RI AF(4*MA) VECTOR OF BUNDLE FUNCTIONS VALUES. * RI AG(N*MA) MATRIX WHOSE COLUMNS ARE BUNDLE SUBGRADIENTS. * RI AY(N*MA) MATRIX WHOSE COLUMNS ARE VARIABLE VECTORS. * RO T VALUE OF THE STEPSIZE PARAMETER. * RO TB BUNDLE PARAMETER FOR MATRIX SCALING. * RO FO PREVIOUS VALUE OF THE OBJECTIVE FUNCTION. * RO F VALUE OF THE OBJECTIVE FUNCTION. * RU PO PREVIOUS DIRECTIONAL DERIVATIVE. * RI TMIN MINIMUM VALUE OF THE STEPSIZE PARAMETER. * RI TMAX MAXIMUM VALUE OF THE STEPSIZE PARAMETER. * RI D1 AUXILIARY VALUE FOR NULL/DESCENT STEP TEST. * RU DF AUXILIARY VALUE FOR TEST ON FUNCTION DECREASE. * RI ETA9 MAXIMUM FOR REAL NUMBERS. * RI TOLF LOWER BOUND FOR FUNCTION DECREASE. * IO JL TERMINATION INDICATOR. * IO NE EXTRAPOLATION COUNTER. * IO NK NULL STEP INDICATOR. NK=0-DESCENT STEP. NK=2-NULL STEP. * IU NV AUXILIARY NUMBER OF FUNCTION EVALUATIONS. * IU NTESF ACTUAL NUMBER OF TESTS ON FUNCTION DECREASE. * II MTESF MAXIMUM NUMBER OF TESTS ON FUNCTION DECREASE. * IO ITERS NULL STEP INDICATOR. ITERS=0-NULL STEP. ITERS=1-DESCENT * STEP. * * SUBPROGRAMS USED : * S MXVCOP COPYING OF A VECTOR. * RF MXVMX2 L-INFINITY NORM OF VECTOR DIFFERENCE. * S PNSTP2 STEPSIZE DETERMINATION FOR DESCENT STEPS. * S PNSTP3 STEPSIZE DETERMINATION FOR NULL STEPS. * * METHOD : * SPECIAL METHOD OF STEP LENGTH DETERMINATION. * SUBROUTINE PS1L07(N,MA,MAL,X,G,S,U,V,AF,AG,AY,T,TB,FO,F,PO,TMIN, + TMAX,D1,DF,ETA9,TOLF,JL,NE,NV,NTESF,MTESF,ITERS) C .. Scalar Arguments .. DOUBLE PRECISION D1,DF,ETA9,F,FO,PO,T,TB,TMAX,TMIN,TOLF INTEGER ITERS,JL,MA,MAL,MTESF,N,NE,NTESF,NV C .. C .. Array Arguments .. DOUBLE PRECISION AF(*),AG(*),AY(*),G(*),S(*),U(*),V(*),X(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION DT,W C .. C .. External Functions .. DOUBLE PRECISION MXVMX2 EXTERNAL MXVMX2 C .. C .. External Subroutines .. EXTERNAL FUNDER,MXVCOP,MXVDIR,PNSTP2,PNSTP3 C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX,MIN C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. T = MIN(1.0D0,TMAX) IF (PO.NE.0.0D0) THEN IF (ITERS.EQ.1) THEN CALL PNSTP2(N,MA,MAL,X,AF,AG,AY,S,F,PO,T,TB,ETA9) ELSE CALL PNSTP3(N,MA,MAL,X,AF,AG,AY,S,F,PO,T,TB,ETA9) END IF END IF T = MIN(MAX(T,TMIN),TMAX) DT = T NE = 0 * * FUNCTION AND GRADIENT EVALUATION AT A NEW POINT * 10 CALL MXVDIR(N,T,S,U,X) CALL FUNDER(N,X,F,G) NFV = NFV + 1 NFG = NFG + 1 NV = NV + 1 * * NULL/DESCENT STEP TEST (ITERS=0/1) * ITERS = 1 IF (F.GT.FO-T*D1) ITERS = 0 W = DF IF (ABS(FO-F).GE.DF*1.0D-5) W = ABS(FO-F) IF (ITERS.EQ.1) DF = W IF (W/MAX(ABS(F),1.0D0).LE.TOLF .OR. FO.EQ.F) THEN NTESF = NTESF + 1 JL = 1 IF (NTESF.GE.MTESF) RETURN ELSE NTESF = 0 END IF W = MXVMX2(N,G,V) T = DT DT = DT + T IF (W.EQ.0.0D0 .AND. ITERS.EQ.1 .AND. NE.LE.9 .AND. + DT.LE.TMAX) THEN * * EXTRAPOLATION * NE = NE + 1 FO = F CALL MXVCOP(N,X,U) GO TO 10 END IF JL = 0 RETURN END * SUBROUTINE PS1L08 ALL SYSTEMS 99/12/01 * PORTABILITY : ALL SYSTEMS * 99/12/01 VL : ORIGINAL VERSION * * PURPOSE : * SPECIAL LINE SEARCH FOR NONSMOOTH NONCONVEX VARIABLE METRIC METHOD. * * PARAMETERS : * II N ACTUAL NUMBER OF VARIABLES. * II MA DECLARED NUMBER OF LINEAR APPROXIMATED FUNCTIONS * II MAL CURRENT NUMBER OF LINEAR APPROXIMATED FUNCTIONS. * RU X(N) VECTOR OF VARIABLES. * RO G(N) SUBGRADIENT OF THE OBJECTIVE FUNCTION. * RI S(N) DIRECTION VECTOR. * RU U(N) PREVIOUS VECTOR OF VARIABLES. * RI AF(4*MA) VECTOR OF BUNDLE FUNCTIONS VALUES. * RI AG(N*MA) MATRIX WHOSE COLUMNS ARE BUNDLE SUBGRADIENTS. * RI AY(N*MA) MATRIX WHOSE COLUMNS ARE VARIABLE VECTORS. * RO T VALUE OF THE STEPSIZE PARAMETER. * RO TB BUNDLE PARAMETER FOR MATRIX SCALING. * RO FO PREVIOUS VALUE OF THE OBJECTIVE FUNCTION. * RO F VALUE OF THE OBJECTIVE FUNCTION. * RU PO PREVIOUS DIRECTIONAL DERIVATIVE. * RU P DIRECTIONAL DERIVATIVE. * RI TMIN MINIMUM VALUE OF THE STEPSIZE PARAMETER. * RI TMAX MAXIMUM VALUE OF THE STEPSIZE PARAMETER. * RI SNORM EUCLIDEAN NORM OF THE DIRECTION VECTOR. * RI WK STOPPING PARAMETER. * RI EPS1 TERMINATION TOLERANCE FOR LINE SEARCH (IN TEST ON THE * CHANGE OF THE FUNCTION VALUE). * RI EPS2 TERMINATION TOLERANCE FOR LINE SEARCH (IN TEST ON THE * DIRECTIONAL DERIVATIVE). * RI ETA5 DISTANCE MEASURE PARAMETER. * RI ETA9 MAXIMUM FOR REAL NUMBERS. * II JE EXTRAPOLATION INDICATOR. * RI MOS3 LOCALITY MEASURE PARAMETER. * IO ITERS NULL STEP INDICATOR. ITERS=0-NULL STEP. ITERS=1-DESCENT * STEP. * SUBPROGRAMS USED : * RF MXVDOT DOT PRODUCT OF TWO VECTORS. * S PNSTP4 STEPSIZE DETERMINATION FOR DESCENT STEPS. * S PNSTP5 STEPSIZE DETERMINATION FOR NULL STEPS. * S PNINT1 EXTRAPOLATION OR INTERPOLATION FOR LINE SEARCH * WITH DIRECTIONAL DERIVATIVES. * * METHOD : * SPECIAL METHOD OF STEP LENGTH DETERMINATION. * SUBROUTINE PS1L08(N,MA,MAL,X,G,S,U,AF,AG,AY,T,TB,FO,F,PO,P,TMIN, + TMAX,SNORM,WK,EPS1,EPS2,ETA5,ETA9,JE,MOS3,ITERS) C .. Scalar Arguments .. DOUBLE PRECISION EPS1,EPS2,ETA5,ETA9,F,FO,P,PO,SNORM,T,TB,TMAX, + TMIN,WK INTEGER ITERS,JE,MA,MAL,MOS3,N C .. C .. Array Arguments .. DOUBLE PRECISION AF(*),AG(*),AY(*),G(*),S(*),U(*),X(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION BET,FL,FU,PL,PU,TL,TU INTEGER IER C .. C .. External Functions .. DOUBLE PRECISION MXVDOT EXTERNAL MXVDOT C .. C .. External Subroutines .. EXTERNAL FUNDER,MXVDIR,PNINT1,PNSTP4,PNSTP5 C .. C .. Intrinsic Functions .. INTRINSIC ABS,DBLE,MAX,MIN C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. IF (JE.GT.0) T = DBLE(2-JE/99)*T IF (JE.LE.0) T = MIN(1.0D0,TMAX) IF (PO.EQ.0.0D0 .OR. JE.GT.0) GO TO 10 IF (ITERS.EQ.1) THEN CALL PNSTP4(N,MA,MAL,X,AF,AG,AY,S,F,PO,T,TB,ETA5,ETA9,MOS3) ELSE CALL PNSTP5(N,MA,MAL,X,AF,AG,AY,S,F,PO,T,TB,ETA5,ETA9,MOS3) END IF 10 T = MIN(MAX(T,TMIN),TMAX) TL = 0.0D0 TU = T FL = FO PL = PO * * FUNCTION AND GRADIENT EVALUATION AT A NEW POINT * 20 CALL MXVDIR(N,T,S,U,X) CALL FUNDER(N,X,F,G) NFV = NFV + 1 NFG = NFG + 1 P = MXVDOT(N,G,S) * * NULL/DESCENT STEP TEST (ITERS=0/1) * ITERS = 1 IF (F.LE.FO-T* (EPS1+EPS1)*WK) THEN TL = T FL = F PL = P ELSE TU = T FU = F PU = P END IF BET = MAX(ABS(FO-F+P*T),ETA5* (SNORM*T)**MOS3) IF (F.LE.FO-T*EPS1*WK .AND. (T.GE.TMIN.OR. + BET.GT.EPS1*WK)) GO TO 40 IF (P-BET.GE.-EPS2*WK .OR. TU-TL.LT.TMIN*1.0D-1) GO TO 30 IF (TL.EQ.0.0D0 .AND. PL.LT.0.0D0) THEN CALL PNINT1(TL,TU,FL,FU,PL,PU,T,2,2,IER) ELSE T = 5.0D-1* (TU+TL) END IF GO TO 20 30 ITERS = 0 40 CONTINUE RETURN END * SUBROUTINE PNINT1 ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * EXTRAPOLATION OR INTERPOLATION FOR LINE SEARCH WITH DIRECTIONAL * DERIVATIVES. * * PARAMETERS : * RI RL LOWER VALUE OF THE STEPSIZE PARAMETER. * RI RU UPPER VALUE OF THE STEPSIZE PARAMETER. * RI FL VALUE OF THE OBJECTIVE FUNCTION FOR R=RL. * RI FU VALUE OF THE OBJECTIVE FUNCTION FOR R=RU. * RI PL DIRECTIONAL DERIVATIVE FOR R=RL. * RI PU DIRECTIONAL DERIVATIVE FOR R=RU. * RO R VALUE OF THE STEPSIZE PARAMETER OBTAINED. * II MODE MODE OF LINE SEARCH. * II MTYP METHOD SELECTION. MTYP=1-BISECTION. MTYP=2-QUADRATIC * INTERPOLATION (WITH ONE DIRECTIONAL DERIVATIVE). * MTYP=3-QUADRATIC INTERPOLATION (WITH TWO DIRECTIONAL * DERIVATIVES). MTYP=4-CUBIC INTERPOLATION. MTYP=5-CONIC * INTERPOLATION. * IO MERR ERROR INDICATOR. MERR=0 FOR NORMAL RETURN. * * METHOD : * EXTRAPOLATION OR INTERPOLATION WITH STANDARD MODEL FUNCTIONS. * SUBROUTINE PNINT1(RL,RU,FL,FU,PL,PU,R,MODE,MTYP,MERR) C .. Parameters .. DOUBLE PRECISION ZERO,HALF,ONE,TWO,THREE,C1L,C1U,C2L,C2U,C3L,FOUR PARAMETER (ZERO=0.0D0,HALF=0.5D0,ONE=1.0D0,TWO=2.0D0,THREE=3.0D0, + C1L=1.1D0,C1U=1.0D3,C2L=1.0D-2,C2U=0.9D0,C3L=0.1D0, + FOUR=4.0D0) C .. C .. Scalar Arguments .. DOUBLE PRECISION FL,FU,PL,PU,R,RL,RU INTEGER MERR,MODE,MTYP C .. C .. Local Scalars .. DOUBLE PRECISION A,B,C,D,DEN,DIS INTEGER NTYP C .. C .. Intrinsic Functions .. INTRINSIC MAX,MIN,SQRT C .. MERR = 0 IF (MODE.LE.0) RETURN IF (PL.GE.ZERO) THEN MERR = 2 RETURN ELSE IF (RU.LE.RL) THEN MERR = 3 RETURN END IF DO 10 NTYP = MTYP,1,-1 IF (NTYP.EQ.1) THEN * * BISECTION * IF (MODE.EQ.1) THEN R = FOUR*RU RETURN ELSE R = HALF* (RL+RU) RETURN END IF ELSE IF (NTYP.EQ.MTYP) THEN A = (FU-FL)/ (PL* (RU-RL)) B = PU/PL END IF IF (NTYP.EQ.2) THEN * * QUADRATIC EXTRAPOLATION OR INTERPOLATION WITH ONE DIRECTIONAL * DERIVATIVE * DEN = TWO* (ONE-A) ELSE IF (NTYP.EQ.3) THEN * * QUADRATIC EXTRAPOLATION OR INTERPOLATION WITH TWO DIRECTIONAL * DERIVATIVES * DEN = ONE - B ELSE IF (NTYP.EQ.4) THEN * * CUBIC EXTRAPOLATION OR INTERPOLATION * C = B - TWO*A + ONE D = B - THREE*A + TWO DIS = D*D - THREE*C IF (DIS.LT.ZERO) GO TO 10 DEN = D + SQRT(DIS) ELSE IF (NTYP.EQ.5) THEN * * CONIC EXTRAPOLATION OR INTERPOLATION * DIS = A*A - B IF (DIS.LT.ZERO) GO TO 10 DEN = A + SQRT(DIS) IF (DEN.LT.ZERO) GO TO 10 DEN = ONE - B* (ONE/DEN)**3 END IF IF (MODE.EQ.1 .AND. DEN.GT.ZERO .AND. DEN.LT.ONE) THEN * * EXTRAPOLATION ACCEPTED * R = RL + (RU-RL)/DEN R = MAX(R,C1L*RU) R = MIN(R,C1U*RU) RETURN ELSE IF (MODE.EQ.2 .AND. DEN.GT.ONE) THEN * * INTERPOLATION ACCEPTED * R = RL + (RU-RL)/DEN IF (RL.EQ.ZERO) THEN R = MAX(R,RL+C2L* (RU-RL)) ELSE R = MAX(R,RL+C3L* (RU-RL)) END IF R = MIN(R,RL+C2U* (RU-RL)) RETURN END IF 10 CONTINUE END * SUBROUTINE PNINT3 ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * EXTRAPOLATION OR INTERPOLATION FOR LINE SEARCH WITHOUT DIRECTIONAL * DERIVATIVES. * * PARAMETERS : * RI RO INITIAL VALUE OF THE STEPSIZE PARAMETER. * RI RL LOWER VALUE OF THE STEPSIZE PARAMETER. * RI RU UPPER VALUE OF THE STEPSIZE PARAMETER. * RI RI INNER VALUE OF THE STEPSIZE PARAMETER. * RI FO VALUE OF THE OBJECTIVE FUNCTION FOR R=RO. * RI FL VALUE OF THE OBJECTIVE FUNCTION FOR R=RL. * RI FU VALUE OF THE OBJECTIVE FUNCTION FOR R=RU. * RI FI VALUE OF THE OBJECTIVE FUNCTION FOR R=RI. * RO PO INITIAL VALUE OF THE DIRECTIONAL DERIVATIVE. * RO R VALUE OF THE STEPSIZE PARAMETER OBTAINED. * II MODE MODE OF LINE SEARCH. * II MTYP METHOD SELECTION. MTYP=1-BISECTION. MTYP=2-TWO POINT * QUADRATIC INTERPOLATION. MTYP=2-THREE POINT QUADRATIC * INTERPOLATION. * IO MERR ERROR INDICATOR. MERR=0 FOR NORMAL RETURN. * * METHOD : * EXTRAPOLATION OR INTERPOLATION WITH STANDARD MODEL FUNCTIONS. * SUBROUTINE PNINT3(RO,RL,RU,RI,FO,FL,FU,FI,PO,R,MODE,MTYP,MERR) C .. Parameters .. DOUBLE PRECISION ZERO,HALF,ONE,TWO,THREE,C1L,C1U,C2L,C2U,C3L PARAMETER (ZERO=0.0D0,HALF=0.5D0,ONE=1.0D0,TWO=2.0D0,THREE=3.0D0, + C1L=1.1D0,C1U=1.0D3,C2L=1.0D-2,C2U=0.9D0,C3L=1.0D-1) C .. C .. Scalar Arguments .. DOUBLE PRECISION FI,FL,FO,FU,PO,R,RI,RL,RO,RU INTEGER MERR,MODE,MTYP C .. C .. Local Scalars .. DOUBLE PRECISION AI,AL,AU,DEN,DIS INTEGER NTYP LOGICAL L1,L2 C .. C .. Intrinsic Functions .. INTRINSIC MAX,MIN,SQRT C .. MERR = 0 IF (MODE.LE.0) RETURN IF (PO.GE.ZERO) THEN MERR = 2 RETURN ELSE IF (RU.LE.RL) THEN MERR = 3 RETURN END IF L1 = RL .LE. RO L2 = RI .LE. RL DO 10 NTYP = MTYP,1,-1 IF (NTYP.EQ.1) THEN * * BISECTION * IF (MODE.EQ.1) THEN R = TWO*RU RETURN ELSE IF (RI-RL.LE.RU-RI) THEN R = HALF* (RI+RU) RETURN ELSE R = HALF* (RL+RI) RETURN END IF ELSE IF (NTYP.EQ.MTYP .AND. L1) THEN IF (.NOT.L2) AI = (FI-FO)/ (RI*PO) AU = (FU-FO)/ (RU*PO) END IF IF (L1 .AND. (NTYP.EQ.2.OR.L2)) THEN * * TWO POINT QUADRATIC EXTRAPOLATION OR INTERPOLATION * IF (AU.GE.ONE) GO TO 10 R = HALF*RU/ (ONE-AU) ELSE IF (.NOT.L1 .OR. .NOT.L2 .AND. NTYP.EQ.3) THEN * * THREE POINT QUADRATIC EXTRAPOLATION OR INTERPOLATION * AL = (FI-FL)/ (RI-RL) AU = (FU-FI)/ (RU-RI) DEN = AU - AL IF (DEN.LE.ZERO) GO TO 10 R = RI - HALF* (AU* (RI-RL)+AL* (RU-RI))/DEN ELSE IF (L1 .AND. .NOT.L2 .AND. NTYP.EQ.4) THEN * * THREE POINT CUBIC EXTRAPOLATION OR INTERPOLATION * DIS = (AI-ONE)* (RU/RI) DEN = (AU-ONE)* (RI/RU) - DIS DIS = AU + AI - DEN - TWO* (ONE+DIS) DIS = DEN*DEN - THREE*DIS IF (DIS.LT.ZERO) GO TO 10 DEN = DEN + SQRT(DIS) IF (DEN.EQ.ZERO) GO TO 10 R = (RU-RI)/DEN ELSE GO TO 10 END IF IF (MODE.EQ.1 .AND. R.GT.RU) THEN * * EXTRAPOLATION ACCEPTED * R = MAX(R,C1L*RU) R = MIN(R,C1U*RU) RETURN ELSE IF (MODE.EQ.2 .AND. R.GT.RL .AND. R.LT.RU) THEN * * INTERPOLATION ACCEPTED * IF (RI.EQ.ZERO .AND. NTYP.NE.4) THEN R = MAX(R,RL+C2L* (RU-RL)) ELSE R = MAX(R,RL+C3L* (RU-RL)) END IF R = MIN(R,RL+C2U* (RU-RL)) IF (R.EQ.RI) GO TO 10 RETURN END IF 10 CONTINUE END * SUBROUTINE PNSTP2 ALL SYSTEMS 99/12/01 * PORTABILITY : ALL SYSTEMS * 99/12/01 VL : ORIGINAL VERSION * * PURPOSE : * STEPSIZE SELECTION USING POLYHEDRAL APPROXIMATION * FOR DESCENT STEP IN CONVEX VARIABLE METRIC METHOD. * * PARAMETERS : * II N ACTUAL NUMBER OF VARIABLES. * II MA DECLARED NUMBER OF LINEAR APPROXIMATED FUNCTIONS. * II MAL CURRENT NUMBER OF LINEAR APPROXIMATED FUNCTIONS. * RU X(N) VECTOR OF VARIABLES. * RI AF(4*MA) VECTOR OF BUNDLE FUNCTIONS VALUES. * RI AG(N*MA) MATRIX WHOSE COLUMNS ARE BUNDLE SUBGRADIENTS. * RI AY(N*MA) MATRIX WHOSE COLUMNS ARE VARIABLE VECTORS. * RI S(N) DIRECTION VECTOR. * RI F VALUE OF THE OBJECTIVE FUNCTION. * RI DF DIRECTIONAL DERIVATIVE. * RO T VALUE OF THE STEPSIZE PARAMETER. * RO TB BUNDLE PARAMETER FOR MATRIX SCALING. * RI ETA9 MAXIMUM FOR REAL NUMBERS. * SUBROUTINE PNSTP2(N,MA,MAL,X,AF,AG,AY,S,F,DF,T,TB,ETA9) C .. Scalar Arguments .. DOUBLE PRECISION DF,ETA9,F,T,TB INTEGER MA,MAL,N C .. C .. Array Arguments .. DOUBLE PRECISION AF(*),AG(*),AY(*),S(*),X(*) C .. C .. Local Scalars .. DOUBLE PRECISION ALF,ALFL,ALFR,BET,BETL,BETR,Q,R,W INTEGER I,J,JN,K,L,LQ C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX,MIN,SQRT C .. W = DF*T* (1.0D0-T*0.5D0) * * INITIAL CHOICE OF POSSIBLY ACTIVE LINES * K = 0 L = -1 JN = 0 TB = SQRT(ETA9) BETR = -ETA9 DO 20 J = 1,MAL - 1 BET = 0.0D0 ALFL = AF(J) - F DO 10 I = 1,N Q = AG(JN+I) ALFL = ALFL + (X(I)-AY(JN+I))*Q BET = BET + S(I)*Q 10 CONTINUE ALF = ABS(ALFL) R = 1.0D0 - BET/DF IF (R*R+ (ALF+ALF)/DF.GT.1.0D-6) THEN K = K + 1 AF(MA+K) = ALF AF(MA+MA+K) = BET R = T*BET - ALF IF (R.GT.W) THEN W = R L = K END IF END IF IF (BET.GT.0.0D0) TB = MIN(TB,ALF/ (BET-DF)) BETR = MAX(BETR,BET-ALF) JN = JN + N 20 CONTINUE IF (L.LT.0 .OR. BETR.LE.DF*0.5D0) RETURN LQ = 1 BETR = AF(MA+MA+L) IF (BETR.LE.0.0D0) THEN IF (T.LT.1.0D0 .OR. BETR.EQ.0.0D0) RETURN LQ = 2 END IF ALFR = AF(MA+L) * * ITERATION LOOP * 30 IF (LQ.GE.1) THEN Q = 1.0D0 - BETR/DF R = Q + SQRT(Q*Q+ (ALFR+ALFR)/DF) IF (BETR.GE.0.0D0) R = - (ALFR+ALFR)/ (DF*R) R = MIN(1.95D0,MAX(0.0D0,R)) ELSE IF (ABS(BETR-BETL)+ABS(ALFR-ALFL).LT.-1.0D-4*DF) RETURN R = (ALFR-ALFL)/ (BETR-BETL) END IF IF (ABS(T-R).LT.1.0D-4) RETURN T = R AF(MA+L) = -1.0D0 W = T*BETR - ALFR L = -1 DO 40 J = 1,K ALF = AF(MA+J) IF (ALF.LT.0.0D0) GO TO 40 BET = AF(MA+MA+J) R = T*BET - ALF IF (R.GT.W) THEN W = R L = J END IF 40 CONTINUE IF (L.LT.0) RETURN BET = AF(MA+MA+L) IF (BET.EQ.0.0D0) RETURN * * NEW INTERVAL SELECTION * ALF = AF(MA+L) IF (BET.LT.0.0D0) THEN IF (LQ.EQ.2) THEN ALFR = ALF BETR = BET ELSE ALFL = ALF BETL = BET LQ = 0 END IF ELSE IF (LQ.EQ.2) THEN ALFL = ALFR BETL = BETR LQ = 0 END IF ALFR = ALF BETR = BET END IF GO TO 30 END * SUBROUTINE PNSTP3 ALL SYSTEMS 99/12/01 * PORTABILITY : ALL SYSTEMS * 99/12/01 VL : ORIGINAL VERSION * * PURPOSE : * STEPSIZE SELECTION USING POLYHEDRAL APPROXIMATION * FOR NULL STEP IN CONVEX VARIABLE METRIC METHOD. * * PARAMETERS : * II N ACTUAL NUMBER OF VARIABLES. * II MA DECLARED NUMBER OF LINEAR APPROXIMATED FUNCTIONS * II MAL CURRENT NUMBER OF LINEAR APPROXIMATED FUNCTIONS. * RU X(N) VECTOR OF VARIABLES. * RI AF(4*MA) VECTOR OF BUNDLE FUNCTIONS VALUES. * RI AG(N*MA) MATRIX WHOSE COLUMNS ARE BUNDLE SUBGRADIENTS. * RI AY(N*MA) MATRIX WHOSE COLUMNS ARE VARIABLE VECTORS. * RI S(N) DIRECTION VECTOR. * RI F VALUE OF THE OBJECTIVE FUNCTION. * RI DF DIRECTIONAL DERIVATIVE. * RO T VALUE OF THE STEPSIZE PARAMETER. * RO TB BUNDLE PARAMETER FOR MATRIX SCALING. * RI ETA9 MAXIMUM FOR REAL NUMBERS. * SUBROUTINE PNSTP3(N,MA,MAL,X,AF,AG,AY,S,F,DF,T,TB,ETA9) C .. Scalar Arguments .. DOUBLE PRECISION DF,ETA9,F,T,TB INTEGER MA,MAL,N C .. C .. Array Arguments .. DOUBLE PRECISION AF(*),AG(*),AY(*),S(*),X(*) C .. C .. Local Scalars .. DOUBLE PRECISION ALF,ALFL,ALFR,BET,BETL,BETR,R,TP,W INTEGER I,J,JN,K,L C .. C .. Intrinsic Functions .. INTRINSIC ABS,MIN,SQRT C .. W = DF*T TP = T * * INITIAL CHOICE OF POSSIBLY ACTIVE LINES * K = 0 L = -1 JN = 0 TB = SQRT(ETA9) DO 20 J = 1,MAL - 1 BET = 0.0D0 ALFL = AF(J) - F DO 10 I = 1,N R = AG(JN+I) ALFL = ALFL + (X(I)-AY(JN+I))*R BET = BET + S(I)*R 10 CONTINUE ALF = ABS(ALFL) R = T*BET - ALF IF (R.GT.DF*T) THEN K = K + 1 AF(MA+K) = ALF AF(MA+MA+K) = BET IF (R.GT.W) THEN W = R L = K END IF END IF IF (BET.GT.0.0D0) TB = MIN(TB,ALF/ (BET-DF)) JN = JN + N 20 CONTINUE IF (L.LT.0) RETURN BETR = AF(MA+MA+L) IF (BETR.LE.0.0D0) RETURN ALFR = AF(MA+L) ALF = ALFR BET = BETR ALFL = 0.0D0 BETL = DF * * ITERATION LOOP * 30 IF (ABS(BETR-BETL)+ABS(ALFR-ALFL).LT.-1.0D-4*DF) RETURN R = T IF (BETR-BETL.NE.0.0D0) T = MIN((ALFR-ALFL)/ (BETR-BETL),TP) IF (ABS(T-R).LT.1.0D-3) RETURN AF(MA+L) = -1.0D0 W = T*BET - ALF L = -1 DO 40 J = 1,K ALF = AF(MA+J) IF (ALF.LT.0.0D0) GO TO 40 BET = AF(MA+MA+J) R = T*BET - ALF IF (R.GT.W) THEN W = R L = J END IF 40 CONTINUE IF (L.LT.0) RETURN * * NEW INTERVAL SELECTION * BET = AF(MA+MA+L) ALF = AF(MA+L) IF (BET.LE.0.0D0) THEN ALFL = ALF BETL = BET ELSE ALFR = ALF BETR = BET END IF GO TO 30 END * SUBROUTINE PNSTP4 ALL SYSTEMS 99/12/01 * PORTABILITY : ALL SYSTEMS * 99/12/01 VL : ORIGINAL VERSION * * PURPOSE : * STEPSIZE SELECTION USING POLYHEDRAL APPROXIMATION * FOR DESCENT STEP IN NONCONVEX VARIABLE METRIC METHOD. * * PARAMETERS : * II N ACTUAL NUMBER OF VARIABLES. * II MA DECLARED NUMBER OF LINEAR APPROXIMATED FUNCTIONS * II MAL CURRENT NUMBER OF LINEAR APPROXIMATED FUNCTIONS. * RU X(N) VECTOR OF VARIABLES. * RI AF(4*MA) VECTOR OF BUNDLE FUNCTIONS VALUES. * RI AG(N*MA) MATRIX WHOSE COLUMNS ARE BUNDLE SUBGRADIENTS. * RI AY(N*MA) MATRIX WHOSE COLUMNS ARE VARIABLE VECTORS. * RI F VALUE OF THE OBJECTIVE FUNCTION. * RI DF DIRECTIONAL DERIVATIVE. * RO T VALUE OF THE STEPSIZE PARAMETER. * RO TB BUNDLE PARAMETER FOR MATRIX SCALING. * RI ETA5 DISTANCE MEASURE PARAMETER. * RI ETA9 MAXIMUM FOR REAL NUMBERS. * RI MOS3 LOCALITY MEASURE PARAMETER. * SUBROUTINE PNSTP4(N,MA,MAL,X,AF,AG,AY,S,F,DF,T,TB,ETA5,ETA9,MOS3) C .. Scalar Arguments .. DOUBLE PRECISION DF,ETA5,ETA9,F,T,TB INTEGER MA,MAL,MOS3,N C .. C .. Array Arguments .. DOUBLE PRECISION AF(*),AG(*),AY(*),S(*),X(*) C .. C .. Local Scalars .. DOUBLE PRECISION ALF,ALFL,ALFR,BET,BETL,BETR,DX,Q,R,W INTEGER I,J,JN,K,L,LQ C .. C .. Intrinsic Functions .. INTRINSIC ABS,DBLE,MAX,MIN,SQRT C .. W = DF*T* (1.0D0-T*0.5D0) * * INITIAL CHOICE OF POSSIBLY ACTIVE LINES * K = 0 L = -1 JN = 0 TB = SQRT(ETA9) BETR = -ETA9 DO 20 J = 1,MAL - 1 R = 0.0D0 BET = 0.0D0 ALFL = AF(J) - F DO 10 I = 1,N DX = X(I) - AY(JN+I) Q = AG(JN+I) R = R + DX*DX ALFL = ALFL + DX*Q BET = BET + S(I)*Q 10 CONTINUE IF (MOS3.NE.2) R = R** (DBLE(MOS3)*0.5D0) ALF = MAX(ABS(ALFL),ETA5*R) R = 1.0D0 - BET/DF IF (R*R+ (ALF+ALF)/DF.GT.1.0D-6) THEN K = K + 1 AF(MA+K) = ALF AF(MA+MA+K) = BET R = T*BET - ALF IF (R.GT.W) THEN W = R L = K END IF END IF IF (BET.GT.0.0D0) TB = MIN(TB,ALF/ (BET-DF)) BETR = MAX(BETR,BET-ALF) JN = JN + N 20 CONTINUE LQ = -1 IF (BETR.LE.DF*0.5D0) RETURN LQ = 1 IF (L.LT.0) RETURN BETR = AF(MA+MA+L) IF (BETR.LE.0.0D0) THEN IF (T.LT.1.0D0 .OR. BETR.EQ.0.0D0) RETURN LQ = 2 END IF ALFR = AF(MA+L) * * ITERATION LOOP * 30 IF (LQ.GE.1) THEN Q = 1.0D0 - BETR/DF R = Q + SQRT(Q*Q+ (ALFR+ALFR)/DF) IF (BETR.GE.0.0D0) R = - (ALFR+ALFR)/ (DF*R) R = MIN(1.95D0,MAX(0.0D0,R)) ELSE IF (ABS(BETR-BETL)+ABS(ALFR-ALFL).LT.-1.0D-4*DF) RETURN R = (ALFR-ALFL)/ (BETR-BETL) END IF IF (ABS(T-R).LT.1.0D-4) RETURN T = R AF(MA+L) = -1.0D0 W = T*BETR - ALFR L = -1 DO 40 J = 1,K ALF = AF(MA+J) IF (ALF.LT.0.0D0) GO TO 40 BET = AF(MA+MA+J) R = T*BET - ALF IF (R.GT.W) THEN W = R L = J END IF 40 CONTINUE IF (L.LT.0) RETURN BET = AF(MA+MA+L) IF (BET.EQ.0.0D0) RETURN * * NEW INTERVAL SELECTION * ALF = AF(MA+L) IF (BET.LT.0.0D0) THEN IF (LQ.EQ.2) THEN ALFR = ALF BETR = BET ELSE ALFL = ALF BETL = BET LQ = 0 END IF ELSE IF (LQ.EQ.2) THEN ALFL = ALFR BETL = BETR LQ = 0 END IF ALFR = ALF BETR = BET END IF GO TO 30 END * SUBROUTINE PNSTP5 ALL SYSTEMS 99/12/01 * PORTABILITY : ALL SYSTEMS * 99/12/01 VL : ORIGINAL VERSION * * PURPOSE : * STEPSIZE SELECTION USING POLYHEDRAL APPROXIMATION * FOR NULL STEP IN NONCONVEX VARIABLE METRIC METHOD. * * PARAMETERS : * II N ACTUAL NUMBER OF VARIABLES. * II MA DECLARED NUMBER OF LINEAR APPROXIMATED FUNCTIONS. * II MAL CURRENT NUMBER OF LINEAR APPROXIMATED FUNCTIONS. * RU X(N) VECTOR OF VARIABLES. * RI AF(4*MA) VECTOR OF BUNDLE FUNCTIONS VALUES. * RI AG(N*MA) MATRIX WHOSE COLUMNS ARE BUNDLE SUBGRADIENTS. * RI AY(N*MA) MATRIX WHOSE COLUMNS ARE VARIABLE VECTORS. * RI S(N) DIRECTION VECTOR. * RI F VALUE OF THE OBJECTIVE FUNCTION. * RI DF DIRECTIONAL DERIVATIVE. * RO T VALUE OF THE STEPSIZE PARAMETER. * RO TB BUNDLE PARAMETER FOR MATRIX SCALING. * RI ETA5 DISTANCE MEASURE PARAMETER. * RI ETA9 MAXIMUM FOR REAL NUMBERS. * RI MOS3 LOCALITY MEASURE PARAMETER. * SUBROUTINE PNSTP5(N,MA,MAL,X,AF,AG,AY,S,F,DF,T,TB,ETA5,ETA9,MOS3) C .. Scalar Arguments .. DOUBLE PRECISION DF,ETA5,ETA9,F,T,TB INTEGER MA,MAL,MOS3,N C .. C .. Array Arguments .. DOUBLE PRECISION AF(*),AG(*),AY(*),S(*),X(*) C .. C .. Local Scalars .. DOUBLE PRECISION ALF,ALFL,ALFR,BET,BETL,BETR,DX,Q,R,W INTEGER I,J,JN,K,L C .. C .. Intrinsic Functions .. INTRINSIC ABS,DBLE,MAX,MIN,SQRT C .. W = DF*T * * INITIAL CHOICE OF POSSIBLY ACTIVE PARABOLAS * K = 0 L = -1 JN = 0 TB = SQRT(ETA9) BETR = -ETA9 DO 20 J = 1,MAL - 1 BET = 0.0D0 R = 0.0D0 ALFL = AF(J) - F DO 10 I = 1,N DX = X(I) - AY(JN+I) R = R + DX*DX Q = AG(JN+I) ALFL = ALFL + DX*Q BET = BET + S(I)*Q 10 CONTINUE IF (MOS3.NE.2) R = R** (DBLE(MOS3)*0.5D0) ALF = MAX(ABS(ALFL),ETA5*R) IF (BET+BET.GT.DF) TB = MIN(TB,ALF/ (BET-DF)) BETR = MAX(BETR,BET-ALF) IF (ALF.LT.BET-DF) THEN K = K + 1 R = T*BET - ALF AF(MA+K) = ALF AF(MA+MA+K) = BET IF (R.GT.W) THEN W = R L = K END IF END IF JN = JN + N 20 CONTINUE IF (L.LT.0) RETURN BETR = AF(MA+MA+L) ALFR = AF(MA+L) ALF = ALFR BET = BETR ALFL = 0.0D0 BETL = DF * * ITERATION LOOP * 30 W = BET/DF IF (ABS(BETR-BETL)+ABS(ALFR-ALFL).LT.-1.0D-4*DF) RETURN IF (BETR-BETL.EQ.0.0D0) STOP 11 R = (ALFR-ALFL)/ (BETR-BETL) IF (ABS(T-W).LT.ABS(T-R)) R = W Q = T T = R IF (ABS(T-Q).LT.1.0D-3) RETURN AF(MA+L) = -1.0D0 W = T*BET - ALF L = -1 DO 40 J = 1,K ALF = AF(MA+J) IF (ALF.LT.0.0D0) GO TO 40 BET = AF(MA+MA+J) R = T*BET - ALF IF (R.GT.W) THEN W = R L = J END IF 40 CONTINUE IF (L.LT.0) RETURN BET = AF(MA+MA+L) Q = BET - T*DF IF (Q.EQ.0.0D0) RETURN * * NEW INTERVAL SELECTION * ALF = AF(MA+L) IF (Q.LT.0.0D0) THEN ALFL = ALF BETL = BET ELSE ALFR = ALF BETR = BET END IF GO TO 30 END * SUBROUTINE PYADB4 ALL SYSTEMS 98/12/01 * PORTABILITY : ALL SYSTEMS * 98/12/01 LU : ORIGINAL VERSION * * PURPOSE : * NEW LINEAR CONSTRAINTS OR NEW SIMPLE BOUNDS ARE ADDED TO THE ACTIVE * SET. GILL-MURRAY FACTORIZATION OF THE TRANSFORMED HESSIAN MATRIX * APPROXIMATION IS UPDATED. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * IU N ACTUAL NUMBER OF VARIABLES. * II NC NUMBER OF LINEARIZED CONSTRAINTS. * RI X(NF) VECTOR OF VARIABLES. * IU IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. * RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * RI CF(NC) VECTOR CONTAINING VALUES OF THE CONSTRAINT FUNCTIONS. * RI CFD(NC) VECTOR CONTAINING INCREMENTS OF THE CONSTRAINT FUNCTIONS. * IU IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * IU ICA(NF) VECTOR CONTAINING INDICES OF ACTIVE CONSTRAINTS. * RI CL(NC) VECTOR CONTAINING LOWER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CU(NC) VECTOR CONTAINING UPPER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RU CR(NF*(NF+1)/2) TRIANGULAR DECOMPOSITION OF KERNEL OF THE * ORTHOGONAL PROJECTION. * RU CZ(NF*NF) MATRIX WHOSE COLUMNS ARE BASIC VECTORS FROM THE * CURRENT REDUCED SUBSPACE. * RU H(NF*(NF+1)/2) GILL-MURRAY FACTORIZATION OF THE TRANSFORMED * HESSIAN MATRIX APPROXIMATION. * RA S(NF) AUXILIARY VECTOR. * RI R VALUE OF THE STEPSIZE PARAMETER. * RI EPS7 TOLERANCE FOR LINEAR INDEPENDENCE OF CONSTRAINTS. * RI EPS9 TOLERANCE FOR ACTIVE CONSTRAINTS. * RO GMAX MAXIMUM ABSOLUTE VALUE OF A PARTIAL DERIVATIVE. * RO UMAX MAXIMUM ABSOLUTE VALUE OF A NEGATIVE LAGRANGE MULTIPLIER. * II KBF TYPE OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS. KBF=1-ONE * SIDED SIMPLE BOUNDS. KBF=2-TWO SIDED SIMPLE BOUNDS. * II KBC TYPE OF CONSTRAINTS. KBC=0-NO CONSTRAINTS. KBC=1-CONSTRAINTS * WITH ONE SIDED BOUNDS. KBC=2-CONSTRAINTS WITH TWO SIDED * BOUNDS. * IU INEW INDEX OF THE NEW ACTIVE CONSTRAINT. * IO IER ERROR INDICATOR. * IO ITERM TERMINATION INDICATOR. * * COMMON DATA : * IU NADD NUMBER OF CONSTRAINT ADDITIONS. * * SUBPROGRAMS USED : * S PLADB4 ADDITION OF A NEW ACTIVE CONSTRAINT. * S PLNEWS IDENTIFICATION OF ACTIVE UPPER BOUNDS. * S PLNEWL IDENTIFICATION OF ACTIVE LINEAR CONSTRAINRS. * S PLDIRL NEW VALUES OF CONSTRAINT FUNCTIONS. * S MXVIND CHANGE OF THE INTEGER VECTOR FOR CONSTRAINT ADDITION. * SUBROUTINE PYADB4(NF,N,NC,X,IX,XL,XU,CF,CFD,IC,ICA,CL,CU,CG,CR,CZ, + H,S,R,EPS7,EPS9,GMAX,UMAX,KBF,KBC,INEW,IER, + ITERM) C .. Scalar Arguments .. DOUBLE PRECISION EPS7,EPS9,GMAX,R,UMAX INTEGER IER,INEW,ITERM,KBC,KBF,N,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION CF(*),CFD(*),CG(*),CL(*),CR(*),CU(*),CZ(*),H(*), + S(*),X(*),XL(*),XU(*) INTEGER IC(*),ICA(*),IX(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. DOUBLE PRECISION DEN,TEMP INTEGER I,IJ,IK,J,K,KC,KJ,KK,L,LL C .. C .. External Subroutines .. EXTERNAL MXVIND,PLADB4,PLDIRL,PLNEWL,PLNEWS C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. IF (KBC.GT.0) THEN IF (R.NE.0.0D0) CALL PLDIRL(NC,CF,CFD,IC,R,KBC) IF (INEW.NE.0) THEN IF (KBF.GT.0) THEN DO 10 I = 1,NF INEW = 0 CALL PLNEWS(X,IX,XL,XU,EPS9,I,INEW) CALL PLADB4(NF,N,ICA,CG,CR,CZ,H,S,EPS7,GMAX,UMAX, + 9,INEW,NADD,IER) CALL MXVIND(IX,I,IER) IF (IER.LT.0) THEN ITERM = -15 RETURN END IF 10 CONTINUE END IF DO 20 KC = 1,NC INEW = 0 CALL PLNEWL(KC,CF,IC,CL,CU,EPS9,INEW) CALL PLADB4(NF,N,ICA,CG,CR,CZ,H,S,EPS7,GMAX,UMAX,9, + INEW,NADD,IER) CALL MXVIND(IC,KC,IER) IF (IER.LT.0) THEN ITERM = -15 RETURN END IF 20 CONTINUE END IF ELSE IF (KBF.GT.0) THEN K = 0 DO 70 L = 1,NF IF (IX(L).GE.0) K = K + 1 INEW = 0 CALL PLNEWS(X,IX,XL,XU,EPS9,L,INEW) IF (INEW.NE.0) THEN IX(L) = 10 - IX(L) KK = K* (K-1)/2 DEN = H(KK+K) IF (DEN.NE.0.0D0) THEN IJ = 0 KJ = KK DO 40 J = 1,N IF (J.LE.K) THEN KJ = KJ + 1 ELSE KJ = KJ + J - 1 END IF IF (J.NE.K) TEMP = H(KJ)/DEN IK = KK DO 30 I = 1,J IF (I.LE.K) THEN IK = IK + 1 ELSE IK = IK + I - 1 END IF IJ = IJ + 1 IF (I.NE.K .AND. J.NE.K) H(IJ) = H(IJ) + + TEMP*H(IK) 30 CONTINUE 40 CONTINUE END IF LL = KK + K DO 60 I = K + 1,N DO 50 J = 1,I LL = LL + 1 IF (J.NE.K) THEN KK = KK + 1 H(KK) = H(LL) END IF 50 CONTINUE 60 CONTINUE N = N - 1 END IF 70 CONTINUE END IF RETURN END * SUBROUTINE PYAGB1 ALL SYSTEMS 99/12/01 * PORTABILITY : ALL SYSTEMS * 99/12/01 VL : ORIGINAL VERSION * * PURPOSE : * SUBGRADIENT AGGREGATION FOR NONSMOOTH VARIABLE METRIC METHOD. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II N ACTUAL NUMBER OF VARIABLES. * RI H(N*(N+1)/2) POSITIVE DEFINITE APPROXIMATION OF THE INVERSE * HESSIAN MATRIX. * RI G(NF) SUBGRADIENT OF THE OBJECTIVE FUNCTION. * RI GO(NF) PREVIOUS SUBGRADIENT OF THE OBJECTIVE FUNCTION. * RU GV(NF) AGGREGATED SUBGRADIENT OF THE OBJECTIVE FUNCTION. * RU GN(N) REDUCED AGGREGATED SUBGRADIENT. * RI SN(N) REDUCED DIRECTION VECTOR. * RI CZ(NF*NF) MATRIX WHOSE COLUMNS ARE BASIC VECTORS FROM THE * CURRENT REDUCED SUBSPACE. * RU S(N) REDUCED SUBGRADIENT. * RU U(N) PREVIOUS REDUCED SUBGRADIENT. * RO ALF LINEARIZATION TERM. * RU ALFV AGGREGATED LINEARIZATION TERM. * II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS. * KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS. * II KBC SPECIFICATION OF LINEAR CONSTRAINTS. KBC=0-NO LINEAR * CONSTRAINTS. KBC=1-ONE SIDED LINEAR CONSTRAINTS. KBC=2=TWO * SIDED LINEAR CONSTRAINTS. * SUBROUTINE PYAGB1(NF,N,IX,H,G,GO,GV,GN,SN,CZ,S,U,ALF,ALFV,KBF,KBC) C .. Scalar Arguments .. DOUBLE PRECISION ALF,ALFV INTEGER KBC,KBF,N,NF C .. C .. Array Arguments .. DOUBLE PRECISION CZ(*),G(*),GN(*),GO(*),GV(*),H(*),S(*),SN(*),U(*) INTEGER IX(*) C .. C .. Local Scalars .. DOUBLE PRECISION A,ALFM,B,LAM1,LAM2,PQ,PR,PRQR,QQP,QR,RR,RRP,RRQ, + W,W1,W2 INTEGER I,J,K,L C .. C .. External Subroutines .. EXTERNAL MXDRMM C .. C .. Intrinsic Functions .. INTRINSIC MAX,MIN C .. ALFM = 0.0D0 * * GENERAL ROUTINE - HERE ALWAYS INPUT PARAMETER ALFM=0 * RR = ALFV + ALFV RRP = ALFV - ALFM RRQ = ALFV - ALF PQ = 0.0D0 PR = 0.0D0 QR = 0.0D0 QQP = ALF - ALFM PRQR = 0.0D0 IF (KBC.GT.0) THEN CALL MXDRMM(NF,N,CZ,G,S) CALL MXDRMM(NF,N,CZ,GO,U) DO 10 I = 1,N RR = RR - SN(I)*GN(I) U(I) = U(I) - GN(I) GN(I) = S(I) - GN(I) RRP = RRP + SN(I)*U(I) RRQ = RRQ + SN(I)*GN(I) 10 CONTINUE DO 40 I = 1,N L = I* (I-1)/2 + 1 W1 = 0.0D0 W2 = 0.0D0 DO 20 J = 1,I - 1 W = H(L) W1 = W1 + W*GN(J) W2 = W2 + W*U(J) L = L + 1 20 CONTINUE DO 30 J = I,N W = H(L) W1 = W1 + W*GN(J) W2 = W2 + W*U(J) L = L + J 30 CONTINUE PR = PR + U(I)*W2 QR = QR + GN(I)*W1 PQ = PQ + (GN(I)-U(I))* (W1-W2) QQP = QQP + S(I)* (W1-W2) PRQR = PRQR + U(I)*W1 40 CONTINUE ELSE IF (KBF.GT.0) THEN K = 0 DO 50 I = 1,NF IF (IX(I).GE.0) THEN K = K + 1 RR = RR - S(I)*GV(I) U(K) = GO(I) - GV(I) W = G(I) - GV(I) RRP = RRP + S(I)*U(K) RRQ = RRQ + S(I)*W S(K) = W END IF 50 CONTINUE K = 0 DO 80 I = 1,NF IF (IX(I).GE.0) THEN K = K + 1 L = K* (K-1)/2 + 1 W1 = 0.0D0 W2 = 0.0D0 DO 60 J = 1,K - 1 W = H(L) W1 = W1 + W*S(J) W2 = W2 + W*U(J) L = L + 1 60 CONTINUE DO 70 J = K,N W = H(L) W1 = W1 + W*S(J) W2 = W2 + W*U(J) L = L + J 70 CONTINUE PR = PR + U(K)*W2 QR = QR + S(K)*W1 PQ = PQ + (S(K)-U(K))* (W1-W2) QQP = QQP + G(I)* (W1-W2) PRQR = PRQR + U(K)*W1 END IF 80 CONTINUE ELSE DO 90 I = 1,NF RR = RR - S(I)*GV(I) U(I) = GO(I) - GV(I) GV(I) = G(I) - GV(I) RRP = RRP + S(I)*U(I) RRQ = RRQ + S(I)*GV(I) 90 CONTINUE DO 120 I = 1,NF L = I* (I-1)/2 + 1 W1 = 0.0D0 W2 = 0.0D0 DO 100 J = 1,I - 1 W = H(L) W1 = W1 + W*GV(J) W2 = W2 + W*U(J) L = L + 1 100 CONTINUE DO 110 J = I,NF W = H(L) W1 = W1 + W*GV(J) W2 = W2 + W*U(J) L = L + J 110 CONTINUE PR = PR + U(I)*W2 QR = QR + GV(I)*W1 PQ = PQ + (GV(I)-U(I))* (W1-W2) QQP = QQP + G(I)* (W1-W2) PRQR = PRQR + U(I)*W1 120 CONTINUE END IF IF (PR.LE.0.0D0 .OR. QR.LE.0.0D0) GO TO 130 A = RRQ/QR B = PRQR/QR W = PRQR*B - PR IF (W.EQ.0.0D0) GO TO 130 LAM1 = (A*PRQR-RRP)/W LAM2 = A - LAM1*B IF (LAM1* (LAM1-1.0D0).LT.0.0D0 .AND. + LAM2* (LAM1+LAM2-1.0D0).LT.0.0D0) GO TO 140 * * MINIMUM ON THE BOUNDARY * 130 LAM1 = 0.0D0 LAM2 = 0.0D0 IF (ALF.LE.ALFV) LAM2 = 1.0D0 IF (QR.GT.0.0D0) LAM2 = MIN(1.0D0,MAX(0.0D0,RRQ/QR)) W = (LAM2*QR-RRQ-RRQ)*LAM2 A = 0.0D0 IF (ALFM.LE.ALFV) A = 1.0D0 IF (PR.GT.0.0D0) A = MIN(1.0D0,MAX(0.0D0,RRP/PR)) B = (A*PR-RRP-RRP)*A IF (B.LT.W) THEN W = B LAM1 = A LAM2 = 0.0D0 END IF IF (QQP* (QQP-PQ).GE.0.0D0) GO TO 140 IF (QR-RRQ-RRQ-QQP*QQP/PQ.GE.W) GO TO 140 LAM1 = QQP/PQ LAM2 = 1.0D0 - LAM1 140 IF (LAM1.EQ.0.0D0 .AND. LAM2* (LAM2-1.0D0).LT.0.0D0 .AND. + RRP-LAM2*PRQR.GT.0.0D0 .AND. PR.GT. + 0.0D0) LAM1 = MIN(1.0D0-LAM2, (RRP-LAM2*PRQR)/PR) A = 1.0D0 - LAM1 - LAM2 B = 1.0D0 - LAM2 IF (KBC.GT.0) THEN DO 150 I = 1,N GN(I) = S(I) + LAM1*U(I) - B*GN(I) 150 CONTINUE DO 160 I = 1,NF GV(I) = LAM1*GO(I) + LAM2*G(I) + A*GV(I) 160 CONTINUE ELSE IF (KBF.GT.0) THEN K = 0 DO 170 I = 1,NF GV(I) = LAM1*GO(I) + LAM2*G(I) + A*GV(I) IF (IX(I).GE.0) THEN K = K + 1 GN(K) = GV(I) END IF 170 CONTINUE ELSE DO 180 I = 1,NF GV(I) = LAM1*GO(I) + (1.0D0-LAM1)*G(I) - A*GV(I) 180 CONTINUE END IF ALFV = LAM1*ALFM + LAM2*ALF + A*ALFV RETURN END * SUBROUTINE PYAGB2 ALL SYSTEMS 99/12/01 * PORTABILITY : ALL SYSTEMS * 99/12/01 VL : ORIGINAL VERSION * * PURPOSE : * SIMPLIFIED AGGREGATION FOR NONSMOOTH VARIABLE METRIC METHOD. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II N ACTUAL NUMBER OF VARIABLES. * RI H(M) POSITIVE DEFINITE APPROXIMATION OF THE INVERSE HESSIAN * MATRIX. * RI G(N) SUBGRADIENT OF THE OBJECTIVE FUNCTION. * RU GV(N) AGGREGATED SUBGRADIENT OF THE OBJECTIVE FUNCTION. * RU GN(N) REDUCED AGGREGATED SUBGRADIENT. * RI SN(N) REDUCED DIRECTION VECTOR. * RI CZ(NF*NF) MATRIX WHOSE COLUMNS ARE BASIC VECTORS FROM THE * CURRENT REDUCED SUBSPACE. * RU S(N) REDUCED SUBGRADIENT. * RO ALF LINEARIZATION TERM. * RU ALFV AGGREGATED LINEARIZATION TERM. * II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS. * KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS. * II KBC SPECIFICATION OF LINEAR CONSTRAINTS. KBC=0-NO LINEAR * CONSTRAINTS. KBC=1-ONE SIDED LINEAR CONSTRAINTS. KBC=2=TWO * SIDED LINEAR CONSTRAINTS. * SUBROUTINE PYAGB2(NF,N,IX,H,G,GV,GN,SN,CZ,S,ALF,ALFV,KBF,KBC) C .. Scalar Arguments .. DOUBLE PRECISION ALF,ALFV INTEGER KBC,KBF,N,NF C .. C .. Array Arguments .. DOUBLE PRECISION CZ(*),G(*),GN(*),GV(*),H(*),S(*),SN(*) INTEGER IX(*) C .. C .. Local Scalars .. DOUBLE PRECISION LAM,P,Q,W INTEGER I,J,K,L C .. C .. External Subroutines .. EXTERNAL MXDRMM C .. C .. Intrinsic Functions .. INTRINSIC MAX,MIN,SIGN C .. P = ALFV - ALF IF (KBC.GT.0) THEN CALL MXDRMM(NF,N,CZ,G,S) DO 10 I = 1,N GN(I) = S(I) - GN(I) P = P + SN(I)*GN(I) 10 CONTINUE Q = 0.0D0 DO 40 I = 1,N L = I* (I-1)/2 + 1 W = 0.0D0 DO 20 J = 1,I - 1 W = W + H(L)*GN(J) L = L + 1 20 CONTINUE DO 30 J = I,N W = W + H(L)*GN(J) L = L + J 30 CONTINUE Q = Q + W*GN(I) 40 CONTINUE LAM = 0.5D0 + SIGN(0.5D0,P) IF (Q.GT.0.0D0) LAM = MIN(1.0D0,MAX(0.0D0,P/Q)) P = 1.0D0 - LAM DO 50 I = 1,N GN(I) = S(I) - P*GN(I) 50 CONTINUE DO 60 I = 1,NF GV(I) = LAM*G(I) + P*GV(I) 60 CONTINUE ELSE IF (KBF.GT.0) THEN K = 0 DO 70 I = 1,NF IF (IX(I).GE.0) THEN K = K + 1 Q = G(I) - GV(I) P = P + S(I)*Q S(K) = Q END IF 70 CONTINUE Q = 0.0D0 K = 0 DO 100 I = 1,NF IF (IX(I).GE.0) THEN K = K + 1 L = K* (K-1)/2 + 1 W = 0.0D0 DO 80 J = 1,K - 1 W = W + H(L)*S(J) L = L + 1 80 CONTINUE DO 90 J = K,N W = W + H(L)*S(J) L = L + J 90 CONTINUE Q = Q + W*S(K) END IF 100 CONTINUE LAM = 0.5D0 + SIGN(0.5D0,P) IF (Q.GT.0.0D0) LAM = MIN(1.0D0,MAX(0.0D0,P/Q)) P = 1.0D0 - LAM K = 0 DO 110 I = 1,NF GV(I) = LAM*G(I) + P*GV(I) IF (IX(I).GE.0) THEN K = K + 1 GN(K) = GV(I) END IF 110 CONTINUE ELSE DO 120 I = 1,NF GV(I) = G(I) - GV(I) P = P + S(I)*GV(I) 120 CONTINUE Q = 0.0D0 DO 150 I = 1,NF L = I* (I-1)/2 + 1 W = 0.0D0 DO 130 J = 1,I - 1 W = W + H(L)*GV(J) L = L + 1 130 CONTINUE DO 140 J = I,NF W = W + H(L)*GV(J) L = L + J 140 CONTINUE Q = Q + W*GV(I) 150 CONTINUE LAM = 0.5D0 + SIGN(0.5D0,P) IF (Q.GT.0.0D0) LAM = MIN(1.0D0,MAX(0.0D0,P/Q)) P = 1.0D0 - LAM DO 160 I = 1,NF GV(I) = G(I) - P*GV(I) 160 CONTINUE END IF ALFV = LAM*ALF + P*ALFV RETURN END * SUBROUTINE PYBUN1 ALL SYSTEMS 97/12/01 * PORTABILITY : ALL SYSTEMS * 97/12/01 VL : ORIGINAL VERSION * * PURPOSE : * VARIABLE METRIC UPDATE OF A DENSE SYMMETRIC POSITIVE DEFINITE MATRIX * WITH THE POSSIBILITY OF MATRIX INNOVATION. * * PARAMETERS : * II N ACTUAL NUMBER OF VARIABLES. * II MA DECLARED NUMBER OF LINEAR APPROXIMATED FUNCTIONS. * II MAL CURRENT NUMBER OF LINEAR APPROXIMATED FUNCTIONS. * RI X(N) VECTOR OF VARIABLES. * RI G(N) SUBGRADIENT OF THE OBJECTIVE FUNCTION. * RI F VALUE OF THE OBJECTIVE FUNCTION. * RU AY(N*MA) MATRIX WHOSE COLUMNS ARE VARIABLE VECTORS. * RU AG(N*MA) MATRIX WHOSE COLUMNS ARE BUNDLE SUBGRADIENTS. * RU AF(4*MA) VECTOR OF VALUES OF BUNDLE FUNCTIONS. * IO ITERS NULL STEP INDICATOR. ITERS=0-NULL STEP. ITERS=1-DESCENT * STEP. * * SUBPROGRAMS USED : * RF MXVDOT DOT PRODUCT OF VECTORS. * SUBROUTINE PYBUN1(N,MA,MAL,X,G,F,AY,AG,AF,ITERS) C .. Scalar Arguments .. DOUBLE PRECISION F INTEGER ITERS,MA,MAL,N C .. C .. Array Arguments .. DOUBLE PRECISION AF(*),AG(*),AY(*),G(*),X(*) C .. C .. Local Scalars .. INTEGER I,IND,K,KN,L C .. C .. External Subroutines .. EXTERNAL MXVCOP C .. L = 0 IF (ITERS.EQ.0) L = 1 * * BUNDLE REDUCTION * KN = 0 IF (MAL.GE.MA) THEN DO 20 K = 1,MAL - 1 KN = K*N - N DO 10 I = 1,N IF (G(I).NE.AG(KN+I)) GO TO 20 10 CONTINUE IND = K GO TO 30 20 CONTINUE IND = 1 30 DO 40 K = IND,MAL - 1 AF(K) = AF(K+1) AF(K+MA*3) = AF(K+1+MA*3) KN = K*N + 1 CALL MXVCOP(N,AG(KN),AG(KN-N)) CALL MXVCOP(N,AY(KN),AY(KN-N)) 40 CONTINUE MAL = MAL - 1 END IF * * BUNDLE COMPLETION * IF (L.GT.0 .AND. KN.EQ.0) THEN AF(MAL+1) = AF(MAL) AF(3*MA+MAL+1) = AF(3*MA+MAL) KN = MAL*N + 1 CALL MXVCOP(N,AG(KN-N),AG(KN)) CALL MXVCOP(N,AY(KN-N),AY(KN)) END IF MAL = MAL + 1 KN = MAL - L AF(KN) = F AF(KN+MA*3) = L K = (KN-1)*N + 1 CALL MXVCOP(N,G,AG(K)) CALL MXVCOP(N,X,AY(K)) RETURN END * SUBROUTINE PYRMB1 ALL SYSTEMS 98/12/01 * PORTABILITY : ALL SYSTEMS * 98/12/01 LU : ORIGINAL VERSION * * PURPOSE : * OLD LINEAR CONSTRAINT OR AN OLD SIMPLE BOUND IS REMOVED FROM THE * ACTIVE SET. TRANSFORMED GRADIENT OF THE OBJECTIVE FUNCTION AND * TRANSFORMED HESSIAN MATRIX APPROXIMATION ARE UPDATED. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II N ACTUAL NUMBER OF VARIABLES. * IU IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. * IU IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * IU ICA(NF) VECTOR CONTAINING INDICES OF ACTIVE CONSTRAINTS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RU CR(NF*(NF+1)/2) TRIANGULAR DECOMPOSITION OF KERNEL OF THE * ORTHOGONAL PROJECTION. * RU CZ(NF*NF) MATRIX WHOSE COLUMNS ARE BASIC VECTORS FROM THE * CURRENT REDUCED SUBSPACE. * RI G(NF) GRADIENT OF THE OBJECTIVE FUNCTION. * RU GN(NF) TRANSFORMED GRADIENT OF THE OBJECTIVE FUNCTION. * RU H(NF*(NF+1)/2) TRANSFORMED HESSIAN MATRIX APPROXIMATION. * RI EPS8 TOLERANCE FOR CONSTRAINT TO BE REMOVED. * RI UMAX MAXIMUN ABSOLUTE VALUE OF THE NEGATIVE LAGRANGE MULTIPLIER. * RI GMAX NORM OF THE TRANSFORMED GRADIENT. * II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS. * KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS. * II KBC SPECIFICATION OF LINEAR CONSTRAINTS. KBC=0-NO LINEAR * CONSTRAINTS. KBC=1-ONE SIDED LINEAR CONSTRAINTS. KBC=2=TWO * SIDED LINEAR CONSTRAINTS. * II IOLD INDEX OF THE REMOVED CONSTRAINT. * IA KOLD AUXILIARY VARIABLE. * IA KREM AUXILIARY VARIABLE. * IO IER ERROR INDICATOR. * IO ITERM TERMINATION INDICATOR. * * COMMON DATA : * IU NREM NUMBER OF CONSTRAINT DELETIONS. * * SUBPROGRAMS USED : * S PLRMB0 CONSTRAINT DELETION. * S MXVSET INITIATION OF A VECTOR. * SUBROUTINE PYRMB1(NF,N,IX,IC,ICA,CG,CR,CZ,G,GN,H,EPS8,UMAX,GMAX, + KBF,KBC,IOLD,KOLD,KREM,IER,ITERM) C .. Scalar Arguments .. DOUBLE PRECISION EPS8,GMAX,UMAX INTEGER IER,IOLD,ITERM,KBC,KBF,KOLD,KREM,N,NF C .. C .. Array Arguments .. DOUBLE PRECISION CG(*),CR(*),CZ(*),G(*),GN(*),H(*) INTEGER IC(*),ICA(*),IX(*) C .. C .. Scalars in Common .. INTEGER NADD,NDECF,NFG,NFH,NFV,NIT,NRED,NREM,NRES C .. C .. Local Scalars .. INTEGER I,J,K,KC,L C .. C .. External Subroutines .. EXTERNAL MXVSET,PLRMB0 C .. C .. Intrinsic Functions .. INTRINSIC ABS,MIN C .. C .. Common blocks .. COMMON /STAT/NDECF,NRES,NRED,NREM,NADD,NIT,NFV,NFG,NFH C .. IF (KBC.GT.0) THEN IF (UMAX.GT.EPS8*GMAX) THEN CALL PLRMB0(NF,N,ICA,CG,CR,CZ,G,GN,IOLD,KREM,NREM,IER) IF (IER.LT.0) THEN ITERM = -16 ELSE IF (IER.GT.0) THEN IOLD = 0 ELSE K = N* (N-1)/2 CALL MXVSET(N,0.0D0,H(K+1)) H(K+N) = 1.0D0 KC = ICA(NF-N+1) IF (KC.GT.0) THEN IC(KC) = -IC(KC) ELSE K = -KC IX(K) = -IX(K) END IF END IF ELSE IOLD = 0 END IF ELSE IF (KBF.GT.0) THEN IF (UMAX.GT.EPS8*GMAX) THEN IX(IOLD) = MIN(ABS(IX(IOLD)),3) DO 10 I = N,KOLD,-1 GN(I+1) = GN(I) 10 CONTINUE GN(KOLD) = G(IOLD) N = N + 1 K = N* (N-1)/2 L = K + N DO 30 I = N,KOLD,-1 DO 20 J = I,1,-1 IF (I.NE.KOLD .AND. J.NE.KOLD) THEN H(L) = H(K) K = K - 1 L = L - 1 ELSE IF (I.EQ.KOLD .AND. J.EQ.KOLD) THEN H(L) = 1.0D0 L = L - 1 ELSE H(L) = 0.0D0 L = L - 1 END IF 20 CONTINUE 30 CONTINUE ELSE IOLD = 0 KOLD = 0 END IF END IF RETURN END * SUBROUTINE PYTRBD ALL SYSTEMS 98/12/01 * PORTABILITY : ALL SYSTEMS * 98/12/01 LU : ORIGINAL VERSION * * PURPOSE : * VECTORS OF VARIABLES DIFFERENCE AND GRADIENTS DIFFERENCE ARE COMPUTED * AND TRANSFORMED. TEST VALUE DMAX IS DETERMINED. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II N ACTUAL NUMBER OF VARIABLES. * RI X(NF) VECTOR OF VARIABLES. * RU XO(NF) VECTORS OF VARIABLES DIFFERENCE. * RI G(NF) GRADIENT OF THE OBJECTIVE FUNCTION. * RU GO(NF) GRADIENTS DIFFERENCE. * RI CZ(NF*NF) MATRIX WHOSE COLUMNS ARE BASIC VECTORS FROM CURRENT * REDUCED SUBSPACE. * RU SN(NF) TRANSFORMED DIRECTION VECTOR. * RI R VALUE OF THE STEPSIZE PARAMETER. * RU F NEW VALUE OF THE OBJECTIVE FUNCTION. * RI FO OLD VALUE OF THE OBJECTIVE FUNCTION. * RU P NEW VALUE OF THE DIRECTIONAL DERIVATIVE. * RU PO OLD VALUE OF THE DIRECTIONAL DERIVATIVE. * RO DMAX MAXIMUM RELATIVE DIFFERENCE OF VARIABLES. * II ITERS TERMINATION INDICATOR FOR STEPLENGTH DETERMINATION. * ITERS=0 FOR ZERO STEP. * II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS. * KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS. * II KBC SPECIFICATION OF LINEAR CONSTRAINTS. KBC=0-NO LINEAR * CONSTRAINTS. KBC=1-ONE SIDED LINEAR CONSTRAINTS. KBC=2=TWO * SIDED LINEAR CONSTRAINTS. * * SUBPROGRAMS USED : * S MXDRMM PREMULTIPLICATION OF A VECTOR BY TRANSPOSE OF A DENSE * RECTANGULAR MATRIX. * S MXVCOP COPYING OF A VECTOR. * S MXVDIF DIFFERENCE OF TWO VECTORS. * S MXVMUL DIAGONAL PREMULTIPLICATION OF A VECTOR. * S MXVSAV DIFFERENCE OF TWO VECTORS WITH COPYING AND SAVING THE * SUBSTRACTED ONE. * S MXVSCL SCALING OF A VECTOR. * SUBROUTINE PYTRBD(NF,N,X,IX,XO,G,GO,CZ,SN,R,F,FO,P,PO,DMAX,ITERS, + KBF,KBC) C .. Scalar Arguments .. DOUBLE PRECISION DMAX,F,FO,P,PO,R INTEGER ITERS,KBC,KBF,N,NF C .. C .. Array Arguments .. DOUBLE PRECISION CZ(*),G(*),GO(*),SN(*),X(*),XO(*) INTEGER IX(*) C .. C .. Local Scalars .. INTEGER I,K C .. C .. External Subroutines .. EXTERNAL MXDRMM,MXVCOP,MXVDIF,MXVSAV,MXVSCL C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX C .. IF (ITERS.GT.0) THEN CALL MXVDIF(NF,X,XO,XO) CALL MXVDIF(NF,G,GO,GO) PO = R*PO P = R*P ELSE F = FO P = PO CALL MXVSAV(NF,X,XO) CALL MXVSAV(NF,G,GO) END IF DMAX = 0.0D0 IF (KBC.GT.0) THEN DO 10 I = 1,NF DMAX = MAX(DMAX,ABS(XO(I))/MAX(ABS(X(I)),1.0D0)) 10 CONTINUE IF (N.GT.0) THEN CALL MXVSCL(N,R,SN,XO) CALL MXVCOP(NF,GO,SN) CALL MXDRMM(NF,N,CZ,SN,GO) END IF ELSE IF (KBF.GT.0) THEN K = 0 DO 20 I = 1,NF IF (IX(I).LT.0) GO TO 20 K = K + 1 DMAX = MAX(DMAX,ABS(XO(I))/MAX(ABS(X(I)),1.0D0)) XO(K) = XO(I) GO(K) = GO(I) 20 CONTINUE ELSE DO 30 I = 1,NF DMAX = MAX(DMAX,ABS(XO(I))/MAX(ABS(X(I)),1.0D0)) 30 CONTINUE END IF RETURN END * SUBROUTINE PYTRBG ALL SYSTEMS 98/12/01 * PORTABILITY : ALL SYSTEMS * 98/12/01 LU : ORIGINAL VERSION * * PURPOSE : * GRADIENT OF THE OBJECTIVE FUNCTION IS SCALED AND REDUCED. * TEST VALUES GMAX AND UMAX ARE COMPUTED. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II N ACTUAL NUMBER OF VARIABLES. * II NC NUMBER OF CONSTRAINTS. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * II ICA(NF) VECTOR CONTAINING INDICES OF ACTIVE CONSTRAINTS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RI CR(NF*(NF+1)/2) TRIANGULAR DECOMPOSITION OF KERNEL OF THE * ORTHOGONAL PROJECTION. * RU CZ(NF*NF) MATRIX WHOSE COLUMNS ARE BASIC VECTORS FROM THE * CURRENT REDUCED SUBSPACE. * RI G(NF) GRADIENT OF THE OBJECTIVE FUNCTION. * RO GN(NF) TRANSFORMED GRADIENT OF THE OBJECTIVE FUNCTION. * RI EPS7 TOLERANCE FOR LINEAR INDEPENDENCE OF CONSTRAINTS. * RO UMAX MAXIMUM ABSOLUTE VALUE OF THE NEGATIVE LAGRANGE MULTIPLIER. * RO GMAX NORM OF THE TRANSFORMED GRADIENT. * II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS. * KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS. * II KBC SPECIFICATION OF LINEAR CONSTRAINTS. KBC=0-NO LINEAR * CONSTRAINTS. KBC=1-ONE SIDED LINEAR CONSTRAINTS. KBC=2=TWO * SIDED LINEAR CONSTRAINTS. * II IOLD INDEX OF THE REMOVED CONSTRAINT. * IA KOLD AUXILIARY VARIABLE. * * SUBPROGRAMS USED : * S MXDRMM PREMULTIPLICATION OF A VECTOR BY A ROWWISE STORED DENSE * RECTANGULAR MATRIX. * S MXDPRB BACK SUBSTITUTION. * S MXVCOP COPYING OF A VECTOR. * RF MXVDOT DOT PRODUCT OF TWO VECTORS. * RF MXVMAX L-INFINITY NORM OF A VECTOR. * S MXVMUL DIAGONAL PREMULTIPLICATION OF A VECTOR. * SUBROUTINE PYTRBG(NF,N,NC,IX,IC,ICA,CG,CR,CZ,G,GN,UMAX,GMAX,KBF, + KBC,IOLD,KOLD) C .. Scalar Arguments .. DOUBLE PRECISION GMAX,UMAX INTEGER IOLD,KBC,KBF,KOLD,N,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION CG(*),CR(*),CZ(*),G(*),GN(*) INTEGER IC(NC),ICA(NF),IX(*) C .. C .. Local Scalars .. DOUBLE PRECISION TEMP INTEGER I,J,K,KC,NCA,NCZ C .. C .. External Functions .. DOUBLE PRECISION MXVDOT,MXVMAX EXTERNAL MXVDOT,MXVMAX C .. C .. External Subroutines .. EXTERNAL MXDPRB,MXDRMM,MXVCOP C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX C .. IOLD = 0 KOLD = 0 UMAX = 0.0D0 GMAX = 0.0D0 IF (KBC.GT.0) THEN IF (NF.GT.N) THEN NCA = NF - N NCZ = N*NF CALL MXVCOP(NF,G,GN) DO 10 J = 1,NCA K = ICA(J) IF (K.GT.0) THEN CZ(NCZ+J) = MXVDOT(NF,CG((K-1)*NF+1),GN) ELSE I = -K CZ(NCZ+J) = GN(I) END IF 10 CONTINUE CALL MXDPRB(NCA,CR,CZ(NCZ+1),0) DO 20 J = 1,NCA TEMP = CZ(NCZ+J) KC = ICA(J) IF (KC.GT.0) THEN K = IC(KC) ELSE I = -KC K = IX(I) END IF IF (K.LE.-5) THEN ELSE IF ((K.EQ.-1.OR.K.EQ.-3) .AND. + UMAX+TEMP.GE.0.0D0) THEN ELSE IF ((K.EQ.-2.OR.K.EQ.-4) .AND. + UMAX-TEMP.GE.0.0D0) THEN ELSE IOLD = J UMAX = ABS(TEMP) END IF 20 CONTINUE END IF IF (N.GT.0) THEN CALL MXDRMM(NF,N,CZ,G,GN) GMAX = MXVMAX(N,GN) END IF ELSE IF (KBF.GT.0) THEN J = 0 IOLD = 0 KOLD = 0 DO 30 I = 1,NF TEMP = G(I) K = IX(I) IF (K.GE.0) THEN J = J + 1 GN(J) = TEMP GMAX = MAX(GMAX,ABS(TEMP)) ELSE IF (K.LE.-5) THEN ELSE IF ((K.EQ.-1.OR.K.EQ.-3) .AND. + UMAX+TEMP.GE.0.0D0) THEN ELSE IF ((K.EQ.-2.OR.K.EQ.-4) .AND. + UMAX-TEMP.GE.0.0D0) THEN ELSE IOLD = I KOLD = J + 1 UMAX = ABS(TEMP) END IF 30 CONTINUE N = J ELSE DO 40 I = 1,NF TEMP = G(I) GMAX = MAX(GMAX,ABS(TEMP)) 40 CONTINUE N = NF END IF RETURN END * SUBROUTINE PYTRBS ALL SYSTEMS 98/12/01 * PORTABILITY : ALL SYSTEMS * 98/12/01 LU : ORIGINAL VERSION * * PURPOSE : * SCALED AND REDUCED DIRECTION VECTOR IS BACK TRANSFORMED. * VECTORS X,G AND VALUES F,P ARE SAVED. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * IU N ACTUAL NUMBER OF VARIABLES. * II NC NUMBER OF LINEARIZED CONSTRAINTS. * RI X(NF) VECTOR OF VARIABLES. * II IX(NF) VECTOR CONTAINING TYPES OF BOUNDS. * RO XO(NF) SAVED VECTOR OF VARIABLES. * RI XL(NF) VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES. * RI XU(NF) VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES. * RI G(NF) GRADIENT OF THE OBJECTIVE FUNCTION. * RO GO(NF) SAVED GRADIENT OF THE OBJECTIVE FUNCTION. * RI CF(NF) VECTOR CONTAINING VALUES OF THE CONSTRAINT FUNCYIONS. * RO CFD(NF) VECTOR CONTAINING INCREMENTS OF THE CONSTRAINT * FUNCTIONS. * II IC(NC) VECTOR CONTAINING TYPES OF CONSTRAINTS. * RI CL(NC) VECTOR CONTAINING LOWER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CU(NC) VECTOR CONTAINING UPPER BOUNDS FOR CONSTRAINT FUNCTIONS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RI CZ(NF*NF) MATRIX WHOSE COLUMNS ARE BASIC VECTORS FROM THE * CURRENT REDUCED SUBSPACE. * RI SN(NF) TRANSFORMED DIRECTION VECTOR. * RO S(NF) DIRECTION VECTOR. * RO RO SAVED VALUE OF THE STEPSIZE PARAMETER. * RO FP PREVIOUS VALUE OF THE OBJECTIVE FUNCTION. * RU FO SAVED VALUE OF THE OBJECTIVE FUNCTION. * RI F VALUE OF THE OBJECTIVE FUNCTION. * RO PO SAVED VALUE OF THE DIRECTIONAL DERIVATIVE. * RI P VALUE OF THE DIRECTIONAL DERIVATIVE. * RU RMAX MAXIMUM VALUE OF THE STEPSIZE PARAMETER. * II KBF SPECIFICATION OF SIMPLE BOUNDS. KBF=0-NO SIMPLE BOUNDS. * KBF=1-ONE SIDED SIMPLE BOUNDS. KBF=2=TWO SIDED SIMPLE BOUNDS. * II KBC SPECIFICATION OF LINEAR CONSTRAINTS. KBC=0-NO LINEAR * CONSTRAINTS. KBC=1-ONE SIDED LINEAR CONSTRAINTS. KBC=2=TWO * SIDED LINEAR CONSTRAINTS. * IO KREM INDICATION OF LINEARLY DEPENDENT GRADIENTS. * IO INEW INDEX OF THE NEW ACTIVE FUNCTION. * * SUBPROGRAMS USED : * S PLMAXS DETERMINATION OF THE MAXIMUM STEPSIZE USING SIMPLE * BOUNDS. * S PLMAXL DETERMINATION OF THE MAXIMUM STEPSIZE USING LINEAR * CONSTRAINTS. * S MXDCMM MATRIX VECTOR PRODUCT. * S MXVCOP COPYING OF A VECTOR. * S MXVSET INITIATION OF A VECTOR. * SUBROUTINE PYTRBS(NF,N,NC,X,IX,XO,XL,XU,G,GO,CF,CFD,IC,CL,CU,CG, + CZ,SN,S,RO,FP,FO,F,PO,P,RMAX,KBF,KBC,KREM,INEW) C .. Scalar Arguments .. DOUBLE PRECISION F,FO,FP,P,PO,RMAX,RO INTEGER INEW,KBC,KBF,KREM,N,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION CF(*),CFD(*),CG(*),CL(*),CU(*),CZ(*),G(*),GO(*), + S(*),SN(*),X(*),XL(*),XO(*),XU(*) INTEGER IC(*),IX(*) C .. C .. Local Scalars .. INTEGER I,K C .. C .. External Subroutines .. EXTERNAL MXDCMM,MXVCOP,MXVSET,PLMAXL,PLMAXS C .. FP = FO RO = 0.0D0 FO = F PO = P CALL MXVCOP(NF,X,XO) CALL MXVCOP(NF,G,GO) IF (KBC.GT.0) THEN IF (N.GT.0) THEN CALL MXDCMM(NF,N,CZ,SN,S) INEW = 0 CALL PLMAXL(NF,NC,CF,CFD,IC,CL,CU,CG,S,RMAX,KBC,KREM,INEW) CALL PLMAXS(NF,X,IX,XL,XU,S,RMAX,KBF,KREM,INEW) ELSE CALL MXVSET(NF,0.0D0,S) END IF ELSE IF (KBF.GT.0) THEN K = N + 1 DO 10 I = NF,1,-1 IF (IX(I).LT.0) THEN S(I) = 0.0D0 ELSE K = K - 1 S(I) = SN(K) END IF 10 CONTINUE INEW = 0 CALL PLMAXS(NF,X,IX,XL,XU,S,RMAX,KBF,KREM,INEW) END IF RETURN END * SUBROUTINE PYTRFD ALL SYSTEMS 90/12/01 * PORTABILITY : ALL SYSTEMS * 90/12/01 LU : ORIGINAL VERSION * * PURPOSE : * PREPARATION OF VARIABLE METRIC UPDATE. * * PARAMETERS : * II NF DECLARED NUMBER OF VARIABLES. * II NC NUMBER OF CONSTRAINTS. * RI X(NF) VECTOR OF VARIABLES. * RU XO(NF) SAVED VECTOR OF VARIABLES. * II IAA(NF+1) VECTOR CONTAINING INDICES OF ACTIVE FUNCTIONS. * RI AG(NF*NA) MATRIX WHOSE COLUMNS ARE GRADIENTS OF THE LINEAR * APPROXIMATED FUNCTIONS. * RI AZ(NF+1) VECTOR OF LAGRANGE MULTIPLIERS. * RI CG(NF*NC) MATRIX WHOSE COLUMNS ARE NORMALS OF THE LINEAR * CONSTRAINTS. * RI G(NF) GRADIENT OF THE LAGRANGIAN FUNCTION. * RU GO(NF) SAVED GRADIENT OF THE LAGRANGIAN FUNCTION. * II N ACTUAL NUMBER OF VARIABLES. * II KD DEGREE OF REQUIRED DERVATIVES. * IU LD DEGREE OF PREVIOUSLY COMPUTED DERIVATIVES. * RU R VALUE OF THE STEPSIZE PARAMETER. * RU F VALUE OF THE OBJECTIVE FUNCTION. * RI FO SAVED VALUE OF THE OBJECTIVE FUNCTION. * RU P VALUE OF THE DIRECTIONAL DERIVATIVE. * RU PO SAVED VALUE OF THE DIRECTIONAL DERIVATIVE. * RO DMAX RELATIVE STEPSIZE. * IO ITERS TERMINATION INDICATOR. ITERS=0-ZERO STEP. ITERS=1-PERFECT * LINE SEARCH. ITERS=2 GOLDSTEIN STEPSIZE. ITERS=3-CURRY * STEPSIZE. ITERS=4-EXTENDED CURRY STEPSIZE. * ITERS=5-ARMIJO STEPSIZE. ITERS=6-FIRST STEPSIZE. * ITERS=7-MAXIMUM STEPSIZE. ITERS=8-UNBOUNDED FUNCTION. * ITERS=-1-MRED REACHED. ITERS=-2-POSITIVE DIRECTIONAL * DERIVATIVE. ITERS=-3-ERROR IN INTERPOLATION. * * SUBPROGRAMS USED : * S MXVCOP COPYING OF A VECTOR. * S MXVDIF DIFFERENCE OF TWO VECTORS. * S MXVDIR VECTOR AUGMENTED BY THE SCALED VECTOR. * S MXVSET INITIATION OF A VECTOR. * S MXVSAV DIFFERENCE OF TWO VECTORS WITH COPYING AND SAVING THE * SUBSTRACTED ONE. * SUBROUTINE PYTRFD(NF,NC,X,XO,IAA,AG,AZ,CG,G,GO,N,KD,LD,R,F,FO,P, + PO,DMAX,ITERS) C .. Scalar Arguments .. DOUBLE PRECISION DMAX,F,FO,P,PO,R INTEGER ITERS,KD,LD,N,NC,NF C .. C .. Array Arguments .. DOUBLE PRECISION AG(*),AZ(*),CG(*),G(*),GO(*),X(*),XO(*) INTEGER IAA(*) C .. C .. Local Scalars .. INTEGER I,J,L C .. C .. External Subroutines .. EXTERNAL MXVDIF,MXVDIR,MXVSAV,MXVSET C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX C .. CALL MXVSET(NF,0.0D0,G) DO 10 J = 1,NF - N L = IAA(J) IF (L.GT.NC) THEN L = L - NC CALL MXVDIR(NF,-AZ(J),AG((L-1)*NF+1),G,G) ELSE IF (L.GT.0) THEN CALL MXVDIR(NF,-AZ(J),CG((L-1)*NF+1),G,G) ELSE L = -L G(L) = G(L) - AZ(J) END IF 10 CONTINUE IF (ITERS.GT.0) THEN CALL MXVDIF(NF,X,XO,XO) CALL MXVDIF(NF,G,GO,GO) PO = R*PO P = R*P ELSE R = 0.0D0 F = FO P = PO CALL MXVSAV(NF,X,XO) CALL MXVSAV(NF,G,GO) LD = KD END IF DMAX = 0.0D0 DO 20 I = 1,NF DMAX = MAX(DMAX,ABS(XO(I))/MAX(ABS(X(I)),1.0D0)) 20 CONTINUE N = NF RETURN END * SUBROUTINE MXDCMM ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * MULTIPLICATION OF A COLUMNWISE STORED DENSE RECTANGULAR MATRIX A * BY A VECTOR X. * * PARAMETERS : * II N NUMBER OF ROWS OF THE MATRIX A. * II M NUMBER OF COLUMNS OF THE MATRIX A. * RI A(N*M) RECTANGULAR MATRIX STORED COLUMNWISE IN THE * ONE-DIMENSIONAL ARRAY. * RI X(M) INPUT VECTOR. * RO Y(N) OUTPUT VECTOR EQUAL TO A*X. * * SUBPROGRAMS USED : * S MXVDIR VECTOR AUGMENTED BY THE SCALED VECTOR. * S MXVSET INITIATION OF A VECTOR. * SUBROUTINE MXDCMM(N,M,A,X,Y) C .. Scalar Arguments .. INTEGER M,N C .. C .. Array Arguments .. DOUBLE PRECISION A(*),X(*),Y(*) C .. C .. Local Scalars .. INTEGER J,K C .. C .. External Subroutines .. EXTERNAL MXVDIR,MXVSET C .. CALL MXVSET(N,0.0D0,Y) K = 0 DO 10 J = 1,M CALL MXVDIR(N,X(J),A(K+1),Y,Y) K = K + N 10 CONTINUE RETURN END * SUBROUTINE MXDPGB ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * SOLUTION OF A SYSTEM OF LINEAR EQUATIONS WITH A DENSE SYMMETRIC * POSITIVE DEFINITE MATRIX A+E USING THE FACTORIZATION A+E=L*D*TRANS(L) * OBTAINED BY THE SUBROUTINE MXDPGF. * * PARAMETERS : * II N ORDER OF THE MATRIX A. * RI A(N*(N+1)/2) FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE * SUBROUTINE MXDPGF. * RU X(N) ON INPUT THE RIGHT HAND SIDE OF A SYSTEM OF LINEAR * EQUATIONS. ON OUTPUT THE SOLUTION OF A SYSTEM OF LINEAR * EQUATIONS. * II JOB OPTION. IF JOB=0 THEN X:=(A+E)**(-1)*X. IF JOB>0 THEN * X:=L**(-1)*X. IF JOB<0 THEN X:=TRANS(L)**(-1)*X. * * METHOD : * BACK SUBSTITUTION * SUBROUTINE MXDPGB(N,A,X,JOB) C .. Scalar Arguments .. INTEGER JOB,N C .. C .. Array Arguments .. DOUBLE PRECISION A(*),X(*) C .. C .. Local Scalars .. INTEGER I,II,IJ,J C .. IF (JOB.GE.0) THEN * * PHASE 1 : X:=L**(-1)*X * IJ = 0 DO 20 I = 1,N DO 10 J = 1,I - 1 IJ = IJ + 1 X(I) = X(I) - A(IJ)*X(J) 10 CONTINUE IJ = IJ + 1 20 CONTINUE END IF IF (JOB.EQ.0) THEN * * PHASE 2 : X:=D**(-1)*X * II = 0 DO 30 I = 1,N II = II + I X(I) = X(I)/A(II) 30 CONTINUE END IF IF (JOB.LE.0) THEN * * PHASE 3 : X:=TRANS(L)**(-1)*X * II = N* (N-1)/2 DO 50 I = N - 1,1,-1 IJ = II DO 40 J = I + 1,N IJ = IJ + J - 1 X(I) = X(I) - A(IJ)*X(J) 40 CONTINUE II = II - I 50 CONTINUE END IF RETURN END * SUBROUTINE MXDPGF ALL SYSTEMS 89/12/01 * PORTABILITY : ALL SYSTEMS * 89/12/01 LU : ORIGINAL VERSION * * PURPOSE : * FACTORIZATION A+E=L*D*TRANS(L) OF A DENSE SYMMETRIC POSITIVE DEFINITE * MATRIX A+E WHERE D AND E ARE DIAGONAL POSITIVE DEFINITE MATRICES AND * L IS A LOWER TRIANGULAR MATRIX. IF A IS SUFFICIENTLY POSITIVE * DEFINITE THEN E=0. * * PARAMETERS : * II N ORDER OF THE MATRIX A. * RU A(N*(N+1)/2) ON INPUT A GIVEN DENSE SYMMETRIC (USUALLY POSITIVE * DEFINITE) MATRIX A STORED IN THE PACKED FORM. ON OUTPUT THE * COMPUTED FACTORIZATION A+E=L*D*TRANS(L). * IO INF AN INFORMATION OBTAINED IN THE FACTORIZATION PROCESS. IF * INF=0 THEN A IS SUFFICIENTLY POSITIVE DEFINITE AND E=0. IF * INF<0 THEN A IS NOT SUFFICIENTLY POSITIVE DEFINITE AND E>0. IF * INF>0 THEN A IS INDEFINITE AND INF IS AN INDEX OF THE * MOST NEGATIVE DIAGONAL ELEMENT USED IN THE FACTORIZATION * PROCESS. * RU ALF ON INPUT A DESIRED TOLERANCE FOR POSITIVE DEFINITENESS. ON * OUTPUT THE MOST NEGATIVE DIAGONAL ELEMENT USED IN THE * FACTORIZATION PROCESS (IF INF>0). * RO TAU MAXIMUM DIAGONAL ELEMENT OF THE MATRIX E. * * METHOD : * P.E.GILL, W.MURRAY : NEWTON TYPE METHODS FOR UNCONSTRAINED AND * LINEARLY CONSTRAINED OPTIMIZATION, MATH. PROGRAMMING 28 (1974) * PP. 311-350. * SUBROUTINE MXDPGF(N,A,INF,ALF,TAU) C .. Scalar Arguments .. DOUBLE PRECISION ALF,TAU INTEGER INF,N C .. C .. Array Arguments .. DOUBLE PRECISION A(*) C .. C .. Local Scalars .. DOUBLE PRECISION BET,DEL,GAM,RHO,SIG,TOL INTEGER I,IJ,IK,J,K,KJ,KK,L C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX C .. L = 0 INF = 0 TOL = ALF * * ESTIMATION OF THE MATRIX NORM * ALF = 0.0D0 BET = 0.0D0 GAM = 0.0D0 TAU = 0.0D0 KK = 0 DO 20 K = 1,N KK = KK + K BET = MAX(BET,ABS(A(KK))) KJ = KK DO 10 J = K + 1,N KJ = KJ + J - 1 GAM = MAX(GAM,ABS(A(KJ))) 10 CONTINUE 20 CONTINUE BET = MAX(TOL,BET,GAM/N) * DEL = TOL*BET DEL = TOL*MAX(BET,1.0D0) KK = 0 DO 60 K = 1,N KK = KK + K * * DETERMINATION OF A DIAGONAL CORRECTION * SIG = A(KK) IF (ALF.GT.SIG) THEN ALF = SIG L = K END IF GAM = 0.0D0 KJ = KK DO 30 J = K + 1,N KJ = KJ + J - 1 GAM = MAX(GAM,ABS(A(KJ))) 30 CONTINUE GAM = GAM*GAM RHO = MAX(ABS(SIG),GAM/BET,DEL) IF (TAU.LT.RHO-SIG) THEN TAU = RHO - SIG INF = -1 END IF * * GAUSSIAN ELIMINATION * A(KK) = RHO KJ = KK DO 50 J = K + 1,N KJ = KJ + J - 1 GAM = A(KJ) A(KJ) = GAM/RHO IK = KK IJ = KJ DO 40 I = K + 1,J IK = IK + I - 1 IJ = IJ + 1 A(IJ) = A(IJ) - A(IK)*GAM 40 CONTINUE 50 CONTINUE 60 CONTINUE IF (L.GT.0 .AND. ABS(ALF).GT.DEL) INF = L RETURN END * SUBROUTINE MXDPGI ALL SYSTEMS 89/12/01 * PORTABILITY : ALL SYSTEMS * 89/12/01 LU : ORIGINAL VERSION * * PURPOSE : * INVERSION OF A DENSE SYMMETRIC MATRIX A+E USING THE DECOMPOSITION * A+E=L*D*TRANS(D) OBTAINED BY THE SUBROUTINE MXDPGF. * * PARAMETERS : * II N ORDER OF THE MATRIX A * RU A(N*(N+1)/2) ON INPUT THE DECOMPOSITION A+E=L*D*TRANS(L) * OBTAINED BY THE SUBROUTINE MXDPGF. * ON OUTPUT THE INVERSION (A+E)**(-1). * * METHOD : * INVERSION OF THE LOWER TRIANGULAR MATRIX L AND BACK MULTIPLICATION * (A+E)**(-1) = TRANS(L)**(-1)*D**(-1)*L**(-1). * SUBROUTINE MXDPGI(N,A) * * INVERSION OF THE LOWER TRIANGULAR MATRIX L * C .. Scalar Arguments .. INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION A(*) C .. C .. Local Scalars .. DOUBLE PRECISION AII,AIJ,AIK INTEGER I,II,IJ,IK,J,JJ,K,KJ,KK C .. II = 0 DO 30 I = 1,N II = II + I A(II) = 1.0D0/A(II) IJ = II DO 20 J = I + 1,N IJ = IJ + J - 1 AIJ = -A(IJ) IK = II KJ = IJ DO 10 K = I + 1,J - 1 IK = IK + K - 1 KJ = KJ + 1 AIJ = AIJ - A(IK)*A(KJ) 10 CONTINUE A(IJ) = AIJ 20 CONTINUE 30 CONTINUE * * BACK MULTIPLICATION (A+E)**(-1)= TRANS(L**(-1))*D**(-1)*L**(-1) * II = 0 DO 70 I = 1,N II = II + I AII = A(II) IK = II KK = II DO 40 K = I + 1,N IK = IK + K - 1 KK = KK + K AIK = A(IK)*A(KK) AII = AII + A(IK)*AIK A(IK) = AIK 40 CONTINUE A(II) = AII IJ = II JJ = II DO 60 J = I + 1,N IJ = IJ + J - 1 JJ = JJ + J AIJ = A(IJ) IK = IJ KJ = JJ DO 50 K = J + 1,N IK = IK + K - 1 KJ = KJ + K - 1 AIJ = AIJ + A(IK)*A(KJ) 50 CONTINUE A(IJ) = AIJ 60 CONTINUE 70 CONTINUE RETURN END DOUBLE PRECISION * FUNCTION MXDPGP ALL SYSTEMS 91/12/01 C PORTABILITY : ALL SYSTEMS C 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * COMPUTATION OF THE NUMBER UXDPGP=TRANS(X)*D**(-1)*Y WHERE D IS A * DIAGONAL MATRIX IN THE FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE * SUBROUTINE UXDPGF. * * PARAMETERS : * II N ORDER OF THE MATRIX A. * RI A(N*(N+1)/2) FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE * SUBROUTINE UXDPGF. * RI X(N) INPUT VECTOR. * RI Y(N) INPUT VECTOR. * RR MXDPGP COMPUTED NUMBER UXDPGP=TRANS(X)*D**(-1)*Y. * + FUNCTION MXDPGP(N,A,X,Y) C .. Scalar Arguments .. INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION A(N* (N+1)/2),X(N),Y(N) C .. C .. Local Scalars .. DOUBLE PRECISION TEMP INTEGER I,J C .. J = 0 TEMP = 0.0D0 DO 10 I = 1,N J = J + I TEMP = TEMP + X(I)*Y(I)/A(J) 10 CONTINUE MXDPGP = TEMP RETURN END * SUBROUTINE MXDPGS ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * SCALING OF A DENSE SYMMETRIC POSITIVE DEFINITE MATRIX A+E USING THE * FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE SUBROUTINE MXDPGF. * * PARAMETERS : * II N ORDER OF THE MATRIX A. * RU A(N*(N+1)/2) FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE * SUBROUTINE MXDPGF. * RI ALF SCALING FACTOR. * SUBROUTINE MXDPGS(N,A,ALF) C .. Scalar Arguments .. DOUBLE PRECISION ALF INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION A(*) C .. C .. Local Scalars .. INTEGER I,J C .. J = 0 DO 10 I = 1,N J = J + I A(J) = A(J)*ALF 10 CONTINUE RETURN END * SUBROUTINE MXDPGU ALL SYSTEMS 89/12/01 * PORTABILITY : ALL SYSTEMS * 89/12/01 LU : ORIGINAL VERSION * * PURPOSE : * CORRECTION OF A DENSE SYMMETRIC POSITIVE DEFINITE MATRIX A+E IN THE * FACTORED FORM A+E=L*D*TRANS(L) OBTAINED BY THE SUBROUTINE MXDPGF. * THE CORRECTION IS DEFINED AS A+E:=A+E+ALF*X*TRANS(X) WHERE ALF IS A * GIVEN SCALING FACTOR AND X IS A GIVEN VECTOR. * * PARAMETERS : * II N ORDER OF THE MATRIX A. * RU A(N*(N+1)/2) FACTORIZATION A+E=L*D*TRANS(L) OBTAINED BY THE * SUBROUTINE MXDPGF. * RI ALF SCALING FACTOR IN THE CORRECTION TERM. * RI X(N) VECTOR IN THE CORRECTION TERM. * RA Y(N) AUXILIARY VECTOR. * * METHOD : * P.E.GILL, W.MURRAY, M.SAUNDERS: METHODS FOR COMPUTING AND MODIFYING * THE LDV FACTORS OF A MATRIX, MATH. OF COMP. 29 (1974) PP. 1051-1077. * SUBROUTINE MXDPGU(N,A,ALF,X,Y) C .. Parameters .. DOUBLE PRECISION ZERO,ONE,FOUR,CON PARAMETER (ZERO=0.0D0,ONE=1.0D0,FOUR=4.0D0,CON=1.0D-8) C .. C .. Scalar Arguments .. DOUBLE PRECISION ALF INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION A(*),X(*),Y(*) C .. C .. Local Scalars .. DOUBLE PRECISION B,D,P,R,T,TO INTEGER I,II,IJ,J C .. C .. External Subroutines .. EXTERNAL MXVSCL C .. C .. Intrinsic Functions .. INTRINSIC SQRT C .. IF (ALF.GE.ZERO) THEN * * FORWARD CORRECTION IN CASE WHEN THE SCALING FACTOR IS NONNEGATIVE * ALF = SQRT(ALF) CALL MXVSCL(N,ALF,X,Y) TO = ONE II = 0 DO 30 I = 1,N II = II + I D = A(II) P = Y(I) T = TO + P*P/D R = TO/T A(II) = D/R B = P/ (D*T) IF (A(II).LE.FOUR*D) THEN * * AN EASY FORMULA FOR LIMITED DIAGONAL ELEMENT * IJ = II DO 10 J = I + 1,N IJ = IJ + J - 1 D = A(IJ) Y(J) = Y(J) - P*D A(IJ) = D + B*Y(J) 10 CONTINUE ELSE * * A MORE COMPLICATE BUT NUMERICALLY STABLE FORMULA FOR UNLIMITED * DIAGONAL ELEMENT * IJ = II DO 20 J = I + 1,N IJ = IJ + J - 1 D = A(IJ) A(IJ) = R*D + B*Y(J) Y(J) = Y(J) - P*D 20 CONTINUE END IF TO = T 30 CONTINUE ELSE * * BACKWARD CORRECTION IN CASE WHEN THE SCALING FACTOR IS NEGATIVE * ALF = SQRT(-ALF) CALL MXVSCL(N,ALF,X,Y) TO = ONE IJ = 0 DO 50 I = 1,N D = Y(I) DO 40 J = 1,I - 1 IJ = IJ + 1 D = D - A(IJ)*Y(J) 40 CONTINUE Y(I) = D IJ = IJ + 1 TO = TO - D*D/A(IJ) 50 CONTINUE IF (TO.LE.ZERO) TO = CON II = N* (N+1)/2 DO 70 I = N,1,-1 D = A(II) P = Y(I) T = TO + P*P/D A(II) = D*TO/T B = -P/ (D*TO) TO = T IJ = II DO 60 J = I + 1,N IJ = IJ + J - 1 D = A(IJ) A(IJ) = D + B*Y(J) Y(J) = Y(J) + P*D 60 CONTINUE II = II - I 70 CONTINUE END IF RETURN END * SUBROUTINE MXDPRB ALL SYSTEMS 89/12/01 * PORTABILITY : ALL SYSTEMS * 89/12/01 LU : ORIGINAL VERSION * * PURPOSE : * SOLUTION OF A SYSTEM OF LINEAR EQUATIONS WITH A DENSE SYMMETRIC * POSITIVE DEFINITE MATRIX A USING THE FACTORIZATION A=TRANS(R)*R. * * PARAMETERS : * II N ORDER OF THE MATRIX A. * RI A(N*(N+1)/2) FACTORIZATION A=TRANS(R)*R. * RU X(N) ON INPUT THE RIGHT HAND SIDE OF A SYSTEM OF LINEAR * EQUATIONS. ON OUTPUT THE SOLUTION OF A SYSTEM OF LINEAR * EQUATIONS. * II JOB OPTION. IF JOB=0 THEN X:=A**(-1)*X. IF JOB>0 THEN * X:=TRANS(R)**(-1)*X. IF JOB<0 THEN X:=R**(-1)*X. * * METHOD : * BACK SUBSTITUTION * SUBROUTINE MXDPRB(N,A,X,JOB) C .. Scalar Arguments .. INTEGER JOB,N C .. C .. Array Arguments .. DOUBLE PRECISION A(*),X(*) C .. C .. Local Scalars .. INTEGER I,II,IJ,J C .. IF (JOB.GE.0) THEN * * PHASE 1 : X:=TRANS(R)**(-1)*X * IJ = 0 DO 20 I = 1,N DO 10 J = 1,I - 1 IJ = IJ + 1 X(I) = X(I) - A(IJ)*X(J) 10 CONTINUE IJ = IJ + 1 X(I) = X(I)/A(IJ) 20 CONTINUE END IF IF (JOB.LE.0) THEN * * PHASE 2 : X:=R**(-1)*X * II = N* (N+1)/2 DO 40 I = N,1,-1 IJ = II DO 30 J = I + 1,N IJ = IJ + J - 1 X(I) = X(I) - A(IJ)*X(J) 30 CONTINUE X(I) = X(I)/A(II) II = II - I 40 CONTINUE END IF RETURN END * SUBROUTINE MXDRGR ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * PLANE ROTATION IS APPLIED TO A ROWWISE STORED DENSE RECTANGULAR * MATRIX A. * * PARAMETERS : * II N NUMBER OF COLUMNS OF THE MATRIX A. * II M NUMBER OF ROWS OF THE MATRIX A. * RU A(M*N) RECTANGULAR MATRIX STORED ROWWISE IN THE * ONE-DIMENSIONAL ARRAY. * II K FIRST INDEX OF THE PLANE ROTATION. * II L SECOND INDEX OF THE PLANE ROTATION. * RI CK DIAGONAL ELEMENT OF THE ELEMENTARY ORTHOGONAL MATRIX. * RI CL OFF-DIAGONAL ELEMENT OF THE ELEMENTARY ORTHOGONAL MATRIX. * II IER TYPE OF THE PLANE ROTATION. IER=0-GENERAL PLANE ROTATION. * IER=1-PERMUTATION. IER=2-TRANSFORMATION SUPPRESSED. * * SUBPROGRAMS USED : * S MXVROT PLANE ROTATION APPLIED TO TWO ELEMENTS. * SUBROUTINE MXDRGR(N,A,K,L,CK,CL,IER) C .. Scalar Arguments .. DOUBLE PRECISION CK,CL INTEGER IER,K,L,N C .. C .. Array Arguments .. DOUBLE PRECISION A(*) C .. C .. Local Scalars .. INTEGER I,IK,IL C .. C .. External Subroutines .. EXTERNAL MXVROT C .. IF (IER.NE.0 .AND. IER.NE.1) RETURN IK = (K-1)*N IL = (L-1)*N DO 10 I = 1,N IK = IK + 1 IL = IL + 1 CALL MXVROT(A(IK),A(IL),CK,CL,IER) 10 CONTINUE RETURN END * SUBROUTINE MXDRMM ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * MULTIPLICATION OF A ROWWISE STORED DENSE RECTANGULAR MATRIX A BY * A VECTOR X. * * PARAMETERS : * II N NUMBER OF COLUMNS OF THE MATRIX A. * II M NUMBER OF ROWS OF THE MATRIX A. * RI A(M*N) RECTANGULAR MATRIX STORED ROWWISE IN THE * ONE-DIMENSIONAL ARRAY. * RI X(N) INPUT VECTOR. * RO Y(M) OUTPUT VECTOR EQUAL TO A*X. * SUBROUTINE MXDRMM(N,M,A,X,Y) C .. Scalar Arguments .. INTEGER M,N C .. C .. Array Arguments .. DOUBLE PRECISION A(*),X(*),Y(*) C .. C .. Local Scalars .. DOUBLE PRECISION TEMP INTEGER I,J,K C .. K = 0 DO 20 J = 1,M TEMP = 0.0D0 DO 10 I = 1,N TEMP = TEMP + A(K+I)*X(I) 10 CONTINUE Y(J) = TEMP K = K + N 20 CONTINUE RETURN END * SUBROUTINE MXDRMV ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * K-TH COLUMN OF A ROWWISE STORED DENSE RECTANGULAR MATRIX A IS COPIED * TO THE VECTOR X. * * PARAMETERS : * II N NUMBER OF COLUMNS OF THE MATRIX A. * II M NUMBER OF ROWS OF THE MATRIX A. * RI A(M*N) RECTANGULAR MATRIX STORED ROWWISE IN THE * ONE-DIMENSIONAL ARRAY. * RO X(M) OUTPUT VECTOR SUCH THAT X(J)=A(J,K) FOR ALL J. * II K INDEX OF THE ROW BEING COPIED TO THE OUTPUT VECTOR. * SUBROUTINE MXDRMV(N,M,A,X,K) C .. Scalar Arguments .. INTEGER K,M,N C .. C .. Array Arguments .. DOUBLE PRECISION A(*),X(*) C .. C .. Local Scalars .. INTEGER I,J C .. IF (K.LT.1 .OR. K.GT.N) RETURN I = K DO 10 J = 1,M X(J) = A(I) I = I + N 10 CONTINUE RETURN END * SUBROUTINE MXDSDA ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * A DENSE SYMMETRIC MATRIX A IS AUGMENTED BY THE SCALED UNIT MATRIX * SUCH THAT A:=A+ALF*I (I IS THE UNIT MATRIX OF ORDER N). * * PARAMETERS : * II N ORDER OF THE MATRIX A. * RU A(N*(N+1)/2) DENSE SYMMETRIC MATRIX STORED IN THE PACKED FORM. * RI ALF SCALING FACTOR. * SUBROUTINE MXDSDA(N,A,ALF) C .. Scalar Arguments .. DOUBLE PRECISION ALF INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION A(*) C .. C .. Local Scalars .. INTEGER I,J C .. J = 0 DO 10 I = 1,N J = J + I A(J) = A(J) + ALF 10 CONTINUE RETURN END * SUBROUTINE MXDSMI ALL SYSTEMS 88/12/01 * PORTABILITY : ALL SYSTEMS * 88/12/01 LU : ORIGINAL VERSION * * PURPOSE : * DENSE SYMMETRIC MATRIX A IS SET TO THE UNIT MATRIX WITH THE SAME * ORDER. * * PARAMETERS : * II N ORDER OF THE MATRIX A. * RO A(N*(N+1)/2) DENSE SYMMETRIC MATRIX STORED IN THE PACKED FORM * WHICH IS SET TO THE UNIT MATRIX (I.E. A:=I). * SUBROUTINE MXDSMI(N,A) C .. Scalar Arguments .. INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION A(*) C .. C .. Local Scalars .. INTEGER I,M C .. M = N* (N+1)/2 DO 10 I = 1,M A(I) = 0.0D0 10 CONTINUE M = 0 DO 20 I = 1,N M = M + I A(M) = 1.0D0 20 CONTINUE RETURN END * SUBROUTINE MXDSMM ALL SYSTEMS 89/12/01 * PORTABILITY : ALL SYSTEMS * 89/12/01 LU : ORIGINAL VERSION * * PURPOSE : * MULTIPLICATION OF A DENSE SYMMETRIC MATRIX A BY A VECTOR X. * * PARAMETERS : * II N ORDER OF THE MATRIX A. * RI A(N*(N+1)/2) DENSE SYMMETRIC MATRIX STORED IN THE PACKED FORM. * RI X(N) INPUT VECTOR. * RO Y(N) OUTPUT VECTOR EQUAL TO A*X. * SUBROUTINE MXDSMM(N,A,X,Y) C .. Scalar Arguments .. INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION A(*),X(*),Y(*) C .. C .. Local Scalars .. DOUBLE PRECISION TEMP INTEGER I,J,K,L C .. K = 0 DO 30 I = 1,N TEMP = 0.0D0 L = K DO 10 J = 1,I L = L + 1 TEMP = TEMP + A(L)*X(J) 10 CONTINUE DO 20 J = I + 1,N L = L + J - 1 TEMP = TEMP + A(L)*X(J) 20 CONTINUE Y(I) = TEMP K = K + I 30 CONTINUE RETURN END * FUNCTION MXDSMQ ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * VALUE OF A QUADRATIC FORM WITH A DENSE SYMMETRIC MATRIX A. * * PARAMETERS : * II N ORDER OF THE MATRIX A. * RI A(N*(N+1)/2) DENSE SYMMETRIC MATRIX STORED IN THE PACKED FORM. * RI X(N) GIVEN VECTOR. * RI Y(N) GIVEN VECTOR. * RR MXDSMQ VALUE OF THE QUADRATIC FORM MXDSMQ=TRANS(X)*A*Y. * DOUBLE PRECISION FUNCTION MXDSMQ(N,A,X,Y) C .. Parameters .. DOUBLE PRECISION ZERO PARAMETER (ZERO=0.0D0) C .. C .. Scalar Arguments .. INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION A(*),X(*),Y(*) C .. C .. Local Scalars .. DOUBLE PRECISION TEMP,TEMP1,TEMP2 INTEGER I,J,K C .. TEMP = ZERO K = 0 DO 20 I = 1,N TEMP1 = ZERO TEMP2 = ZERO DO 10 J = 1,I - 1 K = K + 1 TEMP1 = TEMP1 + A(K)*X(J) TEMP2 = TEMP2 + A(K)*Y(J) 10 CONTINUE K = K + 1 TEMP = TEMP + X(I)* (TEMP2+A(K)*Y(I)) + Y(I)*TEMP1 20 CONTINUE MXDSMQ = TEMP RETURN END * SUBROUTINE MXDSMR ALL SYSTEMS 92/12/01 * PORTABILITY : ALL SYSTEMS * 92/12/01 LU : ORIGINAL VERSION * * PURPOSE : * PLANE ROTATION IS APPLIED TO A DENSE SYMMETRIC MATRIX A. THE CASE * K=L+1 IS REQUIRED. * * PARAMETERS : * II N ORDER OF THE MATRIX A. * RU A(N*(N+1)/2) DENSE SYMMETRIC MATRIX STORED IN THE PACKED FORM. * II K FIRST INDEX OF PLANE ROTATION. * II L SECOND INDEX OF PLANE ROTATION. * RO CK DIAGONAL ELEMENT OF THE ELEMENTARY ORTHOGONAL MATRIX. * RO CL OFF-DIAGONAL ELEMENT OF THE ELEMENTARY ORTHOGONAL MATRIX. * IO IER INFORMATION ON THE TRANSFORMATION. IER<0-K OR L OUT OF * RANGE. IER=0-PLANE ROTATION. IER=1-PERMUTATION. * IER=2-TRANSFORMATION SUPPRESSED. * * SUBPROGRAMS USED : * S MXVROT PLANE ROTATION IS APPLIED TO TWO NUMBERS. * SUBROUTINE MXDSMR(N,A,K,L,CK,CL,IER) C .. Scalar Arguments .. DOUBLE PRECISION CK,CL INTEGER IER,K,L,N C .. C .. Array Arguments .. DOUBLE PRECISION A(*) C .. C .. Local Scalars .. DOUBLE PRECISION AKK,AKL,ALL,CKK,CKL,CLL INTEGER J,KJ,KK,KL,LJ,LL C .. C .. External Subroutines .. EXTERNAL MXVROT C .. IF (IER.NE.0 .AND. IER.NE.1) RETURN IF (K.NE.L+1) THEN IER = -1 RETURN END IF LJ = L* (L-1)/2 DO 10 J = 1,N IF (J.LE.L) THEN LJ = LJ + 1 KJ = LJ + L ELSE LJ = LJ + J - 1 KJ = LJ + 1 END IF IF (J.NE.K .AND. J.NE.L) THEN CALL MXVROT(A(KJ),A(LJ),CK,CL,IER) END IF 10 CONTINUE IF (IER.EQ.0) THEN CKK = CK**2 CKL = CK*CL CLL = CL**2 LL = L* (L+1)/2 KL = LL + L KK = LL + K AKL = (CKL+CKL)*A(KL) AKK = CKK*A(KK) + CLL*A(LL) + AKL ALL = CLL*A(KK) + CKK*A(LL) - AKL A(KL) = (CLL-CKK)*A(KL) + CKL* (A(KK)-A(LL)) A(KK) = AKK A(LL) = ALL ELSE LL = L* (L+1)/2 KK = LL + K AKK = A(KK) A(KK) = A(LL) A(LL) = AKK END IF RETURN END * SUBROUTINE MXDSMS ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * SCALING OF A DENSE SYMMETRIC MATRIX. * * PARAMETERS : * II N ORDER OF THE MATRIX A. * RU A(N*(N+1)/2) DENSE SYMMETRIC MATRIX STORED IN THE PACKED FORM * WHICH IS SCALED BY THE VALUE ALF (I.E. A:=ALF*A). * RI ALF SCALING FACTOR. * SUBROUTINE MXDSMS(N,A,ALF) C .. Scalar Arguments .. DOUBLE PRECISION ALF INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION A(*) C .. C .. Local Scalars .. INTEGER I,M C .. M = N* (N+1)/2 DO 10 I = 1,M A(I) = A(I)*ALF 10 CONTINUE RETURN END * SUBROUTINE MXDSMU ALL SYSTEMS 89/12/01 * PORTABILITY : ALL SYSTEMS * 89/12/01 LU : ORIGINAL VERSION * * PURPOSE : * UPDATE OF A DENSE SYMMETRIC MATRIX A. THIS UPDATE IS DEFINED AS * A:=A+ALF*X*TRANS(X) WHERE ALF IS A GIVEN SCALING FACTOR AND X IS * A GIVEN VECTOR. * * PARAMETERS : * II N ORDER OF THE MATRIX A. * RU A(N*(N+1)/2) DENSE SYMMETRIC MATRIX STORED IN THE PACKED FORM. * RI ALF SCALING FACTOR IN THE CORRECTION TERM. * RI X(N) VECTOR IN THE CORRECTION TERM. * SUBROUTINE MXDSMU(N,A,ALF,X) C .. Scalar Arguments .. DOUBLE PRECISION ALF INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION A(*),X(*) C .. C .. Local Scalars .. DOUBLE PRECISION TEMP INTEGER I,J,K C .. K = 0 DO 20 I = 1,N TEMP = ALF*X(I) DO 10 J = 1,I K = K + 1 A(K) = A(K) + TEMP*X(J) 10 CONTINUE 20 CONTINUE RETURN END * SUBROUTINE MXDSMV ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * K-TH ROW OF A DENSE SYMMETRIC MATRIX A IS COPIED TO THE VECTOR X. * * PARAMETERS : * II N ORDER OF THE MATRIX A. * RI A(N*(N+1)/2) DENSE SYMMETRIC MATRIX STORED IN THE PACKED FORM. * RO X(N) OUTPUT VECTOR. * II K INDEX OF COPIED ROW. * SUBROUTINE MXDSMV(N,A,X,K) C .. Scalar Arguments .. INTEGER K,N C .. C .. Array Arguments .. DOUBLE PRECISION A(*),X(*) C .. C .. Local Scalars .. INTEGER I,L C .. L = K* (K-1)/2 DO 10 I = 1,N IF (I.LE.K) THEN L = L + 1 ELSE L = L + I - 1 END IF X(I) = A(L) 10 CONTINUE RETURN END * SUBROUTINE MXVCOP ALL SYSTEMS 88/12/01 * PORTABILITY : ALL SYSTEMS * 88/12/01 LU : ORIGINAL VERSION * * PURPOSE : * COPYING OF A VECTOR. * * PARAMETERS : * II N VECTOR DIMENSION. * RI X(N) INPUT VECTOR. * RO Y(N) OUTPUT VECTOR WHERE Y:= X. * SUBROUTINE MXVCOP(N,X,Y) C .. Scalar Arguments .. INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION X(*),Y(*) C .. C .. Local Scalars .. INTEGER I C .. DO 10 I = 1,N Y(I) = X(I) 10 CONTINUE RETURN END DOUBLE PRECISION * FUNCTION MXVDEL ALL SYSTEMS 92/12/01 * PORTABILITY : ALL SYSTEMS * 92/12/01 LU : ORIGINAL VERSION * * PURPOSE : * SQUARED NORM OF A SHIFTED VECTOR. * * PARAMETERS : * II N VECTOR DIMENSION. * RI A SCALING FACTOR. * RI X(N) INPUT VECTOR. * RI Y(N) INPUT VECTOR. * RR UXVDEL SQUARED NORM OF Y+A*X. * + FUNCTION MXVDEL(N,A,X,Y) C .. Scalar Arguments .. DOUBLE PRECISION A INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION X(*),Y(*) C .. C .. Local Scalars .. DOUBLE PRECISION TEMP INTEGER I C .. TEMP = 0.0D0 DO 10 I = 1,N TEMP = TEMP + (Y(I)+A*X(I))**2 10 CONTINUE MXVDEL = TEMP RETURN END * SUBROUTINE MXVDIF ALL SYSTEMS 88/12/01 * PORTABILITY : ALL SYSTEMS * 88/12/01 LU : ORIGINAL VERSION * * PURPOSE : * VECTOR DIFFERENCE. * * PARAMETERS : * RI X(N) INPUT VECTOR. * RI Y(N) INPUT VECTOR. * RO Z(N) OUTPUT VECTOR WHERE Z:= X - Y. * SUBROUTINE MXVDIF(N,X,Y,Z) C .. Scalar Arguments .. INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION X(*),Y(*),Z(*) C .. C .. Local Scalars .. INTEGER I C .. DO 10 I = 1,N Z(I) = X(I) - Y(I) 10 CONTINUE RETURN END * SUBROUTINE MXVDIR ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * VECTOR AUGMENTED BY THE SCALED VECTOR. * * PARAMETERS : * II N VECTOR DIMENSION. * RI A SCALING FACTOR. * RI X(N) INPUT VECTOR. * RI Y(N) INPUT VECTOR. * RO Z(N) OUTPUT VECTOR WHERE Z:= Y + A*X. * SUBROUTINE MXVDIR(N,A,X,Y,Z) C .. Scalar Arguments .. DOUBLE PRECISION A INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION X(*),Y(*),Z(*) C .. C .. Local Scalars .. INTEGER I C .. DO 10 I = 1,N Z(I) = Y(I) + A*X(I) 10 CONTINUE RETURN END * FUNCTION MXVDOT ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * DOT PRODUCT OF TWO VECTORS. * * PARAMETERS : * II N VECTOR DIMENSION. * RI X(N) INPUT VECTOR. * RI Y(N) INPUT VECTOR. * RR MXVDOT VALUE OF DOT PRODUCT MXVDOT=TRANS(X)*Y. * DOUBLE PRECISION FUNCTION MXVDOT(N,X,Y) C .. Scalar Arguments .. INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION X(*),Y(*) C .. C .. Local Scalars .. DOUBLE PRECISION TEMP INTEGER I C .. TEMP = 0.0D0 DO 10 I = 1,N TEMP = TEMP + X(I)*Y(I) 10 CONTINUE MXVDOT = TEMP RETURN END * SUBROUTINE MXVINA ALL SYSTEMS 90/12/01 * PORTABILITY : ALL SYSTEMS * 90/12/01 LU : ORIGINAL VERSION * * PURPOSE : * ELEMENTS OF THE INTEGER VECTOR ARE REPLACED BY THEIR ABSOLUTE VALUES. * * PARAMETERS : * II N DIMENSION OF THE INTEGER VECTOR. * IU IX(N) INTEGER VECTOR WHICH IS UPDATED SO THAT IX(I):=ABS(IX(I)) * FOR ALL I. * SUBROUTINE MXVINA(N,IX) C .. Scalar Arguments .. INTEGER N C .. C .. Array Arguments .. INTEGER IX(*) C .. C .. Local Scalars .. INTEGER I C .. C .. Intrinsic Functions .. INTRINSIC ABS C .. DO 10 I = 1,N IX(I) = ABS(IX(I)) IF (IX(I).GT.10) IX(I) = IX(I) - 10 10 CONTINUE RETURN END * SUBROUTINE MXVIND ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * CHANGE OF THE INTEGER VECTOR ELEMENT FOR THE CONSTRAINT ADDITION. * * PARAMETERS : * IU IX(N) INTEGER VECTOR. * II I INDEX OF THE CHANGED ELEMENT. * II JOB CHANGE SPECIFICATION. IS JOB.EQ.0 THEN IX(I)=10-IX(I). * SUBROUTINE MXVIND(IX,I,JOB) C .. Scalar Arguments .. INTEGER I,JOB C .. C .. Array Arguments .. INTEGER IX(*) C .. IF (JOB.EQ.0) IX(I) = 10 - IX(I) RETURN END * SUBROUTINE MXVINS ALL SYSTEMS 90/12/01 * PORTABILITY : ALL SYSTEMS * 90/12/01 LU : ORIGINAL VERSION * * PURPOSE : * INITIATION OF THE INTEGER VECTOR. * * PARAMETERS : * II N DIMENSION OF THE INTEGER VECTOR. * II IP INTEGER PARAMETER. * IO IX(N) INTEGER VECTOR SUCH THAT IX(I)=IP FOR ALL I. * SUBROUTINE MXVINS(N,IP,IX) C .. Scalar Arguments .. INTEGER IP,N C .. C .. Array Arguments .. INTEGER IX(*) C .. C .. Local Scalars .. INTEGER I C .. DO 10 I = 1,N IX(I) = IP 10 CONTINUE RETURN END * SUBROUTINE MXVINV ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * CHANGE OF THE INTEGER VECTOR ELEMENT FOR THE CONSTRAINT ADDITION. * * PARAMETERS : * II N VECTOR DIMENSION. * IU IX(N) INTEGER VECTOR. * II I INDEX OF THE CHANGED ELEMENT. * II JOB CHANGE SPECIFICATION * SUBROUTINE MXVINV(IX,I,JOB) C .. Scalar Arguments .. INTEGER I,JOB C .. C .. Array Arguments .. INTEGER IX(*) C .. IF ((IX(I).EQ.3.OR.IX(I).EQ.5) .AND. JOB.LT.0) IX(I) = IX(I) + 1 IF ((IX(I).EQ.4.OR.IX(I).EQ.6) .AND. JOB.GT.0) IX(I) = IX(I) - 1 IX(I) = -IX(I) RETURN END * SUBROUTINE MXVLIN ALL SYSTEMS 92/12/01 * PORTABILITY : ALL SYSTEMS * 92/12/01 LU : ORIGINAL VERSION * * PURPOSE : * LINEAR COMBINATION OF TWO VECTORS. * * PARAMETERS : * II N VECTOR DIMENSION. * RI A SCALING FACTOR. * RI X(N) INPUT VECTOR. * RI B SCALING FACTOR. * RI Y(N) INPUT VECTOR. * RO Z(N) OUTPUT VECTOR WHERE Z:= A*X + B*Y. * SUBROUTINE MXVLIN(N,A,X,B,Y,Z) C .. Scalar Arguments .. DOUBLE PRECISION A,B INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION X(*),Y(*),Z(*) C .. C .. Local Scalars .. INTEGER I C .. DO 10 I = 1,N Z(I) = A*X(I) + B*Y(I) 10 CONTINUE RETURN END * FUNCTION MXVMAX ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * L-INFINITY NORM OF A VECTOR. * * PARAMETERS : * II N VECTOR DIMENSION. * RI X(N) INPUT VECTOR. * RR MXVMAX L-INFINITY NORM OF THE VECTOR X. * DOUBLE PRECISION FUNCTION MXVMAX(N,X) C .. Scalar Arguments .. INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION X(*) C .. C .. Local Scalars .. INTEGER I C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX C .. MXVMAX = 0.0D0 DO 10 I = 1,N MXVMAX = MAX(MXVMAX,ABS(X(I))) 10 CONTINUE RETURN END DOUBLE PRECISION * FUNCTION MXVMX2 ALL SYSTEMS 95/12/01 * PORTABILITY : ALL SYSTEMS * 95/12/01 SI : ORIGINAL VERSION * * PURPOSE : * L-INFINITY NORM OF VECTOR DIFFERENCE. * * PARAMETERS : * II N VECTOR DIMENSION. * RI X(N) INPUT VECTOR. * RI Y(N) INPUT VECTOR. * RR UXVMX2 L-INFINITY NORM OF X-Y. * + FUNCTION MXVMX2(N,X,Y) C .. Scalar Arguments .. INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION X(*),Y(*) C .. C .. Local Scalars .. DOUBLE PRECISION TEMP INTEGER I C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX C .. TEMP = 0.0D0 DO 10 I = 1,N TEMP = MAX(TEMP,ABS(X(I)-Y(I))) 10 CONTINUE MXVMX2 = TEMP END * SUBROUTINE MXVMUL ALL SYSTEMS 89/12/01 * PORTABILITY : ALL SYSTEMS * 89/12/01 LU : ORIGINAL VERSION * * PURPOSE : * VECTOR IS PREMULTIPLIED BY THE POWER OF A DIAGONAL MATRIX. * * PARAMETERS : * II N VECTOR DIMENSION. * RI D(N) DIAGONAL MATRIX STORED AS A VECTOR WITH N ELEMENTS. * RI X(N) INPUT VECTOR. * RO Y(N) OUTPUT VECTOR WHERE Y:=(D**K)*X. * II K INTEGER EXPONENT. * SUBROUTINE MXVMUL(N,D,X,Y,K) C .. Scalar Arguments .. INTEGER K,N C .. C .. Array Arguments .. DOUBLE PRECISION D(*),X(*),Y(*) C .. C .. Local Scalars .. INTEGER I C .. C .. External Subroutines .. EXTERNAL MXVCOP C .. IF (K.EQ.0) THEN CALL MXVCOP(N,X,Y) ELSE IF (K.EQ.1) THEN DO 10 I = 1,N Y(I) = X(I)*D(I) 10 CONTINUE ELSE IF (K.EQ.-1) THEN DO 20 I = 1,N Y(I) = X(I)/D(I) 20 CONTINUE ELSE DO 30 I = 1,N Y(I) = X(I)*D(I)**K 30 CONTINUE END IF RETURN END * SUBROUTINE MXVNEG ALL SYSTEMS 88/12/01 * PORTABILITY : ALL SYSTEMS * 88/12/01 LU : ORIGINAL VERSION * * PURPOSE : * CHANGE THE SIGNS OF VECTOR ELEMENTS. * * PARAMETERS : * II N VECTOR DIMENSION. * RI X(N) INPUT VECTOR. * RO Y(N) OUTPUT VECTOR WHERE Y:= - X. * SUBROUTINE MXVNEG(N,X,Y) C .. Scalar Arguments .. INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION X(*),Y(*) C .. C .. Local Scalars .. INTEGER I C .. DO 10 I = 1,N Y(I) = -X(I) 10 CONTINUE RETURN END * FUNCTION MXVNM2 ALL SYSTEMS 90/12/01 * PORTABILITY : ALL SYSTEMS * 90/12/01 SI : ORIGINAL VERSION * * PURPOSE : * EUCLIDEAN NORM OF VECTOR DIFFERENCE. * * PARAMETERS : * II N VECTOR DIMENSION. * RI X(N) INPUT VECTOR. * RI Y(N) INPUT VECTOR. * RR MXVNM2 EUCLIDEAN NORM OF X-Y. * DOUBLE PRECISION FUNCTION MXVNM2(N,X,Y) C .. Parameters .. DOUBLE PRECISION ZERO PARAMETER (ZERO=0.0D0) C .. C .. Scalar Arguments .. INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION X(*),Y(*) C .. C .. Local Scalars .. DOUBLE PRECISION TEMP INTEGER I C .. C .. Intrinsic Functions .. INTRINSIC SQRT C .. TEMP = ZERO DO 10 I = 1,N TEMP = TEMP + (X(I)-Y(I))**2 10 CONTINUE MXVNM2 = SQRT(TEMP) END DOUBLE PRECISION * FUNCTION MXVNOR ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * EUCLIDEAN NORM OF A VECTOR. * * PARAMETERS : * II N VECTOR DIMENSION. * RI X(N) INPUT VECTOR. * RR MXVNOR EUCLIDEAN NORM OF X. * + FUNCTION MXVNOR(N,X) C .. Scalar Arguments .. INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION X(*) C .. C .. Local Scalars .. DOUBLE PRECISION DEN,POM INTEGER I C .. C .. Intrinsic Functions .. INTRINSIC ABS,MAX,SQRT C .. DEN = 0.0D0 DO 10 I = 1,N DEN = MAX(DEN,ABS(X(I))) 10 CONTINUE POM = 0.0D0 IF (DEN.GT.0.0D0) THEN DO 20 I = 1,N POM = POM + (X(I)/DEN)**2 20 CONTINUE END IF MXVNOR = DEN*SQRT(POM) RETURN END * SUBROUTINE MXVORT ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * DETERMINATION OF AN ELEMENTARY ORTHOGONAL MATRIX FOR PLANE ROTATION. * * PARAMETERS : * RU XK FIRST VALUE FOR PLANE ROTATION (XK IS TRANSFORMED TO * SQRT(XK**2+XL**2)) * RU XL SECOND VALUE FOR PLANE ROTATION (XL IS TRANSFORMED TO * ZERO) * RO CK DIAGONAL ELEMENT OF THE ELEMENTARY ORTHOGONAL MATRIX. * RO CL OFF-DIAGONAL ELEMENT OF THE ELEMENTARY ORTHOGONAL MATRIX. * IO IER INFORMATION ON THE TRANSFORMATION. IER=0-GENERAL PLANE * ROTATION. IER=1-PERMUTATION. IER=2-TRANSFORMATION SUPPRESSED. * SUBROUTINE MXVORT(XK,XL,CK,CL,IER) C .. Scalar Arguments .. DOUBLE PRECISION CK,CL,XK,XL INTEGER IER C .. C .. Local Scalars .. DOUBLE PRECISION DEN,POM C .. C .. Intrinsic Functions .. INTRINSIC ABS,SQRT C .. IF (XL.EQ.0.0D0) THEN IER = 2 ELSE IF (XK.EQ.0.0D0) THEN XK = XL XL = 0.0D0 IER = 1 ELSE IF (ABS(XK).GE.ABS(XL)) THEN POM = XL/XK DEN = SQRT(1.0D0+POM*POM) CK = 1.0D0/DEN CL = POM/DEN XK = XK*DEN ELSE POM = XK/XL DEN = SQRT(1.0D0+POM*POM) CL = 1.0D0/DEN CK = POM/DEN XK = XL*DEN END IF XL = 0.0D0 IER = 0 END IF RETURN END * SUBROUTINE MXVROT ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * PLANE ROTATION IS APPLIED TO TWO VALUES. * * PARAMETERS : * RU XK FIRST VALUE FOR PLANE ROTATION. * RU XL SECOND VALUE FOR PLANE ROTATION. * RI CK DIAGONAL ELEMENT OF THE ELEMENTARY ORTHOGONAL MATRIX. * RI CL OFF-DIAGONAL ELEMENT OF THE ELEMENTARY ORTHOGONAL MATRIX. * II IER INFORMATION ON THE TRANSFORMATION. IER=0-GENERAL PLANE * ROTATION. IER=1-PERMUTATION. IER=2-TRANSFORMATION SUPPRESSED. * SUBROUTINE MXVROT(XK,XL,CK,CL,IER) C .. Scalar Arguments .. DOUBLE PRECISION CK,CL,XK,XL INTEGER IER C .. C .. Local Scalars .. DOUBLE PRECISION YK,YL C .. IF (IER.EQ.0) THEN YK = XK YL = XL XK = CK*YK + CL*YL XL = CL*YK - CK*YL ELSE IF (IER.EQ.1) THEN YK = XK XK = XL XL = YK END IF RETURN END DOUBLE PRECISION * SUBROUTINE MXVSAB ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * L-1 NORM OF A VECTOR. * * PARAMETERS : * II N VECTOR DIMENSION. * RI X(N) INPUT VECTOR. * RR MXVSAB L-1 NORM OF THE VECTOR X. * + FUNCTION MXVSAB(N,X) C .. Scalar Arguments .. INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION X(*) C .. C .. Local Scalars .. INTEGER I C .. C .. Intrinsic Functions .. INTRINSIC ABS C .. MXVSAB = 0.0D0 DO 10 I = 1,N MXVSAB = MXVSAB + ABS(X(I)) 10 CONTINUE RETURN END * SUBROUTINE MXVSAV ALL SYSTEMS 91/12/01 * PORTABILITY : ALL SYSTEMS * 91/12/01 LU : ORIGINAL VERSION * * PURPOSE : * DIFFERENCE OF TWO VECTORS RETURNED IN THE SUBSTRACTED ONE. * * PARAMETERS : * II N VECTOR DIMENSION. * RI X(N) INPUT VECTOR. * RU Y(N) UPDATE VECTOR WHERE Y:= X - Y. * SUBROUTINE MXVSAV(N,X,Y) C .. Scalar Arguments .. INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION X(*),Y(*) C .. C .. Local Scalars .. DOUBLE PRECISION TEMP INTEGER I C .. DO 10 I = 1,N TEMP = Y(I) Y(I) = X(I) - Y(I) X(I) = TEMP 10 CONTINUE RETURN END * SUBROUTINE MXVSCL ALL SYSTEMS 88/12/01 * PORTABILITY : ALL SYSTEMS * 88/12/01 LU : ORIGINAL VERSION * * PURPOSE : * SCALING OF A VECTOR. * * PARAMETERS : * II N VECTOR DIMENSION. * RI X(N) INPUT VECTOR. * RI A SCALING FACTOR. * RO Y(N) OUTPUT VECTOR WHERE Y:= A*X. * SUBROUTINE MXVSCL(N,A,X,Y) C .. Scalar Arguments .. DOUBLE PRECISION A INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION X(*),Y(*) C .. C .. Local Scalars .. INTEGER I C .. DO 10 I = 1,N Y(I) = A*X(I) 10 CONTINUE RETURN END * SUBROUTINE MXVSET ALL SYSTEMS 88/12/01 * PORTABILITY : ALL SYSTEMS * 88/12/01 LU : ORIGINAL VERSION * * PURPOSE : * A SCALAR IS SET TO ALL THE ELEMENTS OF A VECTOR. * * PARAMETERS : * II N VECTOR DIMENSION. * RI A INITIAL VALUE. * RO X(N) OUTPUT VECTOR SUCH THAT X(I)=A FOR ALL I. * SUBROUTINE MXVSET(N,A,X) C .. Scalar Arguments .. DOUBLE PRECISION A INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION X(*) C .. C .. Local Scalars .. INTEGER I C .. DO 10 I = 1,N X(I) = A 10 CONTINUE RETURN END * SUBROUTINE MXVSUM ALL SYSTEMS 88/12/01 * PORTABILITY : ALL SYSTEMS * 88/12/01 LU : ORIGINAL VERSION * * PURPOSE : * SUM OF TWO VECTORS. * * PARAMETERS : * II N VECTOR DIMENSION. * RI X(N) INPUT VECTOR. * RI Y(N) INPUT VECTOR. * RO Z(N) OUTPUT VECTOR WHERE Z:= X + Y. * SUBROUTINE MXVSUM(N,X,Y,Z) C .. Scalar Arguments .. INTEGER N C .. C .. Array Arguments .. DOUBLE PRECISION X(*),Y(*),Z(*) C .. C .. Local Scalars .. INTEGER I C .. DO 10 I = 1,N Z(I) = X(I) + Y(I) 10 CONTINUE RETURN END SHAR_EOF fi # end of overwriting check cd .. cd .. cd .. # End of shell archive exit 0